Анализ сети в Shiny

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

Как я могу добиться построения всех различных форматов

тех же данные, перечисленные здесь, его в основном текстового неструктурированного данные списаны с вас труба комментарий 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 \ "Космические кадеты: Фанни Warfare \" "
[8] "Это просто жалко ...."
[9] "BLEAH"
[10]" Я ненавижу treyark теперь для Кампания, заканчивающаяся «
[11]« Это не тресковый трейлер »
[12]« На самом деле это хорошая игра, потому что вы не можете стоять на твердой земле 24/7, не означает, что вам нужно плачь об этом, если тебе не нравится игра затем поиграйте с другими, не раздражайтесь об этом Activision, и сделайте нам одолжение и вернитесь в World at War, пожалуйста. »
[13]« AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAahahah! О, Боже, простите, я, это просто ... AHAHAHAHAHAHAHAHAHAHAHAHAHahahahahah! Канада строит стену! AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHA !!! ДЕЙСТВИТЕЛЬНО!?!?! AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH! » [14]« Мне нравятся последние r секунд лучшие »
[15]« Мне нравится эта игра »
[16]« Какие джунгли? лол»
[17]„рейтинг для любительниц“
[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) 

Что при запуске урожаев различных вещей, в том числе это:

И это: