Блог

Я пытаюсь установить коды для перекодирования в блестящем веб-приложении. Однако у меня это не работает.

Вот мой код.

 library(shiny)
library(rlang)
library(dplyr)
        ui <- fluidPage(
      titlePanel("Short Form Web App"),  
      
      sidebarPanel(
        numericInput("num1","previous vector", value = NULL),
        numericInput("num2","post vector", value = NULL),
        selectInput("var","select Variable",names(mtcars)),
        textInput("new_var","new variable names")
        
    
      ),
      
      mainPanel(
        verbatimTextOutput("tab1"),
        verbatimTextOutput("tab2"),
        actionButton("do","Do")
      )
    )
    
    
    server <- function(input, output) {
      output$tab1 <- renderPrint({
        table(mtcars[["cyl"]])
        
      })
      
      rv <- reactiveValues(data = NULL)
      rv$data <- mtcars
      
      
     
      observeEvent(input$do,{
        new_var <- input$new_var
        new <- rv$data %>% transmute(!!new_var := case_when(input$var == input$num1 ~ input$num2))
        rv$data <- bind_cols(rv$data,new)
        
        output$tab2 <- renderPrint({
          
          str(rv$data)
      })
    
      })
      
      }
    
    shinyApp(ui,server)
  

То, что я пытаюсь сделать, это перекодировать предыдущий вектор в новый вектор, подобный recode , но результат продолжает отображаться NA ..
Кто-нибудь может помочь мне решить эту проблему?

Я был бы очень признателен за вашу помощь. Заранее благодарю вас.

Две проблемы:

1. Поскольку input$var это символ, сначала вам нужно преобразовать в символ, т. Е. Использовать !!sym(input$var)
2. В вашем case_when вы пропустили установку значения по умолчанию. Следовательно, будут присвоены все значения, не указанные для перекодирования NA .

Попробуйте это:

 library(shiny)
library(rlang)
library(dplyr)
ui <- fluidPage(
  titlePanel("Short Form Web App"),  
  
  sidebarPanel(
    numericInput("num1","previous vector", value = NULL),
    numericInput("num2","post vector", value = NULL),
    selectInput("var","select Variable",names(mtcars)),
    textInput("new_var","new variable names")
    
    
  ),
  
  mainPanel(
    verbatimTextOutput("tab1"),
    verbatimTextOutput("tab2"),
    actionButton("do","Do")
  )
)


server <- function(input, output) {
  output$tab1 <- renderPrint({
    table(mtcars[["cyl"]])
    
  })
  
  rv <- reactiveValues(data = NULL)
  rv$data <- mtcars
  
  
  
  observeEvent(input$do,{
    new_var <- input$new_var
    new <- rv$data %>% transmute(!!sym(new_var) := case_when(
      !!sym(input$var) == input$num1 ~ as.double(input$num2),
      TRUE ~ !!sym(input$var)))
    rv$data <- bind_cols(rv$data,new)
    
    output$tab2 <- renderPrint({
      
      str(rv$data)
    })
    
  })
  
}