I am building a large map where a number of observed variables map onto latent variables. When using DiagrammeR to generate the map, all the observed items (indicated by squares) appear in a single row. I was wondering if there was a way to sort them into multiple rows, say 5 or 10 in a row? The example below is based on actual data where there are 30+ items that map to one latent variable. The final map will have multiple sets of these, but right now, I am working on getting one to display correctly:
library(tidyverse)
library(DiagrammeR)
nodes <- create_node_df(
n=33,
nodes = 33,
label = make.unique(rep(letters, length.out = 33), sep=''),
tooltip = make.unique(rep(letters, length.out = 33), sep=''),
fontsize= 7,
shape = c("ellipse", "ellipse", rep("square", 31)),
fillcolor = "white",
width = 1,
height = 1,
)
# lines
edges <- create_edge_df(
from=c(1,rep(2,32)),
to = c(2,3,seq(3, 33, 1)),
)
create_graph(nodes_df = nodes,
edges_df = edges,
) %>%
render_graph(layout="tree")
This renders as:
However, what I am going for is more like:
Related
Aim
Giving a different color to a table's cells according to numerical threshold(s).
R Package
gt
Reproducible example
mydata <- structure(list(none = c(4, 4, 25, 18, 10), light = c(2, 3, 10,
24, 6), medium = c(3, 7, 12, 33, 7), heavy = c(2, 4, 4, 13, 2
)), row.names = c("SM", "JM", "SE", "JE", "SC"), class = "data.frame")
Using the above dataset, I can produce a table (however crude), using the following code:
mytable <- gt::gt(mydata)
Where I got stuck
It must be really easy, but I can wrap my head around how to assign (say) red to the cells where the value is (say) larger than 20 AND blue to cells whose value is (say) smaller than 10. It's days now that I am trying to do a little of google search (example HERE), but I could not find a solution. It must be pretty simple but no success so far. My best guess is using the tab_style() function, but I am at loss of understanding how to tune the parameters to get what I am after.
This isn't ideal if you have an arbitrarily large data frame, but for an example of your size it's certainly manageable, imo. I generalized the tests as separate functions to reduce additional code duplication and make it easier to adjust your conditional parameters.
If you're looking for a more generalized solution it would be to look over a vector of columns, as described here.
library(gt)
isHigh <- function(x) {
x > 20
}
isLow <- function(x) {
x < 10
}
mydata %>%
gt() %>%
tab_style(
style = list(
cell_fill(color = 'red'),
cell_text(weight = 'bold')
),
locations =
list(
cells_body(
columns = none,
rows = isHigh(none)
),
cells_body(
columns = light,
rows = isHigh(light)
),
cells_body(
columns = medium,
rows = isHigh(medium)
),
cells_body(
columns = heavy,
rows = isHigh(heavy)
)
)
) %>%
tab_style(
style = list(
cell_fill(color = 'lightblue'),
cell_text(weight = 'bold')
),
locations =
list(
cells_body(
columns = none,
rows = isLow(none)
),
cells_body(
columns = light,
rows = isLow(light)
),
cells_body(
columns = medium,
rows = isLow(medium)
),
cells_body(
columns = heavy,
rows = isLow(heavy)
)
)
)
On the basis of the comment I got, and after having read the earlier post here on SO, I came up with the following:
Create a dataset to work with:
mydata <- structure(list(none = c(4, 4, 25, 18, 10), light = c(2, 3, 10,
24, 6), medium = c(3, 7, 12, 33, 7), heavy = c(2, 4, 4, 13, 2
)), row.names = c("SM", "JM", "SE", "JE", "SC"), class = "data.frame")
Create a 'gt' table:
mytable <- gt::gt(mydata)
Create a vector of columns name to be later used inside the 'for' loops:
col.names.vect <- colnames(mydata)
Create two 'for' loops, one for each threshold upon which we want our values to be given different colors (say, a RED text for values > 20; a BLUE text for values < 5):
for(i in seq_along(col.names.vect)) {
mytable <- gt::tab_style(mytable,
style = gt::cell_text(color="red"),
locations = gt::cells_body(
columns = col.names.vect[i],
rows = mytable$`_data`[[col.names.vect[i]]] > 20))
}
for(i in seq_along(col.names.vect)) {
mytable <- gt::tab_style(mytable,
style = gt::cell_text(color="blue"),
locations = gt::cells_body(
columns = col.names.vect[i],
rows = mytable$`_data`[[col.names.vect[i]]] < 5))
}
This seems to achieve the goal I had in mind.
I'm trying to visualize my network with visNetwork package. But I found myself totally confused about controling node size and edge width. In the first example, I set value=1 in nodes and value=0.1in edges. In the second example, I set value=10 in nodes and width=0.1 in edges. However, in both graphs, size of nodes appear to be the same. Changing edge width seems to work with width not value. I don't know why. I did see people use value in edges for edge width control.
Can anyone clarify me on this issue? Also, what is the range of values for node size and edge width?
nodes1 <- data.frame(id = 1:10,
label = paste("Node", 1:10),# add labels on nodes
value = 1, #**
color = c("darkblue"))
edges1 <- data.frame(from = sample(1:10,8),
to = sample(1:10, 8),
value = 0.1 #**
)
visNetwork::visNetwork(nodes1, edges1, width = "150%", physics=F)
nodes2 <- data.frame(id = 1:10,
label = paste("Node", 1:10),# add labels on nodes
value = 10, #**
color = c("darkblue"))
edges2 <- data.frame(from = sample(1:10,8),
to = sample(1:10, 8),
width = 0.1 #**
)
visNetwork::visNetwork(nodes2, edges2, width = "150%", physics=F)
it looks like size of the nodes works based on comparison . If it is set one value than graph just reflect the same size of nodes on optimal scale, thus it is not changed
if you put value equal to different number you'll see nodes of different size
nodes2 <- data.frame(id = 1:10,
label = paste("Node", 1:10),# add labels on nodes
value = 1:10, #**
color = c("darkblue"))
edges2 <- data.frame(from = sample(1:10,8),
to = sample(1:10, 8),
width = 0.1 #**
)
visNetwork::visNetwork(nodes2, edges2, width = "150%", physics=F)
Using VennDiagram package I'm generating two graphs in the following manner:
# First graph
VennDiagram::draw.pairwise.venn(
area1 = 100,
area2 = 70,
cross.area = 30,
category = c("A1", "B1"),
fill = c("#00204DFF", "#FFEA46FF")
) -> vg1
# Second graph
VennDiagram::draw.pairwise.venn(
area1 = 120,
area2 = 80,
cross.area = 10,
category = c("A2", "B2"),
fill = c("#000004FF", "#FCFFA4FF")
) -> vg2
When called via grid::grid.draw(vg1) and grid::grid.draw(vg2) the charts show as expected:
grid::grid.draw(vg1)
grid::grid.draw(vg2)
Question
How can I create one grid object where both plots are placed one under another?
Attempt
grdFrme <- grid::grid.frame(name = "gf")
grid::grid.pack("gf", vg1)
Error in packGrob(grid.get(gPath), grob, side, row, row.before,
row.after, : invalid 'grob'
Desired results
One solution could be to use awesome multipanelfigure package (fill the panels with base, 'lattice', 'ggplot2' and 'ComplexHeatmap' plots, grobs, and PNG, JPEG, SVG and TIFF images).
library(multipanelfigure)
figure <- multi_panel_figure(columns = 1, rows = 2)
figure %<>%
fill_panel(vg1) %<>%
fill_panel(vg2)
I want to create a PAG(parental ancestral graph) with visNetwork for my shiny app.
In order to do that i have to create edges that have both circles and arrows.
According to the visNetwork package i can convert the arrows to circles like this
visNetwork(nodes, edges) %>%
visEdges(arrows = list(to = list(enabled = TRUE,
scaleFactor = 2, type = 'circle')))
But i want to have both an arrow and a circle, or two circles in one edge like in this picture
PAG
The arrows.from.type and arrows.to.type seem to be working but i now i have this problem.
I want to draw this graph according to an adjacency matrix
So i have this code
i = 1
j = 1
for(i in i:ncol(results))
{
j = i
for(j in j:nrow(results))
{
if(results[j,i]==1)
{
dashBoard = c(dashBoard,TRUE)
colorBoard = c(colorBoard, "green")
if(results[i,j]==1)
{
fromtest <- c(fromtest,Cnames[i])
totest <- c(totest,Rnames[j])
arrfrom <-c(arrfrom,"circle")
arrto<-c(arrto,"circle")
}
else if(results[i,j]==2)
{
fromtest<-c(fromtest,Cnames[i])
totest<-c(totest,Rnames[j])
arrfrom <-c(arrfrom,"circle")
arrto<-c(arrto,"arrow")
}}
That goes on for every possible combination except 1,1 and 1,2
In the end the edges are printed like that
edgesprint <-data.frame(from = fromtest,
to = totest,
arrows.from.type=arrfrom,
arrows.to.type=arrto,
dashes = dashBoard,
physics = FALSE,
smooth = FALSE,
width = 3,
shadow = TRUE,
color = list(color = colorBoard, highlight = "red", hover = "green"),
links = links)
This method works good but sometimes without changing any code i get this error
error in data.frame arguments imply differing number of rows
You can set individual arrow types in the edges data frame by adding columns arrows.to.type and arrows.from.type:
library(visNetwork)
library(magrittr)
nodes <- data.frame(id=c("a","b","c","d"), label=c("a","b","c","d"))
edges <- data.frame(
from = c("a","a","a"),
to = c("b","c","d"),
arrows.from.type = c(NA,"circle","circle"),
arrows.to.type = c("arrow","circle",NA)
)
visNetwork(nodes, edges)
Result:
This approach works for all other attributes you can set through visNodes and visEdges. See here for an example.
I am new to R.
I want to create a massive tree diagram that represent a Lotto game in R that looks like Tree Diagram 1 in this picture(I made it via PowerPoint):
The problem is I need to draw 6 balls out of 45 balls. The totally elements in this case will be 127. I tried to create a tree diagram using PowerPoint and it looks like Tree Diagram 2.
Then I gave up. I can't type "match' and "no match" and calculate the probability manually for such a massive diagram.
How can I create a tree diagram that looks like Tree Diagram 2 that has similar labels in Tree Diagram 1?
The DiagrammeR package should be helpful:
library(DiagrammeR)
nodes <- create_nodes(nodes = 1:7, type = "number")
edges <- create_edges(from = c(1, 1, 2, 2, 3, 3),
to = c(2, 3, 4, 5, 6, 7),
rel = "leading to")
graph <- create_graph(nodes_df = nodes,
edges_df = edges,
graph_attrs = "layout = dot",
node_attrs = "fontname = Helvetica",
edge_attrs = "color = gray20")
# View the graph
render_graph(graph)
You can get "fancy" with the programming and labels accordingly:
nodes <- create_nodes(nodes = 1:7, type = "number",
label = c("Lotto", rep(c("match", "no match"), times = 3)))
### Same Code as Above...