SHARE
TWEET

Untitled

a guest Aug 21st, 2019 75 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. library(shinycssloaders)
  2. library(shiny)
  3. library(shinyWidgets)
  4. library(DiagrammeR)
  5. library(tidyverse)
  6. library(shiny)
  7. library(shinyjs)
  8. library(shinythemes)
  9.  
  10. # load data
  11. # circle nodes & edges
  12. circle_nodes <- read.csv(header = T, file = "data/circle_nodes.csv")
  13. # head(circle_nodes)
  14. # Node  Type Pillar     Shape Pos.x  Pos.y
  15. # 1    1    H1      S plaintext 1.715  2.150
  16. # 2    4    H2      S plaintext 2.272  1.549
  17. # 3    6    H3      S plaintext 2.628  0.811
  18. # 4    9    H4      S plaintext 2.750  0.000
  19. # 5   10    H4      S plaintext 2.628 -0.811
  20. # 6   52 blank      S plaintext 2.272 -1.549
  21.  
  22. circle_edges <- read.csv(header = T, file = "data/circle_edges.csv")
  23. # head(circle_edges)
  24. # from to   color penwidth
  25. # 1    1  4 #B3E2CD        6
  26. # 2    4  6 #B3E2CD        6
  27. # 3    6  9 #B3E2CD        6
  28. # 4    9 10 #B3E2CD        6
  29. # 5   10 52 #FFFFFF        6
  30. # 6   52 53 #FFFFFF        6
  31.  
  32. # centre nodes & edges
  33. centre_nodes <- read.csv(header = T, file = "data/centre_nodes.csv")
  34. #head(centre_nodes)
  35. # Node   Type Initiated Complete                                                      Info  Shape
  36. # 1    A Centre         Y        N Lorem ipsum dolor sit amet, in vocent accusam argumentum  circle
  37. # 2    B Centre         N        N                sit amet, in vocent accusam argumentum mei circle
  38. # 3    C Centre         N        N                       summo admodum suavitate ex nam. Ex  circle
  39. # 4    D Centre         Y        Y                            nam. Ex sonet lucilius eum, at circle
  40. # 5    E Centre         N        N                     at adhuc audiam tincidunt quo. Magna  circle
  41. # 6    F Centre         N        N Lorem ipsum dolor sit amet, in vocent accusam argumentum  circle
  42.  
  43. centre_edges <- read.csv(header = T, file = "data/centre_edges.csv")
  44. #head(centre_edges)
  45. # From To   color
  46. # 1    6  Q #B3E2CD
  47. # 2    6  A #B3E2CD
  48. # 3    6  I #B3E2CD
  49. # 4    6  O #B3E2CD
  50. # 5    6  B #B3E2CD
  51. # 6    6  C #B3E2CD
  52.  
  53. # load functions
  54. circle_nodes_list <- circle_nodes %>%
  55.   filter(!Type %in% c("blank","Pillar"))
  56.  
  57. # Circle Node Paster Function
  58. circle_node_paster <- function(x) {
  59.   paste("'",str_trim(x["Node"]),
  60.         "' [shape = '",x[["Shape"]],
  61.         "', width = '1', height = '1',",
  62.         " pos = '",str_trim(x[["Pos.x"]]),",",
  63.         x[["Pos.y"]], "!'] ",
  64.         sep = "", collapse = "n")
  65. }
  66.  
  67. # create output
  68. circle_node_dat <- paste(unlist(apply(circle_nodes, 1, circle_node_paster)), collapse = "")
  69.  
  70. # Circle edge paster function
  71. circle_edge_paster <- function(x) {
  72.   paste(" '",str_trim(x[["from"]]),"'--'", str_trim(x[["to"]]),
  73.         "' [color = '",x[["color"]],
  74.         "', penwidth = '",x[["penwidth"]],"']",
  75.         sep = "", collapse = "")
  76. }
  77.  
  78. # produce 'circle_edge_dat' grViz code
  79. circle_edge_dat <- paste(unlist(apply(circle_edges, 1, circle_edge_paster)),
  80.                            collapse = "")
  81.  
  82. ## Pastable centre node code
  83. # Centre Node Paster Function
  84. centre_node_paster <- function(x) {
  85.   paste(" '",str_trim(x["Node"]),
  86.         "' [fillcolor = '",x[["Fill.Color"]],
  87.         "', fontcolor = '",x[["Font.Color"]],
  88.         "', tooltip = '",x[["Node"]],
  89.         "', penwidth = '",str_trim(x[["Pen.Width"]]),
  90.         "', shape = '",x[["Shape"]],"']",
  91.         sep = "", collapse = "n")
  92. }
  93.  
  94. # centre edge paster function
  95. centre_edge_paster <- function(x) {
  96.   paste(" '",str_trim(x[["From"]]),"'--'", x[["To"]],
  97.         "' [color = '",x[["color"]],
  98.         "', penwidth = ",str_trim(x[["Pen.Width"]]),"]",
  99.         sep = "", collapse = "")
  100. }
  101.  
  102. #########
  103.  
  104. # UI
  105. ui <- fluidPage(
  106.   sidebarLayout(position = "right",
  107.                 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)),
  108.                 mainPanel(width = 9,
  109.                           grVizOutput('diagram', width = "100%",
  110.                                       height = "800px"),
  111.                           textOutput("grViz_code"))
  112.                 )
  113.   )
  114.  
  115. # SERVER
  116. server <- function(input, output) {
  117.  
  118.   reduced_centre_nodes  <-reactive({
  119.     centre_edges %>% filter (From %in% input$highlight)
  120.   })
  121.  
  122.   centre_edges_dataset <-reactive({
  123.     centre_edges %>% mutate(
  124.       Pen.Width = ifelse(From %in% unique(reduced_centre_nodes()$From), 8, 1))
  125.   })
  126.  
  127.   centre_edge_dat <-reactive({
  128.     paste(unlist(apply(centre_edges_dataset(), 1, centre_edge_paster)),
  129.           collapse = "")
  130.   })
  131.  
  132.   centre_nodes_dataset <-reactive({
  133.     centre_nodes %>%
  134.       mutate(Fill.Color = ifelse(Node %in% unique(reduced_centre_nodes()$To),
  135.                                  "#80ADD7","grey10"),
  136.              Pen.Width = ifelse(Node %in% unique(reduced_centre_nodes()$To),
  137.                                 8,2),
  138.              Font.Color = ifelse(Node %in% unique(reduced_centre_nodes()$To),
  139.                                  "white","gray50"))
  140.   })
  141.  
  142.   centre_node_dat <-reactive({
  143.     paste(unlist(apply(centre_nodes_dataset(), 1, centre_node_paster)),
  144.           collapse = "")
  145.   })
  146.  
  147.   viz_code <-reactive({
  148.     paste("graph {
  149.           graph [bgcolor = 'white',
  150.           layout = 'neato', mode = 'KK',
  151.           outputorder = 'edgesfirst',
  152.           overlap = scale, splines = 'true']
  153.           { node [fontname = 'Helvetica', pin = 'true'] ",
  154.           circle_node_dat, # circle node data
  155.           " edge [splines = 'curved']",
  156.           circle_edge_dat, # circle edge data
  157.           "} node [fontname = 'Helvetica',
  158.           shape = 'circle',
  159.           style = 'filled',
  160.           color = 'black',
  161.           fixedsize = 'true',
  162.           fontcolor = 'gray50']",
  163.           centre_node_dat(), # centre node data
  164.           " edge [splines = 'curved']",
  165.           centre_edge_dat(), # centre edge data
  166.           " }")")
  167.           })
  168.  
  169.   ### for some reason there are additional nodes being added 55+????
  170.   output$diagram <- renderGrViz({
  171.     grViz(viz_code())
  172.   })
  173.  
  174.   }
  175.  
  176. # Run the application
  177. shinyApp(ui = ui, server = server)
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top