0

我正在尝试创建一个加载数据集、显示变量列表及其类并允许用户修改所选变量的类的闪亮应用程序。以下代码中的所有函数都在工作，除了 server-observeEvent 中的最后一个函数，它在尝试修改变量类时不起作用。有什么建议么？

提前谢谢你，拉米`

rm(list = ls())
library(shiny)
library(shinydashboard)
library(DT)

ui <- dashboardPage(
  dashboardHeader(title = "Shiny Example"),
  #--------------------------------------------------------------------  
  dashboardSidebar(
    sidebarMenu(
      menuItem("Data", tabName = "data", icon = icon("th"))
    )
  ),
  #--------------------------------------------------------------------
  dashboardBody(
  #--------------------------------------------------------------------
      tabItem(tabName = "data",
              fluidPage(

                fluidRow(
                  box(
                    selectInput('dataset', 'Select Dataset', list(GermanCredit = "GermanCredit",
                                                                  cars = "cars",
                                                                  iris = "iris")),
                    title = "Datasets",width = 4, status = "primary",
                    checkboxInput("select_all", "Select All Variable", value = TRUE),
                    conditionalPanel(condition = "input.select_all == false",
                                     uiOutput("show.var"))
                  ),
                  box(
                    title = "Variable Summary", width = 4,  status = "primary",
                    DT::dataTableOutput('summary.data')

                  ),
                  box(
                    title = "Modify the Variable Class", width = 4,  status = "primary",
                    radioButtons("choose_class", label = "Modify the Variable Class", 
                                 choices = list(Numeric = "numeric", Factor = "factor", 
                                                Character = "character"),
                                 selected = "numeric"),
                    actionButton("var_modify", "Modify")
                  )
                )
              )
      )
  )
) 

#--------------------------------------------------------------------
# Server Function
#--------------------------------------------------------------------
server <- function(input, output,session) {
  #--------------------------------------------------------------------
  # loading the data
  get.df <- reactive({
    if(input$dataset == "GermanCredit"){
      data("GermanCredit")
      GermanCredit
    }else if(input$dataset == "cars"){
      data(cars)
      cars
    }else if(input$dataset == "iris"){
      data("iris")
      iris
    }
  })

  # Getting the list of variable from the loaded dataset
  var_list <- reactive(names(get.df()))
  # Choosing the variable - checkbox option
  output$show.var <- renderUI({
    checkboxGroupInput('show_var', 'Select Variables', var_list(), selected = var_list())
  })

  # Setting the data frame based on the variable selction
  df <- reactive({
    if(input$select_all){
      df <- get.df()
    } else if(!input$select_all){
      df <- get.df()[, input$show_var, drop = FALSE]
    }
    return(df)
  })

  # create list of variables
  col.name <- reactive({
    d <- data.frame(names(df()), sapply(df(),class))
    names(d) <- c("Name", "Class") 
    return(d)
  })

  # render the variable list into table
  output$summary.data <- DT::renderDataTable(col.name(), server = FALSE, rownames = FALSE,
                                             selection = list(selected = 1, mode = 'single'), 
                                             options = list(lengthMenu = c(5, 10, 15, 20), pageLength = 20, dom = 'p'))


 # storing the selected variable from the variables list table 
  table.sel <- reactive({
    df()[,which(colnames(df()) == col.name()[input$summary.data_rows_selected,1])]
  })


# Trying to modify the variable class  
observeEvent(input$var_modify,{
    modify.row <- which(colnames(df()) == col.name()[input$summary.data_rows_selected,1])
    if( input$choose_class == "numeric"){
      df()[, modify.row] <- as.numeric(df()[, modify.row])
    } else if( input$choose_class == "factor"){
      df()[, modify.row] <- as.factor(df()[, modify.row])
    } else if( input$choose_class == "character"){
      df()[, modify.row] <- as.character(df()[, modify.row])
    }
  })

}

shinyApp(ui = ui, server = server)

`

4

1 回答 1

1

我会使用 reactiveValues() 代替。

library(shiny)

# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(

  sidebarLayout(
    sidebarPanel(
      selectInput("classType", "Class Type:", c("as.numeric", "as.character"))
    ),

    mainPanel(
      textOutput("class")
    )
  )
))

server <- shinyServer(function(input, output) {
  global <- reactiveValues(sample = 1:9)

  observe({
    global$sample <- get(input$classType)(global$sample)
  })

  output$class <- renderText({
    print(class(global$sample))
  })
})

shinyApp(ui = ui, server = server)

如果您有兴趣：关于您的尝试：reactive()是一个函数，并且您通过调用函数的输出df()[, modify.row]。因此，在您的代码中，您尝试更改函数的输出，但这不会更改该函数的期货调用的输出。也许在简化版本中更容易看到：

mean(1:3) <- 1

该代码将来无法将均值函数更改为输出 1。所以这就是 reactiveValues() 的帮助:)。希望有帮助！

于 2017-01-29T23:04:30.073 回答