代码之家  ›  专栏  ›  技术社区  ›  5th

根据系统中的反应子集数据动态选择输入

  •  1
  • 5th  · 技术社区  · 7 年前

    设置: 我已经创建了一个有两个情节的闪亮应用程序。我使用了 flexdashboard -打包以在两个选项卡中创建两个绘图。此外,我在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")
    
    1 回复  |  直到 7 年前
        1
  •  2
  •   5th    7 年前

    我花了一段时间才弄明白你的代码。因此:

    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)
    

    enter image description here