[7a0be0]: / R / 3-2.shapes.R

Download this file

138 lines (132 with data), 5.4 kB

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