Search code examples
rshinygraph-visualization

I want a radio button for the listed layouts (radial, diagonal network and dendroNetwork)

I have written a UI, server and global.r for producing a network graph. It works well with one kind of layout (layout.fruchterman.reingold). I want a radio button for the listed layouts (radial, diagonal network and dendroNetwork):

Global.R file for producing the graph

###          Social Network Analysis /Word Network  ##########
###############################################################
tdm <- TermDocumentMatrix(r_stats_text_corpus,control = list(wordLenghts = c(1,Inf)))
idx <- which(dimnames(tdm)$Terms == "call")  ##change the terms to be searched 
tdm2 <- removeSparseTerms(tdm, sparse = 0.994)
m2 <- as.matrix(tdm2)
m2[m2>=1] <- 1
m2 <- m2 %*% t(m2)  ##Adjaceny Matrix
g <- graph.adjacency(m2, weighted=T, mode = "undirected")
g <- simplify(g)
V(g)$label <- V(g)$name
V(g)$degree <- degree(g)
set.seed(3952)

layout1 <- layout.fruchterman.reingold(g)

###Different Formats for Social Network Graphics

##Radial 
radial <- as.radialNetwork(fit)
radialNetwork(radial)

#Diagonal Network 
diagonalNetwork(radial, height = NULL, width = NULL, fontSize = 10,fontFamily = "serif", linkColour = "#ccc", nodeColour = "#fff",nodeStroke = "steelblue", textColour = "#111", opacity = 0.9,margin = NULL)

#Dendro Network 
dendroNetwork(fit, height = 500, width = 1000, fontSize = 10,
              linkColour = "#ccc", nodeColour = "#fff", nodeStroke = "steelblue",
              textColour = "#111", textOpacity = 0.9, textRotate = NULL,
              opacity = 0.9, margins = NULL, linkType = c("elbow", "diagonal"),
              treeOrientation = c("horizontal", "vertical"), zoom = TRUE)

Here is how my server.R looks for just the graph section  

output$sna <- renderPlot({
        plot(g, layout=layout1)

      })
And the user interface ui.r  is as below  
conditionalPanel(condition="input.tabselected==10",radioButtons("layout","Select the layout to be plotted",c("layout.fruchterman.reingold","kawai","graph_net","radialNetwork","dendroNetwork","diagonal Network")))

How can I plot all the different formats? The same data is listed here (mostly unstructured comments from YouTube Comment Scraper):

head(data1,18) 1 "Call of star wars a halos destiny"
[2] "I thought of an new call of duty name CALL OF DUTY: The road of ARK GIANT"
[3] "Activision must be destroyed for the sake of video games. Boycott those pieces of shits."
[4] "FuturisticðŸ˜"
[5] "1:09 is that the XM 53"
[6] "Lets just not..."
[7] "Petition to call next CoD \"Space Cadets: Fanny Warfare\""
[8] "This is just pathetic...."
[9] "BLEAH"
[10] "I hate treyark now for the Campaign ending"
[11] "this isn't a cod trailer"
[12] "It's actually a good game just because you don't get to stand on solid ground 24/7 doesn't mean you have to cry about it, if you don't like the game then go play something else not rage about it to Activision, and do us a favor and go back to World at War please."
[13] "AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHahahahahahahahahahah! Oh, my God, I'm sorry sorry, I, it's just.... AHAHAHAHAHAHAHAHAHAHAHAHahahahah! Canada builds wall! AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH!!! REALLY!?!?! AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH!" [14] "I like the last r seconds the best"
[15] "i love this game"
[16] "what jungle? lol"
[17] "Rated A for aMatures"
[18] "Phelps?"

Solution

  • I have to admit I find this a fascinating topic and a nice idea. You had most of the code together - with a very few changes I got it to work. Then I optimized a bit to reflect the input dependencies - i.e. added the reactive functions.

    Also I think you don't really want radio buttons here, what you really want are tabs. So I threw this together - adding a tab that can display them all together too:

    ###          Social Network Analysis /Word Network  ##########
###############################################################
library(shiny)
library(NLP)
library(tm)
library(igraph)
library(networkD3)

w <- "240px"
h <- "240px"
u <- shinyUI(fluidPage(
  titlePanel("NLP Graphs"),

  sidebarLayout(
    position = "left",
    sidebarPanel(
      h2("Controls"),
      sliderInput("sparse", "Sparsity:", 0.9, 1, 0.994,0.002),
      numericInput("fmrseed", "F-R Seed:", 1234, 1, 10000, 1)
    ),
    mainPanel(
      h2("Network Graphs"),
      tabsetPanel(
        tabPanel("Fruchterman-Reingold", plotOutput("fmr")),
        tabPanel("Dendro", dendroNetworkOutput("dendro")),
        tabPanel("Diagonal", diagonalNetworkOutput("diagonal")),
        tabPanel("Radial",radialNetworkOutput("radial")),
        tabPanel("All",
                fluidRow(column(width=6,h3("FMR",align="center"),plotOutput("fmr1")),
                         column(width=6,h3("Dendro",align="center"),dendroNetworkOutput("dendro1",width=w,height=h))),
                fluidRow(column(width=6,h3("Diagonal",align="center"),diagonalNetworkOutput("diagonal1",width=w,height=h)),
                         column(width=6,h3("Radial",align="center"),radialNetworkOutput("radial1",width=w,height=h)))
                )
      )
  )
))
)

data <- c(
  "Call of star wars a halos destiny",
  "I thought of an new call of duty name CALL OF DUTY: The road of ARK GIANT",
  "Activision must be destroyed for the sake of video games. Boycott those pieces of shits.",
  "Futuristicð",
  "1:09 is that the XM 53",
  "Lets just not...",
  "Petition to call next CoD \"Space Cadets: Fanny Warfare\"",
  "This is just pathetic....",
  "BLEAH",
  "I hate treyark now for the Campaign ending",
  "this isn't a cod trailer",
  "It's actually a good game just because you don't get to stand on solid ground 24/7 doesn't mean you have to cry about it, if you don't like the game then go play something else not rage about it to Activision, and do us a favor and go back to World at War please.",
  "AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHahahahahahahahahahah! Oh, my God, I'm sorry sorry, I, it's just.... AHAHAHAHAHAHAHAHAHAHAHAHahahahah! Canada builds wall! AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH!!! REALLY!?!?! AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH!",
  "I like the last r seconds the best",
  "i love this game",
  "what jungle? lol",
  "Rated A for aMatures",
  "Phelps?"
)

s <- shinyServer(
  function(input, output)
  {
    r_stats_text_corpus <- Corpus(VectorSource(data))

    matadj <- reactive({
      tdm <-TermDocumentMatrix(r_stats_text_corpus, control = list(wordLenghts = c(1, Inf)))
      idx <-which(dimnames(tdm)$Terms == "call") ##change the terms to be searched
      tdm2 <- removeSparseTerms(tdm, sparse = input$sparse)
      m2 <- as.matrix(tdm2)
      m2[m2 >= 1] <- 1
      m2 <- m2 %*% t(m2) ##Adjaceny Matrix - how often words co-occur in a sentence
      m2
    })

    fit <- reactive({
      fit <- hclust(dist(matadj()))
    })

    fmrlayout <- reactive({
      set.seed(input$fmrseed)
      g <- graph.adjacency(matadj(), weighted = T, mode = "undirected")
      g <- simplify(g)
      V(g)$label <- V(g)$name
      V(g)$degree <- degree(g)
      layout <- layout.fruchterman.reingold(g)
      rv <- list()
      rv$g <- g
      rv$layout <- layout
      rv
    })

    radialnet <- reactive({
      set.seed(input$fmrseed)
      radial <- as.radialNetwork(fit())
    })  

    ###Different Social Network Graphics

    #Radial Network
    output$radial <- renderRadialNetwork({
      radialNetwork(radialnet())
    })
    output$radial1 <- renderRadialNetwork({
      radialNetwork(radialnet())
    })

    #Diagonal Network
    output$diagonal <- renderDiagonalNetwork({
      diagonalNetwork(
        radialnet(),
        height = NULL,
        width = NULL,
        fontSize = 10,
        fontFamily = "serif",
        linkColour = "#ccc",
        nodeColour = "#fff",
        nodeStroke = "steelblue",
        textColour = "#111",
        opacity = 0.9,
        margin = NULL
      )
    })

    output$diagonal1 <- renderDiagonalNetwork({
      diagonalNetwork(
        radialnet(),
        height = NULL,
        width = NULL,
        fontSize = 10,
        fontFamily = "serif",
        linkColour = "#ccc",
        nodeColour = "#fff",
        nodeStroke = "steelblue",
        textColour = "#111",
        opacity = 0.9,
        margin = NULL
      )
    })

    #Dendro Network
    output$dendro <- renderDendroNetwork({
      dendroNetwork(
        fit(),
        height = 500,
        width = 1000,
        fontSize = 10,
        linkColour = "#ccc",
        nodeColour = "#fff",
        nodeStroke = "steelblue",
        textColour = "#111",
        textOpacity = 0.9,
        textRotate = NULL,
        opacity = 0.9,
        margins = NULL,
        linkType = c("elbow", "diagonal"),
        treeOrientation = c("horizontal", "vertical"),
        zoom = TRUE
      )
    })

    output$dendro1 <- renderDendroNetwork({
    dendroNetwork(
        fit(),
        height = 500,
        width = 1000,
        fontSize = 10,
        linkColour = "#ccc",
        nodeColour = "#fff",
        nodeStroke = "steelblue",
        textColour = "#111",
        textOpacity = 0.9,
        textRotate = NULL,
        opacity = 0.9,
        margins = NULL,
        linkType = c("elbow","diagonal"),
        treeOrientation = c("horizontal","vertical"),
        zoom = TRUE
      )
    })

    # Fruchterman-Reingold Network
    output$fmr <- renderPlot({
      rv <- fmrlayout()
      plot(rv$g, layout = rv$layout)
    })
    output$fmr1 <- renderPlot({
      rv <- fmrlayout()
      plot(rv$g, layout = rv$layout)
    })
  }
)

shinyApp(ui = u,server = s)

    Which when run yields various things including this:

    enter image description here

    And this:

    enter image description here