函数中的依赖。两个函数单独工作但在代码中组合时在 Shiny 中显示错误
Dependencies in functions. Two functions working individually but when combined in code are showing error in Shiny
我有 2 个单独的代码（代码 A 和代码 B）。当我组合这些代码来创建单个应用程序时，当两个输入都更新时它会显示错误。不确定错误在哪里？
代码A
library(shiny)
dfaa <- data.frame(A = c( 1L, 4L, 0L, 1L),
B = c("3","*","*","2"),
C = c("4","5","2","*"),
D = c("*","9","*","4"),stringsAsFactors = F)
dfbb <- data.frame(variable = c("A","B","C","D"),
Value = c( 2L, 1L, 9L, 0L),stringsAsFactors = F)
dfbb["Drop_Variable"] <- "No"
ui <- fluidPage(titlePanel("Sample"),
sidebarLayout(
sidebarPanel(
selectInput("select2", label = h3("Select any other Variable to drop"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
selectInput("select3", label = h3("Yes/No"),
choices = list("Yes", "No"),
selected = "No"),
actionButton("applyChanges", "Apply Changes specified in B to A")),
mainPanel(
h3("Table A"), dataTableOutput(outputId="tableA"),
h3("Table B"), dataTableOutput(outputId="tableB")
)))
server <- function(input, output) {
rv <- reactiveValues(dfA=dfaa,dfB=dfbb)
observe({
# update dfB immediately when the variable or value in the ui changes
rv$dfB$Drop_Variable[rv$dfB$variable==input$select2] <- input$select3
})
observeEvent(input$applyChanges,{
drop <- as.character(rv$dfB$variable[rv$dfB$Drop_Variable == "Yes"])
rv$dfA <- rv$dfA[,!(names(rv$dfA) %in% drop)]
})
output$tableB <- renderDataTable({ rv$dfB })
output$tableA <- renderDataTable({ rv$dfA })
}
shinyApp(ui=ui,server=server)
代码 B
library(shiny)
dfaa <- data.frame(A = c( 1L, 4L, 0L, 1L),
B = c("3","*","*","2"),
C = c("4","5","2","*"),
D = c("*","9","*","4"),stringsAsFactors = F)
dfbb <- data.frame(variable = c("A","B","C","D"),
Value = c( 2L, 1L, 9L, 0L),stringsAsFactors = F)
dfbb["Drop_Variable"] <- "No"
ui <- fluidPage(titlePanel("Sample"),
sidebarLayout(
sidebarPanel(
selectInput("select", label = h3("Select Variable"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
numericInput("num", label = h3("Replace * in A with"),
value = unique(dfbb$Value)[1]),
actionButton("applyChanges", "Apply Changes specified in B to A")),
mainPanel(
h3("Table A"), dataTableOutput(outputId="tableA"),
h3("Table B"), dataTableOutput(outputId="tableB")
)))
server <- function(input, output) {
rv <- reactiveValues(dfA=dfaa,dfB=dfbb)
observe({
# update dfB immediately when the variable or value in the ui changes
rv$dfB$Value[rv$dfB$variable==input$select] <- input$num
})
observeEvent(input$applyChanges,{
# Here we apply the changes that were specified
dfAcol <-as.character(rv$dfB$variable)
rv$dfA[dfAcol] <-
Map(function(x, y) replace(x, x=="*", y), rv$dfA[dfAcol], rv$dfB$Value)
})
output$tableB <- renderDataTable({ rv$dfB })
output$tableA <- renderDataTable({ rv$dfA })
}
shinyApp(ui=ui,server=server)
合并代码 A 和 B
library(shiny)
dfaa <- data.frame(A = c( 1L, 4L, 0L, 1L),
B = c("3","*","*","2"),
C = c("4","5","2","*"),
D = c("*","9","*","4"),stringsAsFactors = F)
dfbb <- data.frame(variable = c("A","B","C","D"),
Value = c( 2L, 1L, 9L, 0L),stringsAsFactors = F)
dfbb["Drop_Variable"] <- "No"
ui <- fluidPage(titlePanel("Sample"),
sidebarLayout(
sidebarPanel(
selectInput("select", label = h3("Select Variable"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
numericInput("num", label = h3("Replace * in A with"),
value = unique(dfbb$Value)[1]),
selectInput("select2", label = h3("Select any other Variable to drop"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
selectInput("select3", label = h3("Yes/No"),
choices = list("Yes", "No"),
selected = "No"),
actionButton("applyChanges", "Apply Changes specified in B to A")),
mainPanel(
h3("Table A"), dataTableOutput(outputId="tableA"),
h3("Table B"), dataTableOutput(outputId="tableB")
)))
server <- function(input, output) {
rv <- reactiveValues(dfA=dfaa,dfB=dfbb)
observe({
# update dfB immediately when the variable or value in the ui changes
rv$dfB$Value[rv$dfB$variable==input$select] <- input$num
rv$dfB$Drop_Variable[rv$dfB$variable==input$select2] <- input$select3
})
observeEvent(input$applyChanges,{
# Here we apply the changes that were specified
dfAcol <-as.character(rv$dfB$variable)
rv$dfA[dfAcol] <-
Map(function(x, y) replace(x, x=="*", y), rv$dfA[dfAcol], rv$dfB$Value)
drop <- as.character(rv$dfB$variable[rv$dfB$Drop_Variable == "Yes"])
rv$dfA <- rv$dfA[,!(names(rv$dfA) %in% drop)]
})
output$tableB <- renderDataTable({ rv$dfB })
output$tableA <- renderDataTable({ rv$dfA })
}
shinyApp(ui=ui,server=server)
您似乎在用第一次更新时不存在的变量对数据table 进行子设置，请尝试用%in% 进行子设置。 mappy 之后也有小错误，但您可以解决这个问题...
试试这个：
observeEvent(input$applyChanges,{
print("two")
# Here we apply the changes that were specified
dfAcol <-as.character(rv$dfB$variable)
rv$dfA[dfAcol] <-
Map(function(x, y) replace(x, x=="*", y), rv$dfA[rv$dfA %in% dfAcol,], rv$dfB$Value)
drop <- as.character(rv$dfB$variable[rv$dfB$Drop_Variable == "Yes"])
rv$dfA <- rv$dfA[,!(names(rv$dfA) %in% drop)]
})
我做了一些小的改动，但这意味着架构上的大改动。我添加了一个 "root Table-A"，并在您应用更改之前用它重新初始化 table-A。否则，这些操作通常没有任何意义，并且是在空数据上进行操作。
我所做的唯一更改（我认为）是：
- 添加了我们永远不会更改的附加数据框 (
rootdfaa) 的定义。
- 将
rootdfaa 添加到 ui 输出面板，因为我发现它有助于查看它（因为它永远不会改变，所以没有必要）。我也有一个非常大的屏幕，所以这对我来说不是问题:)
- 在
observeEvent 中添加了一行，以便每次 "apply changes" 时重新初始化 rv$dfA
- 在 df$A 的最终计算中添加了一个
dror=FALSE 语句，以防止 R 将单列结果转换为向量而不是数据帧。
我 做 认为这是解决这个问题的唯一方法 - 试图保护所有这些表达式以便它们迭代地处理可能丢失的数据将是一场噩梦。
代码如下：
library(shiny)
rootdfaa <- data.frame(A = c( 1L, 4L, 0L, 1L),
B = c("3","*","*","2"),
C = c("4","5","2","*"),
D = c("*","9","*","4"),stringsAsFactors = F)
dfaa <- rootdfaa
dfbb <- data.frame(variable = c("A","B","C","D"),
Value = c( 2L, 1L, 9L, 0L),stringsAsFactors = F)
dfbb["Drop_Variable"] <- "No"
ui <- fluidPage(titlePanel("Sample"),
sidebarLayout(
sidebarPanel(
selectInput("select", label = h3("Select Variable"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
numericInput("num", label = h3("Replace * in Tab-A with"),
value = unique(dfbb$Value)[1]),
selectInput("select2", label = h3("Select any other Variable to drop"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
selectInput("select3", label = h3("Yes/No"),
choices = list("Yes", "No"),
selected = "No"),
actionButton("applyChanges", "Apply changes in Tab-B to Tab-A")),
mainPanel(
h3("Root Tab-A"), dataTableOutput(outputId="roottableA"),
h3("Tab-A"), dataTableOutput(outputId="tableA"),
h3("Tab-B"), dataTableOutput(outputId="tableB")
)))
server <- function(input, output) {
rv <- reactiveValues(dfA=dfaa,dfB=dfbb)
observe({
# update dfB immediately when the variable or value in the ui changes
rv$dfB$Value[rv$dfB$variable==input$select ] <- input$num
rowstochange <- rv$dfB$variable==input$select2
rv$dfB$Drop_Variable[rv$dfB$variable==input$select2] <- input$select3
})
observeEvent(input$applyChanges,{
rv$dfA <- rootdfaa # reinitialze dfA
# Here we apply the changes that were specified
dfAcol <-as.character(rv$dfB$variable)
rv$dfA[dfAcol] <-
Map(function(x, y) replace(x, x=="*", y), rv$dfA[dfAcol], rv$dfB$Value)
drop <- as.character(rv$dfB$variable[rv$dfB$Drop_Variable == "Yes"])
rv$dfA <- rv$dfA[,!(names(rv$dfA) %in% drop),drop=FALSE]
})
output$roottableA <- renderDataTable({ rootdfaa })
output$tableB <- renderDataTable({ rv$dfB })
output$tableA <- renderDataTable({ rv$dfA })
}
shinyApp(ui=ui,server=server)
这就是它的样子：
我有 2 个单独的代码（代码 A 和代码 B）。当我组合这些代码来创建单个应用程序时，当两个输入都更新时它会显示错误。不确定错误在哪里？
代码A
library(shiny)
dfaa <- data.frame(A = c( 1L, 4L, 0L, 1L),
B = c("3","*","*","2"),
C = c("4","5","2","*"),
D = c("*","9","*","4"),stringsAsFactors = F)
dfbb <- data.frame(variable = c("A","B","C","D"),
Value = c( 2L, 1L, 9L, 0L),stringsAsFactors = F)
dfbb["Drop_Variable"] <- "No"
ui <- fluidPage(titlePanel("Sample"),
sidebarLayout(
sidebarPanel(
selectInput("select2", label = h3("Select any other Variable to drop"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
selectInput("select3", label = h3("Yes/No"),
choices = list("Yes", "No"),
selected = "No"),
actionButton("applyChanges", "Apply Changes specified in B to A")),
mainPanel(
h3("Table A"), dataTableOutput(outputId="tableA"),
h3("Table B"), dataTableOutput(outputId="tableB")
)))
server <- function(input, output) {
rv <- reactiveValues(dfA=dfaa,dfB=dfbb)
observe({
# update dfB immediately when the variable or value in the ui changes
rv$dfB$Drop_Variable[rv$dfB$variable==input$select2] <- input$select3
})
observeEvent(input$applyChanges,{
drop <- as.character(rv$dfB$variable[rv$dfB$Drop_Variable == "Yes"])
rv$dfA <- rv$dfA[,!(names(rv$dfA) %in% drop)]
})
output$tableB <- renderDataTable({ rv$dfB })
output$tableA <- renderDataTable({ rv$dfA })
}
shinyApp(ui=ui,server=server)
代码 B
library(shiny)
dfaa <- data.frame(A = c( 1L, 4L, 0L, 1L),
B = c("3","*","*","2"),
C = c("4","5","2","*"),
D = c("*","9","*","4"),stringsAsFactors = F)
dfbb <- data.frame(variable = c("A","B","C","D"),
Value = c( 2L, 1L, 9L, 0L),stringsAsFactors = F)
dfbb["Drop_Variable"] <- "No"
ui <- fluidPage(titlePanel("Sample"),
sidebarLayout(
sidebarPanel(
selectInput("select", label = h3("Select Variable"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
numericInput("num", label = h3("Replace * in A with"),
value = unique(dfbb$Value)[1]),
actionButton("applyChanges", "Apply Changes specified in B to A")),
mainPanel(
h3("Table A"), dataTableOutput(outputId="tableA"),
h3("Table B"), dataTableOutput(outputId="tableB")
)))
server <- function(input, output) {
rv <- reactiveValues(dfA=dfaa,dfB=dfbb)
observe({
# update dfB immediately when the variable or value in the ui changes
rv$dfB$Value[rv$dfB$variable==input$select] <- input$num
})
observeEvent(input$applyChanges,{
# Here we apply the changes that were specified
dfAcol <-as.character(rv$dfB$variable)
rv$dfA[dfAcol] <-
Map(function(x, y) replace(x, x=="*", y), rv$dfA[dfAcol], rv$dfB$Value)
})
output$tableB <- renderDataTable({ rv$dfB })
output$tableA <- renderDataTable({ rv$dfA })
}
shinyApp(ui=ui,server=server)
合并代码 A 和 B
library(shiny)
dfaa <- data.frame(A = c( 1L, 4L, 0L, 1L),
B = c("3","*","*","2"),
C = c("4","5","2","*"),
D = c("*","9","*","4"),stringsAsFactors = F)
dfbb <- data.frame(variable = c("A","B","C","D"),
Value = c( 2L, 1L, 9L, 0L),stringsAsFactors = F)
dfbb["Drop_Variable"] <- "No"
ui <- fluidPage(titlePanel("Sample"),
sidebarLayout(
sidebarPanel(
selectInput("select", label = h3("Select Variable"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
numericInput("num", label = h3("Replace * in A with"),
value = unique(dfbb$Value)[1]),
selectInput("select2", label = h3("Select any other Variable to drop"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
selectInput("select3", label = h3("Yes/No"),
choices = list("Yes", "No"),
selected = "No"),
actionButton("applyChanges", "Apply Changes specified in B to A")),
mainPanel(
h3("Table A"), dataTableOutput(outputId="tableA"),
h3("Table B"), dataTableOutput(outputId="tableB")
)))
server <- function(input, output) {
rv <- reactiveValues(dfA=dfaa,dfB=dfbb)
observe({
# update dfB immediately when the variable or value in the ui changes
rv$dfB$Value[rv$dfB$variable==input$select] <- input$num
rv$dfB$Drop_Variable[rv$dfB$variable==input$select2] <- input$select3
})
observeEvent(input$applyChanges,{
# Here we apply the changes that were specified
dfAcol <-as.character(rv$dfB$variable)
rv$dfA[dfAcol] <-
Map(function(x, y) replace(x, x=="*", y), rv$dfA[dfAcol], rv$dfB$Value)
drop <- as.character(rv$dfB$variable[rv$dfB$Drop_Variable == "Yes"])
rv$dfA <- rv$dfA[,!(names(rv$dfA) %in% drop)]
})
output$tableB <- renderDataTable({ rv$dfB })
output$tableA <- renderDataTable({ rv$dfA })
}
shinyApp(ui=ui,server=server)
您似乎在用第一次更新时不存在的变量对数据table 进行子设置，请尝试用%in% 进行子设置。 mappy 之后也有小错误，但您可以解决这个问题...
试试这个：
observeEvent(input$applyChanges,{
print("two")
# Here we apply the changes that were specified
dfAcol <-as.character(rv$dfB$variable)
rv$dfA[dfAcol] <-
Map(function(x, y) replace(x, x=="*", y), rv$dfA[rv$dfA %in% dfAcol,], rv$dfB$Value)
drop <- as.character(rv$dfB$variable[rv$dfB$Drop_Variable == "Yes"])
rv$dfA <- rv$dfA[,!(names(rv$dfA) %in% drop)]
})
我做了一些小的改动，但这意味着架构上的大改动。我添加了一个 "root Table-A"，并在您应用更改之前用它重新初始化 table-A。否则，这些操作通常没有任何意义，并且是在空数据上进行操作。
我所做的唯一更改（我认为）是：
- 添加了我们永远不会更改的附加数据框 (
rootdfaa) 的定义。 - 将
rootdfaa添加到 ui 输出面板，因为我发现它有助于查看它（因为它永远不会改变，所以没有必要）。我也有一个非常大的屏幕，所以这对我来说不是问题:) - 在
observeEvent中添加了一行，以便每次 "apply changes" 时重新初始化 - 在 df$A 的最终计算中添加了一个
dror=FALSE语句，以防止 R 将单列结果转换为向量而不是数据帧。
rv$dfA
我 做 认为这是解决这个问题的唯一方法 - 试图保护所有这些表达式以便它们迭代地处理可能丢失的数据将是一场噩梦。
代码如下：
library(shiny)
rootdfaa <- data.frame(A = c( 1L, 4L, 0L, 1L),
B = c("3","*","*","2"),
C = c("4","5","2","*"),
D = c("*","9","*","4"),stringsAsFactors = F)
dfaa <- rootdfaa
dfbb <- data.frame(variable = c("A","B","C","D"),
Value = c( 2L, 1L, 9L, 0L),stringsAsFactors = F)
dfbb["Drop_Variable"] <- "No"
ui <- fluidPage(titlePanel("Sample"),
sidebarLayout(
sidebarPanel(
selectInput("select", label = h3("Select Variable"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
numericInput("num", label = h3("Replace * in Tab-A with"),
value = unique(dfbb$Value)[1]),
selectInput("select2", label = h3("Select any other Variable to drop"),
choices = unique(dfbb$variable),
selected = unique(dfbb$variable)[1]),
selectInput("select3", label = h3("Yes/No"),
choices = list("Yes", "No"),
selected = "No"),
actionButton("applyChanges", "Apply changes in Tab-B to Tab-A")),
mainPanel(
h3("Root Tab-A"), dataTableOutput(outputId="roottableA"),
h3("Tab-A"), dataTableOutput(outputId="tableA"),
h3("Tab-B"), dataTableOutput(outputId="tableB")
)))
server <- function(input, output) {
rv <- reactiveValues(dfA=dfaa,dfB=dfbb)
observe({
# update dfB immediately when the variable or value in the ui changes
rv$dfB$Value[rv$dfB$variable==input$select ] <- input$num
rowstochange <- rv$dfB$variable==input$select2
rv$dfB$Drop_Variable[rv$dfB$variable==input$select2] <- input$select3
})
observeEvent(input$applyChanges,{
rv$dfA <- rootdfaa # reinitialze dfA
# Here we apply the changes that were specified
dfAcol <-as.character(rv$dfB$variable)
rv$dfA[dfAcol] <-
Map(function(x, y) replace(x, x=="*", y), rv$dfA[dfAcol], rv$dfB$Value)
drop <- as.character(rv$dfB$variable[rv$dfB$Drop_Variable == "Yes"])
rv$dfA <- rv$dfA[,!(names(rv$dfA) %in% drop),drop=FALSE]
})
output$roottableA <- renderDataTable({ rootdfaa })
output$tableB <- renderDataTable({ rv$dfB })
output$tableA <- renderDataTable({ rv$dfA })
}
shinyApp(ui=ui,server=server)
这就是它的样子：