我想要列出的布局(径向、对角线网络和 dendroNetwork)的单选按钮
I want a radio button for the listed layouts (radial, diagonal network and dendroNetwork)
我写了一个 UI 服务器和 global.r 来生成网络图。它适用于一种布局 (layout.fruchterman.reingold)。我想要列出的布局(径向、对角线网络和 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")))
如何绘制所有不同的格式?此处列出了相同的数据(主要是来自 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?"
我不得不承认,我发现这是一个引人入胜的话题,也是一个不错的主意。您将大部分代码放在一起 - 只需进行很少的更改,我就可以使用它。然后我优化了一点以反映输入依赖性——即添加了 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)
当 运行 产生各种东西时,包括这个:
还有这个:
我写了一个 UI 服务器和 global.r 来生成网络图。它适用于一种布局 (layout.fruchterman.reingold)。我想要列出的布局(径向、对角线网络和 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")))
如何绘制所有不同的格式?此处列出了相同的数据(主要是来自 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?"
我不得不承认,我发现这是一个引人入胜的话题,也是一个不错的主意。您将大部分代码放在一起 - 只需进行很少的更改,我就可以使用它。然后我优化了一点以反映输入依赖性——即添加了 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)
当 运行 产生各种东西时,包括这个:
还有这个: