Question

我已经编写了一个用于生成网络图的ui，server和global.r目前只适用于一种布局（layout.fruchterman.reingold），我想使用带有列出的布局的单选按钮，对角网络和dendroNetwork（下面使用R

附加代码

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")))

如何实现绘制所有不同格式

此处列出了相同的数据，其主要是文本非结构化数据从You tube comment http://ytcomments.klostermann.ca/

中删除

头（data1,18）    [1]“星球大战的召唤是一个光环的命运”    [2]“我想到了一个新的职责名称CALL OF DUTY：ARK GIANT的道路”
   [3]“为了电子游戏，必须销毁Activision。抵制那些屎。”    [4]“FuturisticðŸ〜”
   [5]“1:09是XM 53”    [6]“让我们不......”    [7]“请求下一个CoD”空间军校学员：Fanny Warfare \“”    [8]“这只是可悲的......”    [9]“BLEAH”
  [10]“我现在讨厌竞选结束”   [11]“这不是鳕鱼预告片”   [12]“这实际上是一场精彩的比赛只是因为你没有全天候站稳脚跟并不意味着你不得不为此而哭泣，如果你不喜欢这场比赛然后去玩别的而不是愤怒关于它给Activision，帮我们一个忙，回到战争世界。“   [13] “AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHahahahahahahahahahah！哦，我的上帝，我很抱歉抱歉，我，只是.... AHAHAHAHAHAHAHAHAHAHAHAHahahahah！加拿大建立墙！AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH！真的！？！？！AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH！”   [14]“我喜欢最后r秒最好”   [15]“我喜欢这个游戏”   [16]“什么丛林？哈哈”
  [17]“aMatures的评级A”
  [18]“菲尔普斯？”

Answer 1

我必须承认，我发现这是一个引人入胜的话题，也是一个好主意。您将大部分代码放在一起 - 只需进行少量更改即可实现。然后我优化了一点以反映输入依赖性 - 即添加了reactive函数。

另外我觉得你真的不想要单选按钮，你真正想要的是标签。所以我把它扔在一起 - 添加一个可以一起显示它们的选项卡：

###          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)

运行时会产生各种各样的事情，包括：

而且：

闪亮的网络分析

1 个答案: