Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- library(shinycssloaders)
- library(shiny)
- library(shinyWidgets)
- library(DiagrammeR)
- library(tidyverse)
- library(shiny)
- library(shinyjs)
- library(shinythemes)
- # load data
- # circle nodes & edges
- circle_nodes <- read.csv(header = T, file = "data/circle_nodes.csv")
- # head(circle_nodes)
- # Node Type Pillar Shape Pos.x Pos.y
- # 1 1 H1 S plaintext 1.715 2.150
- # 2 4 H2 S plaintext 2.272 1.549
- # 3 6 H3 S plaintext 2.628 0.811
- # 4 9 H4 S plaintext 2.750 0.000
- # 5 10 H4 S plaintext 2.628 -0.811
- # 6 52 blank S plaintext 2.272 -1.549
- circle_edges <- read.csv(header = T, file = "data/circle_edges.csv")
- # head(circle_edges)
- # from to color penwidth
- # 1 1 4 #B3E2CD 6
- # 2 4 6 #B3E2CD 6
- # 3 6 9 #B3E2CD 6
- # 4 9 10 #B3E2CD 6
- # 5 10 52 #FFFFFF 6
- # 6 52 53 #FFFFFF 6
- # centre nodes & edges
- centre_nodes <- read.csv(header = T, file = "data/centre_nodes.csv")
- #head(centre_nodes)
- # Node Type Initiated Complete Info Shape
- # 1 A Centre Y N Lorem ipsum dolor sit amet, in vocent accusam argumentum circle
- # 2 B Centre N N sit amet, in vocent accusam argumentum mei circle
- # 3 C Centre N N summo admodum suavitate ex nam. Ex circle
- # 4 D Centre Y Y nam. Ex sonet lucilius eum, at circle
- # 5 E Centre N N at adhuc audiam tincidunt quo. Magna circle
- # 6 F Centre N N Lorem ipsum dolor sit amet, in vocent accusam argumentum circle
- centre_edges <- read.csv(header = T, file = "data/centre_edges.csv")
- #head(centre_edges)
- # From To color
- # 1 6 Q #B3E2CD
- # 2 6 A #B3E2CD
- # 3 6 I #B3E2CD
- # 4 6 O #B3E2CD
- # 5 6 B #B3E2CD
- # 6 6 C #B3E2CD
- # load functions
- circle_nodes_list <- circle_nodes %>%
- filter(!Type %in% c("blank","Pillar"))
- # Circle Node Paster Function
- circle_node_paster <- function(x) {
- paste("'",str_trim(x["Node"]),
- "' [shape = '",x[["Shape"]],
- "', width = '1', height = '1',",
- " pos = '",str_trim(x[["Pos.x"]]),",",
- x[["Pos.y"]], "!'] ",
- sep = "", collapse = "n")
- }
- # create output
- circle_node_dat <- paste(unlist(apply(circle_nodes, 1, circle_node_paster)), collapse = "")
- # Circle edge paster function
- circle_edge_paster <- function(x) {
- paste(" '",str_trim(x[["from"]]),"'--'", str_trim(x[["to"]]),
- "' [color = '",x[["color"]],
- "', penwidth = '",x[["penwidth"]],"']",
- sep = "", collapse = "")
- }
- # produce 'circle_edge_dat' grViz code
- circle_edge_dat <- paste(unlist(apply(circle_edges, 1, circle_edge_paster)),
- collapse = "")
- ## Pastable centre node code
- # Centre Node Paster Function
- centre_node_paster <- function(x) {
- paste(" '",str_trim(x["Node"]),
- "' [fillcolor = '",x[["Fill.Color"]],
- "', fontcolor = '",x[["Font.Color"]],
- "', tooltip = '",x[["Node"]],
- "', penwidth = '",str_trim(x[["Pen.Width"]]),
- "', shape = '",x[["Shape"]],"']",
- sep = "", collapse = "n")
- }
- # centre edge paster function
- centre_edge_paster <- function(x) {
- paste(" '",str_trim(x[["From"]]),"'--'", x[["To"]],
- "' [color = '",x[["color"]],
- "', penwidth = ",str_trim(x[["Pen.Width"]]),"]",
- sep = "", collapse = "")
- }
- #########
- # UI
- ui <- fluidPage(
- sidebarLayout(position = "right",
- sidebarPanel(width = 3, pickerInput(inputId = "highlight",label = "Select/Deselect Relevant Groups", choices = paste(circle_nodes_list$Node), selected = paste(circle_nodes_list$Node), options = list('actions-box' = TRUE, size = 10, 'selected-text-format' = "count > 3"),multiple = TRUE)),
- mainPanel(width = 9,
- grVizOutput('diagram', width = "100%",
- height = "800px"),
- textOutput("grViz_code"))
- )
- )
- # SERVER
- server <- function(input, output) {
- reduced_centre_nodes <-reactive({
- centre_edges %>% filter (From %in% input$highlight)
- })
- centre_edges_dataset <-reactive({
- centre_edges %>% mutate(
- Pen.Width = ifelse(From %in% unique(reduced_centre_nodes()$From), 8, 1))
- })
- centre_edge_dat <-reactive({
- paste(unlist(apply(centre_edges_dataset(), 1, centre_edge_paster)),
- collapse = "")
- })
- centre_nodes_dataset <-reactive({
- centre_nodes %>%
- mutate(Fill.Color = ifelse(Node %in% unique(reduced_centre_nodes()$To),
- "#80ADD7","grey10"),
- Pen.Width = ifelse(Node %in% unique(reduced_centre_nodes()$To),
- 8,2),
- Font.Color = ifelse(Node %in% unique(reduced_centre_nodes()$To),
- "white","gray50"))
- })
- centre_node_dat <-reactive({
- paste(unlist(apply(centre_nodes_dataset(), 1, centre_node_paster)),
- collapse = "")
- })
- viz_code <-reactive({
- paste("graph {
- graph [bgcolor = 'white',
- layout = 'neato', mode = 'KK',
- outputorder = 'edgesfirst',
- overlap = scale, splines = 'true']
- { node [fontname = 'Helvetica', pin = 'true'] ",
- circle_node_dat, # circle node data
- " edge [splines = 'curved']",
- circle_edge_dat, # circle edge data
- "} node [fontname = 'Helvetica',
- shape = 'circle',
- style = 'filled',
- color = 'black',
- fixedsize = 'true',
- fontcolor = 'gray50']",
- centre_node_dat(), # centre node data
- " edge [splines = 'curved']",
- centre_edge_dat(), # centre edge data
- " }")")
- })
- ### for some reason there are additional nodes being added 55+????
- output$diagram <- renderGrViz({
- grViz(viz_code())
- })
- }
- # Run the application
- shinyApp(ui = ui, server = server)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement