Diff of /R/3-2.shapes.R [000000] .. [13df9a]

Switch to unified view

a b/R/3-2.shapes.R
1
# ========3.1.shapes========
2
3
add_metanet_shape_diamond <- function() {
4
  mydiamond <- function(coords, v = NULL, params) {
5
    vertex.color <- params("vertex", "color")
6
    if (length(vertex.color) != 1 && !is.null(v)) {
7
      vertex.color <- vertex.color[v]
8
    }
9
    vertex.frame.color <- params("vertex", "frame.color")
10
    if (length(vertex.frame.color) != 1 && !is.null(v)) {
11
      vertex.frame.color <- vertex.frame.color[v]
12
    }
13
    vertex.frame.width <- params("vertex", "frame.width")
14
    if (length(vertex.frame.width) != 1 && !is.null(v)) {
15
      vertex.frame.width <- vertex.frame.width[v]
16
    }
17
    vertex.size <- 1 / 200 * sqrt(2) * params("vertex", "size")
18
    if (length(vertex.size) != 1 && !is.null(v)) {
19
      vertex.size <- vertex.size[v]
20
    }
21
    vertex.size <- rep(vertex.size, length.out = nrow(coords))
22
    vertex.frame.color[vertex.frame.width <= 0] <- NA
23
    vertex.frame.width[vertex.frame.width <= 0] <- 1
24
    if (length(vertex.frame.width) == 1) {
25
      symbols(
26
        x = coords[, 1], y = coords[, 2], bg = vertex.color,
27
        fg = vertex.frame.color, stars = cbind(vertex.size, vertex.size, vertex.size, vertex.size),
28
        lwd = vertex.frame.width, add = TRUE, inches = FALSE
29
      )
30
    } else {
31
      mapply(coords[, 1], coords[, 2], vertex.color, vertex.frame.color,
32
        vertex.size, vertex.frame.width,
33
        FUN = function(x, y, bg, fg, size, lwd) {
34
          symbols(
35
            x = x, y = y, bg = bg, fg = fg, lwd = lwd,
36
            stars = cbind(size, size, size, size), add = TRUE, inches = FALSE
37
          )
38
        }
39
      )
40
    }
41
  }
42
  igraph::add_shape("diamond", clip = shape_noclip, plot = mydiamond)
43
}
44
45
add_metanet_shape_triangle1 <- function() {
46
  mytriangle1 <- function(coords, v = NULL, params) {
47
    vertex.color <- params("vertex", "color")
48
    if (length(vertex.color) != 1 && !is.null(v)) {
49
      vertex.color <- vertex.color[v]
50
    }
51
    vertex.frame.color <- params("vertex", "frame.color")
52
    if (length(vertex.frame.color) != 1 && !is.null(v)) {
53
      vertex.frame.color <- vertex.frame.color[v]
54
    }
55
    vertex.frame.width <- params("vertex", "frame.width")
56
    if (length(vertex.frame.width) != 1 && !is.null(v)) {
57
      vertex.frame.width <- vertex.frame.width[v]
58
    }
59
    vertex.size <- 1 / 200 * 1.2 * params("vertex", "size")
60
    if (length(vertex.size) != 1 && !is.null(v)) {
61
      vertex.size <- vertex.size[v]
62
    }
63
    vertex.size <- rep(vertex.size, length.out = nrow(coords))
64
    vertex.frame.color[vertex.frame.width <= 0] <- NA
65
    vertex.frame.width[vertex.frame.width <= 0] <- 1
66
    if (length(vertex.frame.width) == 1) {
67
      symbols(
68
        x = coords[, 1], y = coords[, 2] - vertex.size / sqrt(3), bg = vertex.color,
69
        fg = vertex.frame.color, stars = cbind(vertex.size, vertex.size * sqrt(3), vertex.size, 0),
70
        lwd = vertex.frame.width, add = TRUE, inches = FALSE
71
      )
72
    } else {
73
      mapply(coords[, 1], coords[, 2], vertex.color, vertex.frame.color,
74
        vertex.size, vertex.frame.width,
75
        FUN = function(x, y, bg, fg, size, lwd) {
76
          symbols(
77
            x = x, y = y - size / sqrt(3), bg = bg, fg = fg, lwd = lwd,
78
            stars = cbind(size, size * sqrt(3), size, 0), add = TRUE, inches = FALSE
79
          )
80
        }
81
      )
82
    }
83
  }
84
  igraph::add_shape("triangle1", clip = shape_noclip, plot = mytriangle1)
85
}
86
87
add_metanet_shape_triangle2 <- function() {
88
  mytriangle2 <- function(coords, v = NULL, params) {
89
    vertex.color <- params("vertex", "color")
90
    if (length(vertex.color) != 1 && !is.null(v)) {
91
      vertex.color <- vertex.color[v]
92
    }
93
    vertex.frame.color <- params("vertex", "frame.color")
94
    if (length(vertex.frame.color) != 1 && !is.null(v)) {
95
      vertex.frame.color <- vertex.frame.color[v]
96
    }
97
    vertex.frame.width <- params("vertex", "frame.width")
98
    if (length(vertex.frame.width) != 1 && !is.null(v)) {
99
      vertex.frame.width <- vertex.frame.width[v]
100
    }
101
    vertex.size <- 1 / 200 * 1.2 * params("vertex", "size")
102
    if (length(vertex.size) != 1 && !is.null(v)) {
103
      vertex.size <- vertex.size[v]
104
    }
105
    vertex.size <- rep(vertex.size, length.out = nrow(coords))
106
    vertex.frame.color[vertex.frame.width <= 0] <- NA
107
    vertex.frame.width[vertex.frame.width <= 0] <- 1
108
    if (length(vertex.frame.width) == 1) {
109
      symbols(
110
        x = coords[, 1], y = coords[, 2] + vertex.size / sqrt(3), bg = vertex.color,
111
        fg = vertex.frame.color, stars = cbind(vertex.size, 0, vertex.size, vertex.size * sqrt(3)),
112
        lwd = vertex.frame.width, add = TRUE, inches = FALSE
113
      )
114
    } else {
115
      mapply(coords[, 1], coords[, 2], vertex.color, vertex.frame.color,
116
        vertex.size, vertex.frame.width,
117
        FUN = function(x, y, bg, fg, size, lwd) {
118
          symbols(
119
            x = x, y = y + size / sqrt(3), bg = bg, fg = fg, lwd = lwd,
120
            stars = cbind(size, 0, size, size * sqrt(3)), add = TRUE, inches = FALSE
121
          )
122
        }
123
      )
124
    }
125
  }
126
  igraph::add_shape("triangle2", clip = shape_noclip, plot = mytriangle2)
127
}
128
129
# 因为igraph默认只有circle和square适合展示,所以这里添加了更多的形状
130
131
add_metanet_shapes <- function() {
132
  # !!!考虑添加更多的形状,至少是21:25,形状为pie时添加额外legend
133
  for (i in names(default_v_shape)[3:5]) {
134
    paste0("add_metanet_shape_", i) -> fun_name
135
    do.call(fun_name, list())
136
  }
137
}