Networkd3 отображает все данные, а не подмножество, которое я хочу показать на основе входных данных виджета в приложении Shiny.

Я пытаюсь создать приложение 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)