-
Notifications
You must be signed in to change notification settings - Fork 0
/
create_alltraces.R
114 lines (106 loc) · 3.96 KB
/
create_alltraces.R
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
#' Create all traces for a time serie
#'
#' @param meshExample One or several meshes.
#' @param graphExample One or several cell graphs.
#' @param meshColors Colors for each mesh.
#' @param display Display type. 'labels', 'heatmap' or 'none'.
#' @param defaultColor Uniform mesh color (HEX color and alpha value between 0 and 1). Needed only if 'none' display type is chosen.
#' @param heatmapParam Variable (from cell graph) to display if 'heatmap' display type is selected.
#'
#' @importFrom colorRamps matlab.like
#' @importFrom dplyr left_join pull select
#' @return A list.
#'
create_alltraces <- function(meshExample,
graphExample,
meshColors,
display,
defaultColor = list("#CCCCFF", 0.2),
heatmapParam = "GeometryArea"
){
makeColorScale <- FALSE
if (display == 'labels'){
opacity <- 1
if (is.null(meshColors)){
meshColors <- meshExample$allColors$Col_label
}
if (ncol(meshColors)>1){
color <- NULL
for (i in 1:ncol(meshColors)){
color[i] <- setdiff(unique(meshColors[,i]), "#000000") #I remove black vertices
} # to be more general, remove any color shared by two vertices
}else{
color <- meshColors
}
} else if (display == 'none'){
color <- rep(defaultColor[[1]], ncol(meshExample$it)) # "#00FFFF"
opacity <- defaultColor[[2]]
} else if (display == 'heatmap'){
if (is.numeric(meshColors) == TRUE && is.null(heatmapParam) == TRUE ){
makeColorScale <- TRUE
colorCut <- cut(pull(meshColors), 15,
labels = matlab.like(15)
)
color <- as.character(colorCut)
opacity <- 1
}else if (is.null(heatmapParam) == FALSE){
meshColors <- left_join(meshExample$it_label, graphExample$vertices) %>%
select(., heatmapParam)
makeColorScale <- TRUE
colorCut <- cut(pull(meshColors), 15,
labels = matlab.like(15)
)
color <- as.character(colorCut)
opacity <- 1
}else{
warning("Provide continous variable for heatmap or valid heatmap parameter.")
}
}
trace2 <- list(type="mesh3d",
x = meshExample$vb[1,],
y = meshExample$vb[2,],
z = meshExample$vb[3,],
i = meshExample$it[1,]-1, # NB indices start at 0
j = meshExample$it[2,]-1,
k = meshExample$it[3,]-1,
facecolor = color,
opacity = opacity,
visible = FALSE
)
if (makeColorScale){
trace4 <- list(x = c(100,1,200),
y = c(200,1,1),
z = c(1,500,3),
marker = list(
autocolorscale = FALSE,
cmax = round(max(meshColors)),#2.5,
cmin = round(min(meshColors)),#0,
color = c("#0000aa", "#99ff99", "#aa0000"),
colorbar = list(
x = 1.2,
y = 0.5,
len = 1,
thickness = 15,
tickfont = list(size = 12),
titlefont = list(size = 20)
),
colorscale = purrr::map2(.x = seq(0,1, len=15),
.y = matlab.like(15),
~ list(.x, .y)),
line = list(width = 0),
opacity = 0.1,
showscale = TRUE,
size = 20,
symbol = "circle"
),
mode = "markers",
opacity = 0,
type = "scatter3d"
)
}else{
trace4 <- NULL
}
meshCellcenter <- graphExample$vertices[,c("label","x", "y", "z")]
list(trace2, trace4, meshCellcenter)
#facecolor: one color per triangle (e.g. length(facecolor) == length(i))
}