R-使用单个代码中的闪亮输出更新数据表

Question

我正在尝试创建一个允许用户输入值的闪亮应用程序。数据中缺少的值将由用户提供的值或默认值替换。用户输入该值之后，将生成新文件data_new。我想使用此文件进一步更新我的原始数据集以替换缺失值。我不确定如何从Shiny应用程序文件中获取输入并更新数据表。

代码第1部分：

library(shiny)
    library(readr)
    library(datasets)
data_set <- structure(list(A = c(1L, 4L, 0L, 1L), B = c("3", "*", "*", "2"
), C = c("4", "5", "2", "*"), D = c("*", "9", "*", "4")), .Names = c("A", "B", "C", "D"), class = "data.frame", row.names = c(NA, -4L))
    data_set1 <- data_set
    my.summary <- function(x, na.rm=TRUE){
      result <- c(Mean=mean(x, na.rm=na.rm),
                  SD=sd(x, na.rm=na.rm),
                  Median=median(x, na.rm=na.rm),
                  Min=min(x, na.rm=na.rm),
                  Max=max(x, na.rm=na.rm), 
                  N=length(x),
                  Nmiss = sum(is.na(x)))
    }
    # identifying numeric columns
    ind <- sapply(data_set1, is.numeric)
    # applying the function to numeric columns only
    stats_d <- data.frame(t(data.frame(sapply(data_set1[, ind], my.summary) )))
    stats_d <- cbind(Row.Names = rownames(stats_d), stats_d)
    colnames(stats_d)[1] <- "variable"
    data_new <- stats_d
    #rownames(data) <- c()
    data_new["User_input"] <- data_new$Max
    data_new["OutlierCutoff"] <- 1
    data_new["Drop_Variable"] <- "No"
    shinyApp(
      ui <-
        fluidPage(
          titlePanel("Univariate Analysis"),
          # Create a new row for the table.
          sidebarLayout(
            sidebarPanel(
            selectInput("select", label = h3("Select Variable"), 
                        choices = unique(data_new$variable), 
                        selected = unique(data_new$variable)[1]),
            numericInput("num", label = h3("Replace missing value with"), value = unique(data_new$variable)[1]),
            selectInput("select1", label = h3("Select Variable"), 
                        choices = unique(data_new$variable), 
                        selected = unique(data_new$variable)[1]),
            numericInput("num1", label = h3("Outlier Cutoff"), value = unique(data_new$variable)[1],min = 0, max = 1),
            selectInput("select2", label = h3("Select any other Variable to drop"), 
                        choices = unique(data_new$variable), 
                        selected = unique(data_new$variable)[1]),
            selectInput("select3", label = h3("Yes/No"), 
                        choices = list("Yes", "No")),
            submitButton(text = "Apply Changes", icon = NULL)),
          mainPanel(
            dataTableOutput(outputId="table")
          ))  )  
          ,
      Server <- function(input, output) {
        # Filter data based on selections
        output$table <- renderDataTable({
          data_new$User_input[data_new$variable==input$select] <<- input$num
          data_new$OutlierCutoff[data_new$variable==input$select1] <<- input$num1
          data_new$Drop_Variable[data_new$variable==input$select2] <<- input$select3
          data_new
        })
      })

代码第2部分：

data_set[as.character(data_new$variable)] <- Map(function(x, y)
   replace(x, is.na(x), y), data_set[as.character(data_new$variable)], data_new$User_input)
data_setN <- data_set

Answer 1

这是一项相当复杂的事业，在那里有一些很酷的代码的地方，您并没有真正以某种方式构造它，使您可以在Shiny中取得很大的前进进度。对于第一或第二闪亮的事业来说，这可能太复杂了。

如果我有时间，我会为您重写，但我现在不在，我认为您实际上可以自己做，并学到很多东西。这就是我认为必须完成的：

第一个我会将submitButton更改为actionButton。在Shiny中，使用TristButton几乎总是错误的途径 - 仅导致死胡同（就像您现在发现的那样）。您需要这样的东西：

  actionButton("applyChanges","Apply Changes"),

第二，您需要将data_new放入reactiveEvent函数中。您现在在初始化中进行的计算必须被移动（或可能复制）到反应性代码块中。这样的东西：

data_new <- eventReactive(applyChanges,{
  # code to change NAs in data_set1 to something specified in the input goes here
  ############################################################################### 
  ind <- sapply(data_set1, is.numeric)   
  stats_d <- data.frame(t(data.frame(sapply(data_set1[, ind], my.summary) )))
  stats_d <- cbind(Row.Names = rownames(stats_d), stats_d)
  colnames(stats_d)[1] <- "variable" 
  d_new <- stats_d
  d_new["User_input"] <- d_new$Max
  d_new["OutlierCutoff"] <- 1
  d_new["Drop_Variable"] <- "No"
  return(d_new)
})

第三我会将您的所有输入小部件转换为renderUI小部件，并使用您刚刚创建的Data_new反应性在服务器中计算它们。在ui函数中这样：

   uiOutput("select")

在server函数中像这样：

output$select <- renderUI({
      selectInput("select", label = h3("Select Variable"), 
                  choices = unique(data_new()$variable), 
                  selected = unique(data_new()$variable)[1]),
    )
  })

请注意data_new（）中的函数parens（）。这是因为它现在是一个反应性。对于输入控制select，num，select1，num1，select2，select3。

第四（实际上，这可能是很好的做法），请观看Joe Cheng可以找到的所有视频使用Shiny-观看它们多次，您需要理解它。反应性编程与其他形式的编程不同。需要一段时间才能得到它。

希望我不会犯任何令人困惑的语法错误。重组祝您好运。我认为实际上没有闪亮的另一种前进方向，但我可能是错的。