r - 对数据集进行子集化不起作用，因为它每次都给出相同的数据集

问题描述

我在下面有一个闪亮的应用程序，用户在其中上传一个文件（这里我只是将 dt 放在一个反应函数中），然后他可以从那里选择他想selectInput()通过pickerInput(). 然后他应该可以点击Update并看到表格。

用户还应该能够value1通过将所有值与相乘来更新这些值，numericInput() value1并创建一个新值sliderInput()，因此也可以更新表中显示的数据框。这些更改应仅在用户单击操作按钮时应用Update2。

问题是我认为子集部分出了点问题，无论我尝试对过滤器做什么子集似乎都不起作用。Nomally when a nameis chosen only this name should be displayed in the table with relative value1of course and the same logic when I choose value1.This the relative code chunk:

output_table <- reactive({
        req(input$p1, sapply(input$p1, function(x) input[[x]]))
        dt_part <- dt2()
        for (colname in input$p1) {
            if (is.factor(dt_part[[colname]]) && !is.null(input[[colname]])) {
                dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
            } else {
                if (!is.null(input[[colname]][[1]])) {
                    dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
                }
            }
        }
        dt_part
    })

应用程序

library(shiny)
library(shinyWidgets)
library(DT)
# ui object

ui <- fluidPage(
    titlePanel(p("Spatial app", style = "color:#3474A7")),
    sidebarLayout(
        sidebarPanel(
            uiOutput("inputp1"),
            #Add the output for new pickers
            actionButton("button", "Update"),
            uiOutput("pickers"),
            numericInput("num", label = ("value"), value = 1),
            actionButton("button2", "Update 2")
        ),
        
        mainPanel(
            DTOutput("table")
            
            
        )
    )
)

# server()
server <- function(input, output, session) {
    DF1 <- reactiveValues(data=NULL)
    
    dt <- reactive({
        name<-c("John","Jack","Bill")
        value1<-c(2,4,6)
        dt<-data.frame(name,value1)
    })
    
    observe({
        DF1$data <- dt()
    })
    
    output$inputp1 <- renderUI({
        pickerInput(
            inputId = "p1",
            label = "Select Column headers",
            choices = colnames( dt()),
            multiple = TRUE,
            options = list(`actions-box` = TRUE)
        )
    })
    
    observeEvent(input$p1, {
        #Create the new pickers
        output$pickers<-renderUI({
            dt1 <- DF1$data
            div(lapply(input$p1, function(x){
                if (is.numeric(dt1[[x]])) {
                    sliderInput(inputId=x, label=x, min=min(dt1[[x]]), max=max(dt1[[x]]), value=c(min(dt1[[x]]),max(dt1[[x]])))
                }else { # if (is.factor(dt1[[x]])) {
                    selectInput(
                        inputId = x,       # The col name of selected column
                        label = x,         # The col label of selected column
                        choices = dt1[,x], # all rows of selected column
                        multiple = TRUE
                    )
                }
                
            }))
        })
    })
    
    
    dt2 <- eventReactive(input$button2, {
        req(input$num)
        dt <- DF1$data ## here you can provide the user input data read inside this observeEvent or recently modified data DF1$data
        dt$value1<-dt$value1*isolate(input$num)
        
        dt
    })
    observe({DF1$data <- dt2()})
    
    output_table <- reactive({
        req(input$p1, sapply(input$p1, function(x) input[[x]]))
        dt_part <- dt2()
        for (colname in input$p1) {
            if (is.factor(dt_part[[colname]]) && !is.null(input[[colname]])) {
                dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
            } else {
                if (!is.null(input[[colname]][[1]])) {
                    dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
                }
            }
        }
        dt_part
    })
    
    output$table<-renderDT({
        if (input$button | input$button2) {
            DF1$data
        }else return(NULL)
    })
    
}

# shinyApp()
shinyApp(ui = ui, server = server)

标签： rshiny

解决方案

我看到您想根据两个不同的变量对数据进行子集化，并且只显示一个表格。我已经更新了下面的代码。

library(shiny)
library(shinyWidgets)
library(DT)
# ui object

ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      uiOutput("inputp1"),
      #Add the output for new pickers
      actionButton("button", "Update"),
      uiOutput("pickers"),
      numericInput("num", label = ("value"), value = 1),
      actionButton("button2", "Update 2")
    ),

    mainPanel(
      DTOutput("table1") 
      #DTOutput("table2")

    )
  )
)

# server()
server <- function(input, output, session) {
  DF1 <- reactiveValues(data=NULL)

  dt <- reactive({
    name<-c("John","Jack","Bill")
    value1<-c(2,4,6)
    dt<-data.frame(name,value1)
  })

  observe({
    DF1$data <- dt()
  })

  output$inputp1 <- renderUI({
    pickerInput(
      inputId = "p1",
      label = "Select Column headers",
      choices = colnames( dt()),
      multiple = TRUE,
      options = list(`actions-box` = TRUE)
    )
  })

  observeEvent(input$p1, {
    #Create the new pickers
    output$pickers<-renderUI({
      dt1 <- dt()
      div(lapply(input$p1, function(x){
        if (is.numeric(dt1[[x]])) {
          sliderInput(inputId=x, label=x, min=min(dt1[[x]]), max=max(dt1[[x]]), value=c(min(dt1[[x]]),max(dt1[[x]])))
        }else { # if (is.factor(dt1[[x]])) {
          selectInput(
            inputId = x,       # The col name of selected column
            label = x,         # The col label of selected column
            choices = dt1[,x], # all rows of selected column
            multiple = TRUE
          )
        }

      }))
    })
  })


  # dt2 <- eventReactive(input$button2, {
  #   req(input$num)
  #   dt <- dt()  ## here you can provide the user input data
  #   #dt <- DF1$data  ## or most recently modified data DF1$data
  #   dt$value1<-dt$value1*isolate(input$num)
  # 
  #   dt
  # })
  # observe({DF1$data <- dt2()})

  output$table1<-renderDT({
    if (input$button | input$button2) {
      DF1$data
    }else return(NULL)
  })

  observeEvent(input$button2, {
    req(input$p1, input$num, sapply(input$p1, function(x) input[[x]]))
    dt_part <- dt() 
    dt_part$value1<-dt_part$value1*isolate(input$num)
    
    colname <- colnames(dt())
    for (colname in input$p1) {
      if (!is.null(input[[colname]][[1]]) && is.numeric(input[[colname]][[1]])) {
        dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
      }else {
        if (!is.null(input[[colname]])) {
          dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
        }
      }
    }
    
    DF1$data <- dt_part

    # output$table2<-renderDT({
    #   if (input$button | input$button2) {
    #     dt_part # output_table()
    #   }else return(NULL)
    # })
  })

}

# shinyApp()
shinyApp(ui = ui, server = server)

输出

r - 对数据集进行子集化不起作用，因为它每次都给出相同的数据集

问题描述

解决方案

推荐阅读