我正在尝试制作一个Shiny应用程序，用户可以在其中选择一些选项，并根据输入内容显示一个网络和数据表。我有一个饮食研究数据库，希望用户能够指定他们感兴趣的捕食动物种类，饮食指标（体重，体积等）以及希望节点识别的分类标准。数据表工作正常（因此我不包括代码），并根据输入进行了更新，但网络没有变化，它仅显示所有数据。当我运行用于在Shiny之外生成图的代码时，它工作正常。这是我的第一次闪亮尝试，因此任何建议将不胜感激。
library(dplyr)
library(igraph)
library(networkD3)
Diet <-data.frame(
Predator_Scientific_Name = rep("Acanthocybium solanderi", 10),
Class_Predator = rep("Actinopterygii", 10),
Order_Predator = rep("Perciformes", 10),
Family_Predator = rep("Scombridae", 10),
Genus_Predator = rep("Acanthocybium", 10),
Species_Predator = rep("solandri", 10),
Class_Prey = rep("Actinopterygii", 10),
Order_Prey = c( "Clupeiformes" , NA , "Perciformes", "Perciformes", "Perciformes", "Perciformes", "Perciformes", "Perciformes", "Tetraodontiformes", "Tetraodontiformes"),
Family_Prey = c("Clupeidae", NA, "Coryphaenidae", "Carangidae", "Scombridae","Echeneidae","Carangidae", "Scombridae", "Balistidae","Diodontidae"),
Genus_Prey = c("Sardinella", NA, "Coryphaena", "Decapterus", "Euthynnus", NA, NA, NA, "Balistes", "Diodon"),
Species_Prey = c("aurita" , "", "hippurus", "punctatus","alletteratus", "", "", "","capriscus", "spp." ),
Lowest_Taxonomic_Identification_Prey = c("Sardinella aurita","Actinopterygii","Coryphaena hippurus","Decapterus punctatus","Euthynnus alletteratus", "Echeneidae", "Carangidae","Scombridae","Balistes capriscus","Diodon spp."),
Frequency_of_Occurrence = c(2.8, 59.1, 1.4, 7.0, 1.4, 1.4, 15.5, 21.1, 2.8, 4.2), StringAsFactors = FALSE
)
pred.name <- unique(Diet$Predator_Scientific_Name)
prey.tax <- unique(Diet$Lowest_Taxonomic_Identification_Prey)
#Progress bar function
compute_data <- function(updateProgress = NULL) {
# Create 0-row data frame which will be used to store data
dat <- data.frame(x = numeric(0), y = numeric(0))
for (i in 1:10) {
Sys.sleep(0.25)
# Compute new row of data
new_row <- data.frame(x = rnorm(1), y = rnorm(1))
# If we were passed a progress update function, call it
if (is.function(updateProgress)) {
text <- paste0("x:", round(new_row$x, 2), " y:", round(new_row$y, 2))
updateProgress(detail = text)
}
# Add the new row of data
dat <- rbind(dat, new_row)
}
dat
}
####
# Define UI for application that draws a histogram
ui <- dashboardPage(
skin = "blue",
dashboardHeader(title = "Diet Database"),
dashboardSidebar(
sidebarMenu(
menuItem("Parameters",
tabName = "paramaters",
icon = shiny::icon("bar-chart")))
),
dashboardBody(
tabItems(
tabItem(
tabName = "paramaters",
fluidRow(
shiny::column(
width = 4,
shinydashboard::box(
title = "Predator",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
width = NULL,
shiny::helpText("Select a predator to view its connections and prey items:"),
shiny::selectInput(
"pred",
shiny::h5("Predator Scientific Name:"),
c(NA,pred.name))),
shinydashboard::box(
title = "Prey",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
width = NULL,
shiny::helpText("Select a prey taxa to view its connections and predators:"),
shiny::selectInput(
"prey",
shiny::h5("Prey Taxa:"),
c(NA,prey.tax))),
shinydashboard::box(
title = "Diet Metric",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
width = NULL,
shiny::helpText("Select a diet metric to use:"),
shiny::selectInput(
"dietmetric",
shiny::h5("Diet Metric:"),
c("Frequency of Occurrence" = "Frequency_of_Occurrence",
"Wet Weight" = "Weight",
"Dry Weight" = "Dry_Weight",
"Volume" = "Volume",
"Index of Relative Importance" = "IRI",
"Index of Caloric Importance" = "ICI",
"Number" = "Number"))),
shinydashboard::box(
title = "Taxonomic Level",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
width = NULL,
shiny::helpText("Select a taxonomic level of nodes:"),
shiny::selectInput(
"nodetax",
shiny::h5("Taxonomic Level:"),
c("Order" = "Order",
"Family" = "Family",
"Genus" = "Genus",
"Species" = "Species"))),
shinydashboard::box(
title = "Generate Network",
status = "primary",
solidHeader = T,
collapsible = T,
width = NULL,
actionButton("makenet", "Generate")
)
),
#Area for network to be displayed
shiny::column(
width = 8,
shinydashboard::box(
title = "Trophic Network",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
width = NULL,
forceNetworkOutput("netplot")
)
)
))
)))
server <- function(input, output, session) {
network.data <- eventReactive(input$makenet, {
edgelist <- Diet %>% filter(Predator_Scientific_Name == input$pred|Lowest_Taxonomic_Identification_Prey == input$prey
) %>% select(
paste(input$nodetax, "Predator", sep = "_"),
Class_Predator,
paste(input$nodetax, "Prey", sep = "_"),
Class_Prey,
input$dietmetric
)
colnames(edgelist) <- c("SourceName",
"SourceClass",
"TargetName",
"TargetClass",
"Weight")
edgelist <- edgelist[complete.cases(edgelist),]
})
output$netplot <- renderForceNetwork( {
network.data()
ig <-igraph::simplify(igraph::graph_from_data_frame(edgelist[,c(1,3,5)], directed = TRUE))
SourceID <- TargetID <- c()
for (i in 1:nrow(edgelist)) {
SourceID[i] <- which(edgelist[i,1] == V(ig)$name)-1
TargetID[i] <- which(edgelist[i,3] == V(ig)$name)-1
}
#Create edgelist that contains source and target nodes and edge weights
edgeList <- cbind(edgelist, SourceID, TargetID)
nodeList <- data.frame(ID = c(0:(igraph::vcount(ig) - 1)),
nName = igraph::V(ig)$name)
#Determine and assign groups based on class
preddf <-
data.frame(SciName = edgelist[, 1], class = edgelist[, 2])
preydf <-
data.frame(SciName = edgelist[, 3], class = edgelist[, 4])
groupsdf <- rbind(preddf, preydf)
groupsdf <- groupsdf %>% mutate(SciName = as.character(SciName),
class = as.character(class))
nodeGroup <- c()
for (i in 1:nrow(nodeList)) {
index <- which(groupsdf[, 1] == nodeList$nName[i])
nodeGroup[i] <- groupsdf[index[1], 2]
}
nodeList <-
cbind(nodeList,
nodeGroup)
progress <- shiny::Progress$new()
progress$set(message = "Generating your network...", value = 0)
# Close the progress when this reactive exits (even if there's an error)
on.exit(progress$close())
# Create a callback function to update progress.
# Each time this is called:
# - If `value` is NULL, it will move the progress bar 1/5 of the remaining
# distance. If non-NULL, it will set the progress to that value.
# - It also accepts optional detail text.
updateProgress <- function(value = NULL, detail = NULL) {
if (is.null(value)) {
value <- progress$getValue()
value <- value + (progress$getMax() - value) / 5
}
progress$set(value = value, detail = detail)
}
# Compute the new data, and pass in the updateProgress function so
# that it can update the progress indicator.
compute_data(updateProgress)
networkD3::forceNetwork(
Links = edgeList,
# data frame that contains info about edges
Nodes = nodeList,
# data frame that contains info about nodes
Source = "SourceID",
# ID of source node
Target = "TargetID",
# ID of target node
Value = "Weight",
# value from the edge list (data frame) that will be used to value/weight relationship amongst nodes
NodeID = "nName",
# value from the node list (data frame) that contains node
Group = "nodeGroup",
# value from the node list (data frame) that contains value we want to use for node color
fontSize = 25,
opacity = 0.85,
zoom = TRUE,
# ability to zoom when click on the node
opacityNoHover = 0.4 # opacity of labels when static
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
答案 0 :(得分：0)
我正在共享我的固定代码，以防将来对某人有所帮助。我基本上只是更改了服务器代码的顶部。
network.data <- eventReactive(input$makenet, {
Diet %>% filter(Predator_Scientific_Name == input$pred|Lowest_Taxonomic_Identification_Prey == input$prey
) %>% select(
paste(input$nodetax, "Predator", sep = "_"),
Class_Predator,
paste(input$nodetax, "Prey", sep = "_"),
Class_Prey,
input$dietmetric
) %>% rename("SourceName" = paste(input$nodetax, "Predator", sep = "_"),
"SourceClass" = Class_Predator,
"TargetName" = paste(input$nodetax, "Prey", sep = "_"),
"TargetClass" = Class_Prey,
"Weight" = input$dietmetric) %>% na.omit()
})
output$netplot <- renderForceNetwork( {
edgelist <- network.data()