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

Question

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

代码第 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)
})

Third 我会将您所有的输入小部件转换为 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 实际上有另一种方法，但我可能是错的。

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

Update data table using shiny output in single code

r

rscript

shiny