【问题标题】:Dynamically choose inputs based on reactive subset data in shiny根据闪亮的反应性子集数据动态选择输入
【发布时间】:2017-09-05 07:31:49
【问题描述】:

设置: 我已经构建了一个带有两个绘图的闪亮应用程序。我使用flexdashboard-package 在两个选项卡中创建了两个图。此外,我在 R-markdown 中编写了整个闪亮应用程序。

现在我想创建一个界面,用户可以在其中对数据进行子集化。该部分本身有效。但是,在我绘制两个图之前,我还需要对子集数据执行一些计算。

有什么方法可以将mydata 之类的子集对象转换为数据框?我的问题是我还需要在其他绘图的 UI 部分中使用这个子集对象。

编辑:我特别需要一些方法将我的选择从checkboxGroupInput 传输到selectInput("cat_1"," category 1:",choices = levels(mydata()$mycat)

### 1. Create some sample data
myrows<-sample(letters,12)
exdata<- data.frame(mycat=rep(myrows,2),yr=rep(1:2,each=12),KPI_1=rnorm(24),
                    KPI_2=round(runif(24,1,20)),KPI_3=rbinom(24,6,0.5))

### 2. UI part
fluidPage(fluidRow(
  checkboxGroupInput("comp", "Categories",myrows,myrows,inline=TRUE),
  actionButton("go", "Update"),
  textOutput("txt"),
  tableOutput("head"))
)

### 3. Server part
mydata<-eventReactive(input$go,{
  res<-subset(exdata,mycat%in%input$comp)
  return(res)
  })

  output$txt <- renderText({
     paste("You chose", paste(input$comp, collapse = ", "))
   })
   output$head <- renderTable({
   mydata()
   })

在下一个块中,我这样做:

library(plotly)
library(shiny)

### 4. UI part of my plot
fluidRow(sidebarLayout(sidebarPanel(
           selectInput("cat_1",
                       "  category 1:",
                       choices = levels(mydata()$mycat),
                       selected = levels(mydata()$mycat)[1]),
           selectInput("cat_2",
                       "  category 2:",
                       choices = levels(mydata()$mycat),
                       selected = levels(mydata()$mycat)[2])),
           mainPanel(plotlyOutput("plot3", height = 300, width = 700))))

  ### 5. Server part of my plot
  output$plot3 <- renderPlotly({
  ## 5.1 Create plot data      
      cat1<-input$cat_1
      cat2<-input$cat_2
      y1<-as.numeric(mydata()[mydata()$mycat==cat1])
      y2<-as.numeric(mydata()[mydata()$mycat==cat2])
      x0<-c(1,2)

  ## 5.2 Do plot
  plot_ly(x = x0,y = y1, type="scatter",mode='lines+markers',name=Firm1) %>%
  add_trace(y = y2, name = Firm2, mode = 'lines+markers') %>%
            layout(dragmode = "select")

【问题讨论】:

  • 我无法重现您的问题,因为一切都对我有用。也许您没有显示整个代码
  • 哦,是的。对不起。将在一秒钟内添加它
  • 能否请您更新您的代码,因为很难知道它到底适合哪里。我认为您可以在服务器中创建一个对象,存储输出并在触发操作时对其进行更新,然后在 selectInput 中调用该对象
  • @akrun 很抱歉造成混乱。我已经做了。问题在selectInput("cat_1"," category 1:",choices = levels(mydata()$mycat),。显然闪亮不喜欢其输入中的动态元素。如果您想构建一个情节,这是有道理的,但如果您构建一个完整的仪表板,则不是真的
  • 我的意思是应该更改choices = levels(mydata()$mycat)

标签: r shiny


【解决方案1】:

我花了一段时间才弄清楚你的代码。所以:

1) 使用renderUI 可以让您动态创建控件

2) 坚持使用ui

3) 确保您了解 renderPlotly 以及您要绘制的内容

library(shiny)
library(plotly)

### 1. Create some sample data
myrows<-sample(letters,12)
exdata<- data.frame(mycat=rep(myrows,2),yr=rep(1:2,each=12),KPI_1=rnorm(24),
                    KPI_2=round(runif(24,1,20)),KPI_3=rbinom(24,6,0.5))


ui <- fluidPage(

  sidebarPanel(
    uiOutput("c1"),uiOutput("c2")),
  mainPanel(
    column(6,
    checkboxGroupInput("comp", "Categories",myrows,myrows,inline=TRUE),
    actionButton("go", "Update"),
    textOutput("txt"),
    tableOutput("head")),
    column(6,
    plotlyOutput("plot3", height = 300, width = 700)))
)

server <- function(input, output) {
  ### 3. Server part
  mydata <- eventReactive(input$go,{
    res<-subset(exdata,mycat%in%input$comp)
    return(res)
  })

  output$txt <- renderText({
    paste("You chose", paste(input$comp, collapse = ", "))
  })
  output$head <- renderTable({
    mydata()
  })

  conrolsdata <- reactive({
    unique(as.character(mydata()$mycat))
  })
  output$c1 <- renderUI({
    selectInput("cat_1", "Variable:",conrolsdata())
  })

  output$c2 <- renderUI({
    selectInput("cat_2", "Variable:",conrolsdata())
  })


  output$plot3 <- renderPlotly({

    if(is.null(input$cat_1)){
      return()
    }

    y1<- mydata()$KPI_1[as.character(mydata()$mycat) %in% input$cat_1]
    y2<- mydata()$KPI_2[as.character(mydata()$mycat) %in% input$cat_2]
    x0<-c(1,2)
     #use the key aesthetic/argument to help uniquely identify selected observations
     plot_ly(x = x0,y = y1, type="scatter",mode='lines+markers',name="Firm1") %>%
       add_trace(y = y2, name = "Firm2", mode = 'lines+markers') %>%
       layout(dragmode = "select")
  })

}

shinyApp(ui, server)

【讨论】:

  • 谢谢。奇怪代码的主要原因是使用了flexdashboard 和 R-markdown。鉴于我目前的经验,我建议所有在使用flexdashboard 时遇到问题的人,尝试在shiny 中(重新)创建您的应用程序。它可能会解决一些问题。很高兴学习如何申请renderUI,不知何故我在shiny 上的复习没有提到这一点。
猜你喜欢
  • 2017-11-24
  • 1970-01-01
  • 2020-08-01
  • 2018-07-31
  • 2016-12-25
  • 2019-07-17
  • 2020-07-04
  • 2018-10-07
相关资源
最近更新 更多