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实际上还有另一种方法，但我可能是错的。

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

1 个答案: