2016-12-29 42 views
1

我寫了一個用於生成網絡圖的UI,服務器和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]「我認爲使命職責的稱呼叫的新的呼叫:ARK巨人之路」
[3]「Activision必須爲了視頻遊戲而銷燬。抵制媽的那些片。 「
[4] 」FuturisticðŸ~「
[5] 」1:09是,XM 53「
[6] 」讓我們只是不...「
[7]」請願書呼籲未來的CoD \ 「太空學員:芬妮戰\」 「
[8] 」這是很可悲......「
[9] 」BLEAH「
[10]」 我恨treyark現在的活動結束「
[11]‘這是不是一個鱈魚拖車’
[12]」這實際上是一場精彩的比賽,只是因爲你沒有得到腳踏實地24/7並不意味着你必須如果你不喜歡這個遊戲,那就哭吧然後去別的玩一些不憤怒關於它動,做我們一個忙,回去戰爭世界吧。「
[13]」 AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAHahahahahahahahahahah!噢,我的上帝,我很抱歉,我只是...... AHAHAHAHAHAHAHAHAHAHAHAHahahahah!加拿大建造牆壁! AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH !!!真!?!?! 「AHAHAHAHAHAHAHAHAHAHAHAHAHAHAHAH!」 [14]「我喜歡最後的r秒最好的」
[15]「我喜歡這個遊戲」
[16]「叢林是什麼?笑」
[17]‘爲aMatures評爲’
[18]‘菲爾普斯?’

+0

請包括一些示例數據,使之重現性。 – HubertL

+0

親愛的HubertL,我附上了一個樣本數據,以及我從哪裏下載數據的鏈接 –

+0

如果我理解你的問題,你需要做的就是在'server.R'中使用'if'' else'塊檢查選擇了哪個單選按鈕,並據此調用不同的繪圖功能。 – krish

回答

5

我不得不承認我這找到一個迷人的話題,一個不錯的主意。你有大部分代碼一起然後我進行了一些優化,以反映輸入依賴關係 - 即添加了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) 

其中運行時的產量各種各樣的事情,包括這個:

enter image description here

這:

enter image description here

+0

邁克·懷斯:-)你是驚人的,救世主多謝 –

+0

這是有趣的 - 教育。但是,請接受答案,並在您獲得足夠的聲望點時才加以讚揚。 –