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

Question

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

代码第 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 中取得很大进展的方式。对于第一个或第二个 Shiny 项目来说，这可能太复杂了。

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

首先我会将submitButton 更改为actionButton。在 Shiny 中，使用 submitButton 几乎总是错误的路径——它只会导致死胡同（就像你现在发现的那样）。你需要这样的东西：

  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 找到的所有视频 - 多看几遍就可以理解。反应式编程不同于其他形式的编程。需要一段时间才能得到它。

希望我没有犯任何令人困惑的语法错误。祝重组顺利。我不认为 Shiny 实际上还有其他前进方式，但我可能是错的。