0

最近我问我有问题pickerInput。问题已解决，但我想知道如何仅将数据放在一个反应​​函数中而不创建另一个非数字的一列 + 两列。

在这篇文章中，我在响应式函数中使用了 mtcars（模拟我在上传文件时通常会做的事情），然后，在另一个响应式函数中，我正在对数据帧（日志和 sqrt）进行更改。但是，我想添加两个非数字列，这必须在转换后完成。

dat <- mtcars
dat$Brands <- rownames(dat)
str(dat$Brands)

> chr [1:32] "Mazda RX4" "Mazda RX4 Wag" "Datsun 710" "Hornet 4 Drive"
> "Hornet Sportabout" "Valiant" "Duster 360" "Merc 240D" ...

dat$Info <- rep("Info", length(rownames(mtcars)))
str(dat$Info)

>  chr [1:32] "Info" "Info" "Info" "Info" "Info" "Info" "Info" "Info"
> "Info" "Info" "Info" "Info" "Info" "Info" "Info" "Info" ...

在那篇文章中，如果我在 data1() 中添加两个非数字列，并pickerInput在他们回答我时留下 data()，则非数字列将不会出现选择。出于这个原因，我将所有信息放在一个单一的反应函数中......但是，现在解决方案不起作用。

每次我单击其中一个checkboxInput时，选定的列都会自动更改。

图像1

图2

这是代码：

library(shiny)
library(shinyWidgets)
library(dplyr)

ui <- fluidPage(
  
  # Application title
  titlePanel("Old Faithful Geyser Data"),
  
  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      
      uiOutput("picker"),
      
      checkboxInput("play", strong("I want to play with my data"), value = FALSE),
      
      conditionalPanel(
        condition = "input.play == 1",
        checkboxInput("change_log2", "Log2 transformation", value = FALSE),
        checkboxInput("run_sqrt", "sqrt option", value = FALSE)),
      
      
      actionButton("view", "View Selection")
      
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      h2('Mydata'),
      DT::dataTableOutput("table"),
    )
  )
)

library(shiny)
library(DT)

server <- function(session, input, output) {
  
  data <- reactive({
    dat <- mtcars
    if(input$change_log2){
      dat <- log2(dat)
    }
    
    if(input$run_sqrt){
      dat <- sqrt(dat)
    }
    
    dat$Brands <- rownames(dat)
    dat$Info <- rep("Info", length(rownames(mtcars)))
    
    return(dat)
  })
  
  
  observeEvent(input$play, {
    
    if(!input$play) {
      updateCheckboxInput(session, "change_log2", value = FALSE)
      updateCheckboxInput(session, "run_sqrt", value = FALSE)
    }
    
  })
  
  
  output$picker <- renderUI({
    pickerInput(inputId = 'pick', 
                label = 'Choose', 
                choices = colnames(data()),
                options = list(`actions-box` = TRUE),
                multiple = T,
                selected = colnames(data())
    )
  })
  
  datasetInput <- eventReactive(input$view,{
    
    datasetInput <- data() %>% 
      select(input$pick)
    
    return(datasetInput)
    
  })
  
  output$table <- renderDT({
    
    datatable(
      datasetInput(),
      filter="top", 
      rownames = FALSE,
      extensions = 'Buttons',
      
      options = list(
        dom = 'Blfrtip',
        buttons =
          list('copy', 'print', list(
            extend = 'collection',
            buttons = list(
              list(extend = 'csv', filename = "File", title = NULL),
              list(extend = 'excel', filename = "File", title = NULL)),
            text = 'Download'
          ))
      ),
      class = "display"
    )
  })
}


# Run the application 
shinyApp(ui = ui, server = server)

我想它必须是相关的updatepickerInput（我看到了类似的问题，但我不知道如何在一个独特的pickerInput.

有谁知道如何解决它？

提前致谢

问候

4

1 回答 1

1

您可以使用reactiveValues保存数据集并将该函数仅应用于从 中选择的列的数字列pickerInput。

library(shiny)
library(shinyWidgets)
library(dplyr)
library(DT)

dat <- mtcars
dat$Brands <- rownames(dat)
dat$Info <- rep("Info", length(rownames(mtcars)))


ui <- fluidPage(
  
  # Application title
  titlePanel("Old Faithful Geyser Data"),
  
  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      
      uiOutput("picker"),
      
      checkboxInput("play", strong("I want to play with my data"), value = FALSE),
      
      conditionalPanel(
        condition = "input.play == 1",
        checkboxInput("change_log2", "Log2 transformation", value = FALSE),
        checkboxInput("run_sqrt", "sqrt option", value = FALSE)),
      
      
      actionButton("view", "View Selection")
      
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      h2('Mydata'),
      DT::dataTableOutput("table"),
    )
  )
)


server <- function(session, input, output) {
  
  rv <- reactiveValues(data = dat)
  
  observeEvent(input$play, {
    
    if(!input$play) {
      updateCheckboxInput(session, "change_log2", value = FALSE)
      updateCheckboxInput(session, "run_sqrt", value = FALSE)
    }
    
  })
  
  
  output$picker <- renderUI({
    cols <- names(rv$data)
    
    pickerInput(inputId = 'pick', 
                label = 'Choose', 
                choices = cols,
                options = list(`actions-box` = TRUE),
                multiple = T,
                selected = cols)
  })
  
  datasetInput <- eventReactive(input$view,{
    
    datasetInput <- rv$data %>% select(input$pick)
    if(input$change_log2){
      datasetInput <- datasetInput %>% mutate(across(where(is.numeric), log2))
    }
    
    if(input$run_sqrt){
      datasetInput <- datasetInput %>% mutate(across(where(is.numeric), sqrt))
    }

    return(datasetInput)
    
  })
  
  output$table <- renderDT({
    
    datatable(
      datasetInput(),
      filter="top", 
      rownames = FALSE,
      extensions = 'Buttons',
      
      options = list(
        dom = 'Blfrtip',
        buttons =
          list('copy', 'print', list(
            extend = 'collection',
            buttons = list(
              list(extend = 'csv', filename = "File", title = NULL),
              list(extend = 'excel', filename = "File", title = NULL)),
            text = 'Download'
          ))
      ),
      class = "display"
    )
  })
}


# Run the application 
shinyApp(ui = ui, server = server)
于 2021-08-11T11:47:00.580 回答