小编Ada*_*haw的帖子

在下面的 R 闪亮脚本中，我试图使功能在第一个子菜单项中，每个 selectInput 值取决于上一列中的项目选择。附上数据，也写了代码。但是我无法达到预期的结果。请运行代码并检查，我希望整个服务器逻辑只属于一个功能。谢谢，请帮忙。

library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(

  id = "tabs",
  menuItem("Charts", icon = icon("bar-chart-o"),
           menuSubItem("Sub-item 1", tabName = "subitem1"),
           menuSubItem("Sub-item 2", tabName = "subitem2")
  ))),
dashboardBody(
tabItems(tabItem("subitem1", uiOutput("brand_selector")),
         tabItem("subitem2", 4))
))
server <- shinyServer(function(input, output) {
candyData <- read.table(
text = "
Brand       Candy           value
Nestle      100Grand        Choc1
Netle       Butterfinger    Choc2
Nestle      Crunch          Choc2
Hershey's   KitKat          Choc4
Hershey's   Reeses          Choc3
Hershey's   Mounds          Choc2
Mars        Snickers        Choc5
Nestle      100Grand        Choc3
Nestle      Crunch          Choc4
Hershey's   KitKat …

给定的 visNetwork 脚本创建 visNetwork 图，如下面的快照所示。我的问题是，如果您看到第一个和第二个节点，则两者之间的边缘是弯曲的。有没有一种方法可以使边缘变直而不改变边缘的长度。附上截图供参考，请帮忙。

library(visNetwork)
nodes <- data.frame(id = 1:10,color = c(rep("blue",6), rep("red",3), 
rep("green",1)))
edges <- data.frame(from = c(1,2,3,3,4,5,6,7,8,9), to = 
c(2,3,4,8,5,6,7,8,9,10),length = c(2,1,1,1,1,1,1,1,1,1))
nodes = data.frame(nodes, level = edges$from)
visNetwork(nodes, edges, height = "500px", width = "100%") %>% 
visOptions(highlightNearest = list(enabled = T, degree = 2, hover = T)) %>%
visOptions(highlightNearest = F, nodesIdSelection = F, width = 500, height = 
500,autoResize = F) %>%
visEdges(smooth = T) %>% 
addFontAwesome() %>% visHierarchicalLayout(edgeMinimization = T,  
blockShifting = T , …

下面的 R 闪亮脚本创建了三个 selectInput，以便每个 selectInput 的值取决于前一个 selectInput 的输入值。例如，在脚本的数据中，“value”列值取决于“Candy”列，“Candy”列值取决于“Brand”。问题是，无论我在“Brand”列中选择“Mars”还是“Netle”值，两者对应的“Candy”值“100Grand”都是相同的，因此我没有看到值列发生变化selectInput 正在读取相同的值。请帮助我解决这个问题，还请确保脚本不会变慢。谢谢。

candyData <- read.table(
text = "
Brand       Candy           value
Mars        100Grand        Choc1
Netle       100Grand        Choc2
Nestle      Crunch          Choc3",
header = TRUE,
stringsAsFactors = FALSE)
library(shiny)
library(shinydashboard)
submenuUI <- function(id) {
ns <- NS(id)
tagList(
box(title = "Data", status = "primary", solidHeader = T, width = 12,
    fluidPage(
      fluidRow(

        column(2,offset = 0, style='padding:1px;',

selectInput(ns("Select1"),"select1",unique(candyData$Brand))),
        column(2,offset = 0,

style='padding:1px;',selectInput(ns("Select2"),"select2",choices = NULL)),
        column(2, offset = 0,

style='padding:1px;',selectInput(ns("Select3"),"select3",choices=NULL ))
      )))
)
}
submenuServ <- function(input, …