闪亮的反应性因data.tables

时间:2015-09-12 08:49:04

标签: r data.table shiny

作为Modifying a reactive value should trigger an observe chunk的后续行动,我进一步调查了这个问题,并意识到这个问题可能源于我对data.table的使用。与data.table s不同,data.frame被引用修改,这使得它们使用起来更有效,但shiny的反应性也明显不可见。

在下面的示例中,按下提交按钮会触发data.frame案例中的观察块,但不会触发data.table案例中的观察块。解决方法可能是将值与data.table的更改相关联,这也有助于触发反应。

with data.frame

shinyServer ( 

   function(input, output, session) {

      lReactiveValues = reactiveValues(a = data.frame(firstcol = runif(1)))

      voidaA = observeEvent(
         input$buttonCommit,
         {
            new = runif(1)
            cat(new,' one\t')
            lReactiveValues$a[letters[ncol(isolate(lReactiveValues$a))]] = new
         }
      )

      voidB = observe(priority = 50,{
         # input$buttonCommit
         cat(ncol(lReactiveValues$a))

         counter = runif(1)
         cat(counter,' two\t'); 

         if (counter > 0.5) {

            cat('\n')

            cat(ncol(lReactiveValues$a),' three\n')

         }
      }
      )

   }
)

with data.table

shinyServer ( 

   function(input, output, session) {

      lReactiveValues = reactiveValues(a = data.table(firstcol = runif(1)))
      # lReactiveValues = reactiveValues(a = data.frame(firstcol = runif(1)))

      voidaA = observeEvent(
         input$buttonCommit,
         {
            new = runif(1)
            cat(new,' one\t')
            setnames(
               lReactiveValues$a[, newcol := new],
               'newcol',
               letters[ncol(isolate(lReactiveValues$a))]
            )
            cat(ncol(lReactiveValues$a))
         }
      )

      voidB = observe(priority = 50,{
         # input$buttonCommit
         cat(ncol(lReactiveValues$a))

         counter = runif(1)
         cat(counter,' two\t'); 

         if (counter > 0.5) {

            cat('\n')

            cat(ncol(lReactiveValues$a),' three\n')

         }
      }
      )

   }
)

ui.r

dashboardPage(

   dashboardHeader(

      title = "Analytics"

   ),

   ## Sidebar content
   dashboardSidebar(
   menuItem("Analysis", tabName = "tabAnalysis", icon = icon("calculator"))
   ),

   ## Body content
   dashboardBody(
      tabItems(
         tabItem(
            tabName = "tabAnalysis",
            actionButton("buttonCommit", "Commit!")
         )
      )
      #, style='width: 100%; height: 100%;'

   )
)

代码功能的简短摘要 - 按下按钮应该在控制台上打印一些文本,其中包含字符串' one'。按钮应进一步触发观察块,提示打印包含字符串' two的一些文本。根据观察块中的if条件,另一组文本包括' three'可能会打印出来。在data.frame的server.r案例中,这种行为在应用程序运行时始终存在。在data.table的server.r情况下,只需点击几下按钮就会出现这种情况,之后只有' one'打印字符串,'两个'和'三' AREN'吨。想想这种翻转行为是在第一次发现if条件为假之后发生的。

2 个答案:

答案 0 :(得分:0)

如果你担心记忆,这是一个hacky解决方案:

添加DTControl值:

lReactiveValues = reactiveValues(a = data.table(firstcol = runif(1)), DTControl = 0)

然后在参考更改后将其与以下内容配对:

lReactiveValues$a[, newcol := new]
lReactiveValues$DTControl <- lReactiveValues$DTControl + 1

然后在您的观察功能中添加以下行:

lReactiveValues$DTControl

因为您的DTControl更新,所以触发了被动功能。需要进行一些努力以确保始终将两者配对,但它可以在没有任何内存负载的情况下覆盖此引用问题。

无论如何,这应该突出显示为闪亮的问题。

答案 1 :(得分:0)

可以使用 [[ 或 $ 修改 data.table 并保存到反应式表达式中。如:

dt <- reactiveVal(data.table(a=c(1,2),b=c(10,20))

在反应式表达式中,以下内容会将 b 的值从 10 更改为 100 并触发观察者

observeEvent(dt(), { print(dt()) })
observeEvent(input$mybutton, { 
  x <- dt()
  x[a==1][["b"]] <- 100
  dt(x)
})

使用您的示例代码和reactiveValues

server <- shinyServer ( 
  
  function(input, output, session) {
    
    lReactiveValues = reactiveValues(a = data.table(firstcol = runif(1)))
    # lReactiveValues = reactiveValues(a = data.frame(firstcol = runif(1)))
    
    voidaA = observeEvent(
      input$buttonCommit,
      {
        new = runif(1)
        cat(new,' one\t')
        
        lRV <- lReactiveValues$a
        lRV[["newcol"]] <- new
        lReactiveValues$a <- lRV
        
        cat(ncol(lReactiveValues$a))
      }
    )
    
    voidB = observe(priority = 50,{
      # input$buttonCommit
      cat(ncol(lReactiveValues$a))
      
      counter = runif(1)
      cat(counter,' two\t'); 
      
      if (counter > 0.5) {
        
        cat('\n')
        
        cat(ncol(lReactiveValues$a),' three\n')
        
      }
    }
    )
    
  }
)

ui <- dashboardPage(
  
  dashboardHeader(
    
    title = "Analytics"
    
  ),
  
  ## Sidebar content
  dashboardSidebar(
    menuItem("Analysis", tabName = "tabAnalysis", icon = icon("calculator"))
  ),
  
  ## Body content
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "tabAnalysis",
        actionButton("buttonCommit", "Commit!")
      )
    )
    #, style='width: 100%; height: 100%;'
    
  )
)

shinyApp(ui,server)