依赖关系的功能。 两个功能独立工作，但在代码组合时显示错误闪亮(Dependencies in

2019-09-28 21:43发布

站内文章 / 前端开发
24 0 0

我有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)

Answer 1:

我做了几个小的变化，但是这意味着一个大的体系结构更改。 我加了一个“根表-A”，并重新初始化表-A与之前任何时候你应用更改。 否则，操作简单往往没有任何意义和空数据操作。

只有我所做的修改（我认为）分别为：

  • 加入另外的数据帧（的定义rootdfaa ），我们将永远不会改变。
  • 添加rootdfaa到UI输出面板，因为我觉得它有助于看到它（因为它永远不会改变它是不是真的有必要）。 我有一个非常大的屏幕太所以它是没有问题的，我:)
  • 添加一行observeEvent到重新初始化rv$dfA我们每次“应用更改”时间
  • 加入dror=FALSE语句DF $ A的最终计算从转动的单个列产生进载体，而不是一个数据帧保持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)

这是什么样子：



Answer 2:

你似乎子集划分的数据表与不，当你更新它的第一次，尝试用子集化存在变量%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)]     
  })


文章来源: Dependencies in functions. Two functions working individually but when combined in code are showing error in Shiny
标签： r shiny reactive-programming reactive
举报

收藏的人(0)

Ta的文章 更多文章
登录 后发表评论
0条评论
还没有人评论过~