如何开发一个新的反应数据框架,从另一个反应数据框架中获取列并将数据类型更改为因子或数字?

How to develop a new reactive data frame which takes columns from another reactive data frame and change data types to factor or numeric?

我使用 fileInput() 在名为 theData() 的反应性数据帧中传输数据。 我需要通过 as.factor() 函数将某些列更改为因数。我知道我无法修改反应式数据框。所以我定义了新的反应数据框,它从 checkboxGroupInput().

中获取条目

我已经问过一个类似的问题,关于更改为静态数据的因子,但由于在这种情况下,数据是由 fileInput 导入的,所以我认为问这个问题是合适的。

这是代码

####################################################
# ui.r
####################################################

library(shiny)
library(shinydashboard)
library(shinyjs)
library(dplyr)
#library(caret)

input_csv_file <- fileInput(inputId = "csv_file",label = "",multiple = F)

input_xcat <- checkboxGroupInput(inputId = "xcat", label = "select categorical x",choices = "")


# inputs ###############################



input_csv_file <- fileInput(inputId = "csv_file",label = "",multiple = F)



#Header####
dashHeader <- dashboardHeader(title = "salam")
dashSidebar <- dashboardSidebar(sidebarMenu(
  menuItem(tabName = "tab_1", text = "page 1"),
  menuItem(tabName = "tab_2", text = "page 2")
))
dashBody <- dashboardBody(
  tabItems(
    tabItem(tabName = "tab_1", 
            # csv_file ####################################################################################
            fluidRow(
              box(width = 4, height = 200, 
                  input_csv_file
              ),
              box(width = 6, height = 150,
                  verbatimTextOutput("csv_file_res")
              )
            ),
            # #############################################################################
            fluidRow(
              box(width = 4, height = 200,
                verbatimTextOutput("str_res")
              ),
              box(width = 4, height = 200,
                input_xcat
              )
            )
            
    ),
    tabItem(tabName = "tab_2")
  )
)




dashboardPage(
  header = dashHeader,
  sidebar = dashSidebar,
  body = dashBody,
  title = "salam",
  skin = "red"
)


##############################################################
# server
##############################################################



library(shiny)
library(dplyr)

server <- function(input, output, session){
  
  # file uploud ###################################

  theData <- reactive({
    if(is.null(input$csv_file)){
      return(NULL)
    }
    read.csv(input$csv_file$datapath, header = T)
  })
  
  
  
  output$csv_file_res <- renderPrint({
    head(theData() )
  })
  
  # var selection #####################################
  
  observe({
    updateCheckboxGroupInput(session = session, inputId = "xcat", label = "select categorical x", choices = names( theData() ), selected = names(theData())[2] )
  })
    
  
  
  
  # str #####################################
  
  xcat_sel <- reactive({
                        {if(is.null(input$csv_file)){
                          return(NULL)
                        }
                          input$xcat
                        }
                      })
  
  theData_2 <- reactive({if(is.null(input$csv_file)){
                          return(NULL)
                        }
                        mutate(theData(), xcat_sel() = as.factor(xcat_sel())) 
                        })
  
  output$str_res <- renderPrint( str(theData_2() )  )
  
  # end ###############################  
}




这是使用 acrossmutate 的可能解决方案。

  theData_2 <- reactive({
    mutate(theData(), across(all_of(input$xcat), as.factor))
  })

完整代码:

我做了一些小修改,比如在某些地方添加了 req 功能。

####################################################
# ui.r
####################################################

library(shiny)
library(shinydashboard)
library(shinyjs)
library(dplyr)
# library(caret)

input_csv_file <- fileInput(inputId = "csv_file", label = "", multiple = F)
input_xcat <- checkboxGroupInput(inputId = "xcat", label = "select categorical x", choices = NULL)
input_csv_file <- fileInput(inputId = "csv_file", label = "", multiple = F)


# Header####
dashHeader <- dashboardHeader(title = "salam")
dashSidebar <- dashboardSidebar(sidebarMenu(
  menuItem(tabName = "tab_1", text = "page 1"),
  menuItem(tabName = "tab_2", text = "page 2")
))
dashBody <- dashboardBody(
  tabItems(
    tabItem(
      tabName = "tab_1",
      # csv_file ####################################################################################
      fluidRow(
        box(
          width = 4, height = 200,
          input_csv_file
        ),
        box(
          width = 6, height = 150,
          verbatimTextOutput("csv_file_res")
        )
      ),
      # #############################################################################
      fluidRow(
        box(
          width = 4, height = 200,
          verbatimTextOutput("str_res")
        ),
        box(
          width = 4, height = 200,
          input_xcat
        )
      )
    ),
    tabItem(tabName = "tab_2")
  )
)

ui <- dashboardPage(
  header = dashHeader,
  sidebar = dashSidebar,
  body = dashBody,
  title = "salam",
  skin = "red"
)

server <- function(input, output, session) {
  theData <- reactive({
    req(input$csv_file)
    read.csv(input$csv_file$datapath, header = T)
  })
  output$csv_file_res <- renderPrint({
    head(theData())
  })
  observe({
    updateCheckboxGroupInput(session = session,
                             inputId = "xcat",
                             label = "select categorical x",
                             choices = names(theData()),
                             selected = names(theData())[2])
  })
  theData_2 <- reactive({
    mutate(theData(), across(all_of(input$xcat), as.factor))
  })
  output$str_res <- renderPrint({
    #str functin is also an option
    glimpse(theData_2())
    })
}

shinyApp(ui, server)