R 闪亮:使用动态渲染';带ActionLink和shinyJS的s

R 闪亮:使用动态渲染';带ActionLink和shinyJS的s,r,shiny,shinyjs,R,Shiny,Shinyjs,我正在构建一个仪表板,需要在其中创建一些框(基于提供的数据集),然后让每个框能够单击并显示子集框 如果我事先知道数据,我可以这样做,但在动态创建内容时,我在创建链接id和显示和隐藏内容方面遇到困难 下面是它应该如何工作的代码(但使用静态内容) 我没有仔细阅读您的帖子,但我认为您需要将shinnput.onInputChange('last_btn',this.id)替换为shinn.setInputValue('last_btn',this.id,{priority:'event'})。这样,即

我正在构建一个仪表板,需要在其中创建一些框(基于提供的数据集),然后让每个框能够单击并显示子集框

如果我事先知道数据,我可以这样做,但在动态创建内容时,我在创建
链接id
显示和隐藏内容方面遇到困难

下面是它应该如何工作的代码(但使用静态内容)


我没有仔细阅读您的帖子,但我认为您需要将
shinnput.onInputChange('last_btn',this.id)
替换为
shinn.setInputValue('last_btn',this.id,{priority:'event'})
。这样,即使
input$last_btn
的值没有改变,只要你点击两次按钮,
observeEvent
就会被触发。啊,我差一点就到了!它工作得很好,谢谢@Stéphanelant一如既往!我在JS方面很糟糕,所以如果我在网上找不到它,我就会迷路。请随意将其作为答案发布,我会接受的。
library(shiny)
library(shinydashboard)
library(shinyjs)


#####/UI/####

header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
  useShinyjs(),
  fluidRow(
    uiOutput("box1"),
    uiOutput("box2"),
    uiOutput("box3")
  ),
  fluidRow(
    div(id = "ILRow",
        uiOutput("box1a"),
        uiOutput("box1b"),
        uiOutput("box1c")
        ),
    div(id = "NCRow",
        uiOutput("box2a"),
        uiOutput("box2b")
        ),
    div(id = "INRow",
        uiOutput("box3a")
        )
  )
)

ui <- dashboardPage(header, sidebar, body)



#####/SERVER/####
server <- function(input, output) { 

  CSRbox <- function(description = NULL, linkName = NULL) {

    # the box tags
    withTags(
      # col
      div(
        class = "col-md-2",
        # Widget: user widget style 1
        div(
          class = "box",
          ## Box Header ##
          div(
            actionLink(linkName, NULL, icon = icon("plus-square-o", "fa-2x")),
            h2(description)
          )
        )
      )
    )
  }

  dat <- data.frame(State = c("Illinois","Illinois","Illinois","North Carolina","North Carolina","Indiana"), City = c("Chicago","Niles","Evanston","Charlotte","Raleigh","West Lafayette"))

  output$box1 <- renderUI({
    CSRbox("Illinois", "Ill_Link")
    })

  output$box2 <- renderUI({
    CSRbox("North Carolina", "NC_Link")
  })

  output$box3 <- renderUI({
    CSRbox("Indiana", "IN_Link")
  })

  output$box1a <- renderUI({
    CSRbox("Chicago", "CH_Link")
  })

  output$box1b <- renderUI({
    CSRbox("Niles", "NI_Link")
  })

  output$box1c <- renderUI({
    CSRbox("Evanston", "EV_Link")
  })

  output$box2a <- renderUI({
    CSRbox("Charlotte", "CA_Link")
  })

  output$box2b <- renderUI({
    CSRbox("Raleigh", "RL_Link")
  })

  output$box3a <- renderUI({
    CSRbox("West Lafayette", "WL_Link")
  })

  shinyjs::hide("ILRow")
  shinyjs::hide("NCRow")
  shinyjs::hide("INRow")

  observeEvent(input$Ill_Link, {
    shinyjs::toggle("ILRow")
    shinyjs::hide("NCRow")
    shinyjs::hide("INRow")
  })

  observeEvent(input$NC_Link, {
    shinyjs::toggle("NCRow")
    shinyjs::hide("ILRow")
    shinyjs::hide("INRow")
  })

  observeEvent(input$IN_Link, {
    shinyjs::toggle("INRow")
    shinyjs::hide("ILRow")
    shinyjs::hide("NCRow")
  })



  }

shinyApp(ui, server)
library(shiny)
library(shinydashboard)
library(shinyjs)


#####/UI/####

header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
  useShinyjs(),
  fluidRow(
    uiOutput("boxLevel1")
  ),
  fluidRow(
    div(id = "LevelDetail",
        uiOutput("boxLevel2")
        )
  )
)

ui <- dashboardPage(header, sidebar, body)



#####/SERVER/####
server <- function(input, output) { 

  CSRbox <- function(description = NULL, linkName = NULL) {

    # the box tags
    withTags(
      # col
      div(
        class = "col-md-2",
        # Widget: user widget style 1
        div(
          class = "box",
          ## Box Header ##
          div(
            actionLink(linkName, NULL, icon = icon("plus-square-o", "fa-2x")),
            h2(description)
          )
        )
      )
    )
  }

  dat <- data.frame(State = c("Illinois","Illinois","Illinois","North Carolina","North Carolina","Indiana"), City = c("Chicago","Niles","Evanston","Charlotte","Raleigh","West Lafayette"))



  output$boxLevel1 <- renderUI({

    lapply(sort(unique(dat$State)), function(name) {

      CSRbox(name, paste0(name,"Link"))

    })
  })

  output$boxLevel2 <- renderUI({

    temp <- dat[dat$State == "Illinois",] #Should be based of off the input$Click of the Input Link. Ex: input$Illinois

    lapply(sort(unique(temp$City)), function(name) {

      CSRbox(name, paste0(name,"Link2"))

    })
  })

  shinyjs::hide("LevelDetail")

  observeEvent(input$IllinoisLink, { #Would need to loop through and make an observeEvent for each possible input$click
    shinyjs::toggle("LevelDetail")
  })

  }

shinyApp(ui, server)
library(shiny)
library(shinydashboard)
library(shinyjs)


#####/UI/####

header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
  useShinyjs(),
  tags$head(tags$script(HTML("$(document).on('click', '.needed', function () {
                                Shiny.onInputChange('last_btn',this.id);
                             });"))),
  fluidRow(
    uiOutput("boxLevel1"),
    textOutput("lastButtonCliked")
  ),
  fluidRow(
    div(id = "LevelDetail",
        uiOutput("boxLevel2")
        )
  )
)

ui <- dashboardPage(header, sidebar, body)



#####/SERVER/####
server <- function(input, output) { 

  CSRbox <- function(description = NULL, linkName = NULL) {

    # the box tags
    withTags(
      # col
      div(
        class = "col-md-2",
        # Widget: user widget style 1
        div(
          class = "box",
          ## Box Header ##
          div(
            actionLink(linkName, NULL, icon = icon("plus-square-o", "fa-2x"), class="needed"),
            h2(description)
          )
        )
      )
    )
  }

  dat <- data.frame(State = c("Illinois","Illinois","Illinois","North Carolina","North Carolina","Indiana"), City = c("Chicago","Niles","Evanston","Charlotte","Raleigh","West Lafayette"))

  output$boxLevel1 <- renderUI({

    lapply(sort(unique(dat$State)), function(name) {

      CSRbox(name, paste0(name))

    })
  })

  output$boxLevel2 <- renderUI({

    temp <- dat[dat$State == input$last_btn,] #Should be based of off the input$Click of the Input Link. Ex: input$Illinois

    lapply(sort(unique(temp$City)), function(name) {

      CSRbox(name, paste0(name,"Link2"))

    })
  })

  avs <- reactiveValues(
    clickN = NA, #new click
    clickO = NA, #original click
    dataSame = TRUE #data sets are the same
  )

  observe({
    avs$clickN <- input$last_btn
  })

  shinyjs::hide("LevelDetail")

  observeEvent(input$last_btn, {

    avs$dataSame <- identical(avs$clickN, avs$clickO)

    if(!avs$dataSame) {
      shinyjs::show("LevelDetail")
      avs$clickO <- avs$clickN
    } else {
      shinyjs::hide("LevelDetail")
      avs$clickO <- NULL
    }
  })

  }

shinyApp(ui, server)