1- utils :: globalVariables(c(" group"
2- # ' Plot a Thematic Evolution Analysis
1+ utils :: globalVariables(c(" group" " CL1" " CL2" " value" " visEdges" " visIgraphLayout" " visNetwork" " visOptions"
2+ " visPhysics"
3+ # ' Plot Thematic Evolution Network
34# '
4- # ' It plot a Thematic Evolution Analysis performed using the \code{\link{thematicEvolution}} function.
5+ # ' Visualizes the thematic evolution of clusters over time using a temporal network layout.
6+ # ' Nodes are positioned along the x-axis according to time slices and vertically to minimize overlap.
7+ # ' Edges represent links between themes across time periods, with customizable weights and styles.
8+ # ' Nodes and Edges objects are the results of a Thematic Evolution Analysis performed using the \code{\link{thematicEvolution}} function.
59# '
610# ' @param Nodes is a list of nodes obtained by \code{\link{thematicEvolution}} function.
711# ' @param Edges is a list of edges obtained by \code{\link{thematicEvolution}} function.
8- # ' @param measure is a character. It can be \code{measure=("inclusion","stability", "weighted")}.
9- # ' @param min.flow is numerical. It indicates the minimum value of measure to plot a flow.
10- # ' @return a sankeyPlot
12+ # ' @param min.flow Numeric. Minimum threshold for edge weight (i.e., flow) to be included in the network visualization. Default is `0`.
13+ # ' @param measure Character. The method to define edge weight: `"inclusion"`, `"stability"`, or `"weighted"` (default is `"weighted"`).
14+ # ' @param node_shape Character. Shape of the nodes in the network. Options are `"dot"` (default), `"box"`, `"circle"`, or `"ellipse"`.
15+ # ' @param label_size Numeric. Font size of the node labels. Default is `15`.
16+ # ' @param edge_scale Numeric. Scaling factor for edge width. Default is `10`.
17+ # ' @param node_scale Numeric. Scaling factor for node size. Default is `30`.
18+ # '
19+ # ' @return A `visNetwork` object displaying a time-structured thematic evolution network.
1120# '
1221# '
1322# ' @examples
@@ -27,91 +36,94 @@ utils::globalVariables(c("group"))
2736# '
2837# ' @export
2938
30- plotThematicEvolution <- function (Nodes , Edges , measure = " inclusion" min.flow = 0 ){
39+ plotThematicEvolution <- function (Nodes ,
40+ Edges ,
41+ min.flow = 0 ,
42+ measure = " weighted" # measure=("inclusion","stability", "weighted")
43+ node_shape = " box" # "box", "circle", "ellipse"
44+ label_size = 5 ,
45+ edge_scale = 10 ,
46+ node_scale = 30 ) {
3147
32-
48+ switch (measure ,
49+ inclusion = {
50+ edge_weight_var = " Inclusion"
51+ },
52+ stability = {
53+ edge_weight_var = " Stability"
54+ },
55+ weighted = {
56+ edge_weight_var = " Inc_Weighted"
57+ }
58+ )
3359
34- Kx <- length(unique(Nodes $ group ))
35- Ky <- nrow(Nodes )
36- Nodes <- Nodes %> %
37- mutate(
38- coordX = rep(seq(from = 0 , to = 1 , by = 1 / (Kx - 0.8 )),as.numeric(table(group ))),
39- coordY = rep(0.1 , Ky )
40- )
60+ Edges $ Stability <- Edges $ Stability * 10
4161
42-
43- # ###############
44- switch (measure , inclusion = {
45- Edges = Edges [- c(4 , 5 )]
46- }, stability = {
47- Edges = Edges [- c(3 , 4 )]
48- }, weighted = {
49- Edges = Edges [, - c(3 , 5 )]
50- })
51- names(Edges )[3 ] = " weight"
52- Edges = Edges [Edges $ weight > = min.flow , ]
53- Edges $ weight = Edges $ weight * 100
62+ # 1. X coordinate by time
63+ unique_slices <- sort(unique(Nodes $ slice ))
64+ x_positions <- normalize_to_minus1_1(setNames((seq_along(unique_slices )- 1 ), unique_slices ))
65+ Nodes <- Nodes %> %
66+ mutate(x = x_positions [as.character(slice )])
5467
55- Nodes $ id <- (1 : nrow(Nodes ))- 1
56-
57- # # identify and remove nodes with empty edges
58- ind <- setdiff(Nodes $ id ,unique(c(Edges $ from ,Edges $ to )))
59- if (length(ind )> 0 ) {
60- Nodes <- Nodes [- (ind + 1 ),]
61- Nodes $ idnew <- (1 : nrow(Nodes ))- 1
62- # # replace old edge ids with new ones
63- for (i in 1 : nrow(Nodes )){
64- old <- Nodes $ id [i ]
65- new <- Nodes $ idnew [i ]
66- Edges $ from [Edges $ from == old ] <- new
67- Edges $ to [Edges $ to == old ] <- new
68- }
69- }
68+ # 2. Y coordinates to avoid overlap
69+ Nodes <- Nodes %> %
70+ group_by(slice ) %> %
71+ arrange(name ) %> %
72+ mutate(y = normalize_to_minus1_1(seq(from = 100 , by = 100 , length.out = n()))) %> %
73+ ungroup()
7074
71- # Edges$color <- "lightgrey"
75+ # 4. Prepare nodes for visNetwork
76+ Nodes_vis <- Nodes %> %
77+ mutate(shape = node_shape ,
78+ size = sum * node_scale ,
79+ value = sum ) %> %
80+ select(id , label , group , color , x , y , shape , size , value )
7281
73- # plotly margins
74- m <- list (
75- l = 50 ,
76- r = 50 ,
77- b = 100 ,
78- t = 100 ,
79- pad = 4
80- )
82+ # Add fonts as a list for each line (label below)
83+ # Nodes_vis$font <- map(seq_len(nrow(Nodes_vis)), ~ list(size = label_size, vadjust = -0.1))
84+
85+ if (node_shape %in% c(" dot" " square"
86+ vadjust <- - 2 * (Nodes_vis $ size / (max(Nodes_vis $ size ) - min(Nodes_vis $ size ))) * label_size
87+ font_sizes <- rep(label_size , nrow(Nodes_vis ))
88+ } else {
89+ # Scala il font in base al valore del nodo (sum) tra min e max specificati
90+ min_font <- 10
91+ max_font <- label_size * 4
92+ font_sizes <- min_font + (Nodes_vis $ value - min(Nodes_vis $ value )) / (max(Nodes_vis $ value ) - min(Nodes_vis $ value )) * (max_font - min_font )
93+ vadjust <- rep(0 , nrow(Nodes_vis ))
94+ }
95+
96+ Nodes_vis $ font <- purrr :: map2(font_sizes , vadjust , ~ list (size = .x , vadjust = .y ))
8197
82- plotly :: plot_ly(
83- type = " sankey"
84- arrangement = " snap"
85- node = list (
86- label = Nodes $ name ,
87- x = Nodes $ coordX ,
88- y = Nodes $ coordY ,
89- color = Nodes $ color ,
90- pad = 4 ), # 10 Pixel
91- link = list (
92- source = Edges $ from ,
93- target = Edges $ to ,
94- value = Edges $ weight
95- # ,color = Edges$color
96- )
97- ) %> %
98- layout(margin = m ) %> %
99- plotly :: add_annotations(x = Nodes $ coordX ,
100- y = 1.08 ,
101- text = factor (Nodes $ group ) ,
102- showarrow = F ,xanchor = " center"
103- font = list (color = ' Dark'
104- family = " TimesNewRoman"
105- size = 18 )) %> %
106- config(displaylogo = FALSE ,
107- modeBarButtonsToRemove = c(
108- ' toImage'
109- ' sendDataToCloud'
110- ' pan2d'
111- ' select2d'
112- ' lasso2d'
113- ' toggleSpikelines'
114- ' hoverClosestCartesian'
115- ' hoverCompareCartesian'
116- ))
98+ Nodes_vis $ fixed.x <- TRUE
99+
100+ # 5. Prepare edges
101+ edges_vis <- Edges %> %
102+ mutate(width = !! sym(edge_weight_var ) * edge_scale ,
103+ value = !! sym(edge_weight_var )) %> %
104+ dplyr :: filter(value > = min.flow )
105+
106+ edges_vis $ color <- lapply(1 : nrow(edges_vis ), function (i ) list (color = " #D3D3D3" highlight = " #35343370" hover = " #35343370"
107+
108+ # # layout
109+ coords = as.matrix(Nodes %> % select(x ,y ))
110+
111+ # 6. Build the network
112+ VIS <- visNetwork(Nodes_vis , edges_vis , type = " full" smooth = TRUE ) %> %
113+ # visNodes(scaling=list(min = 10, max = node_scale)) %>%
114+ visEdges(smooth = list (type = " horizontal" arrows = " to" scaling = list (min = 1 , max = edge_scale )) %> %
115+ visIgraphLayout(layout = " layout.norm" layoutMatrix = coords , type = " full" > %
116+ # visOptions(highlightNearest = TRUE, nodesIdSelection = FALSE) %>%
117+ visPhysics(enabled = FALSE ) %> %
118+ visOptions(highlightNearest = list (enabled = TRUE , hover = TRUE , degree = 1 ,
119+ algorithm = " all" hideColor = " rgba(200, 200, 200, 0.90)" nodesIdSelection = FALSE ) %> %
120+ # visNetwork::visOptions(highlightNearest =list(enabled = T, hover = T, degree=max(as.numeric(unique_slices))), nodesIdSelection = T) %>%
121+ visNetwork :: visInteraction(dragNodes = TRUE , navigationButtons = F , hideEdgesOnDrag = TRUE , zoomSpeed = 0.4 ) %> %
122+ visNetwork :: visOptions(manipulation = FALSE , height = " 100%" width = " 100%"
123+
124+ return (VIS )
125+ }
126+
127+ normalize_to_minus1_1 <- function (v ) {
128+ 2 * (v - min(v )) / (max(v ) - min(v )) - 1
117129}
0 commit comments