Question

这是问题How to store reactive outputs values in a vector to be used in a function?

的扩展

我已经实现了上述问题中使用的相同数据，并添加了两个列，SD_D和Ord = M_D + SD_D。在此步骤之前，应用程序运行良好，但我想添加一个新列，它只是Ord的先前值。为了达到这个目的，我写了一个函数shift（x，lag），其中lag将是1.

当应用程序更新时，Ord的4个先前值变为NA，我需要这些值来计算Rec列的滞后。我怎么能保留Ord之前的4个值？

例如，如果用户输入值120,150,110,146，则预期结果为：

D        M_D     SD_D    Ord      Rec
100.00   NA      NA      100      NA
100.00   NA      NA      100      100
100.00   NA      NA      100      100
100.00   NA      NA      100      100
120.00   100.00  0.00    100.00   100
150.00   105.00  10.00   115.00   100
110.00   117.50  23.63   141.13   115
146.00   120.00  21.60   141.60   141.13

这是ui代码

library(shiny)

fluidPage(
  sidebarPanel(textInput("c1","example"),

           actionButton("update", "Update Table")
  ),

 mainPanel(tableOutput("example")

 )
)

和服务器代码

library(shiny)
library(zoo)

function(input, output) {

  #Example
  d <- rep(100,4)
  m <- rep(100,4)
  k <- rep(0,4)
  r <- rep(100,4)
  o <- rep(100,4)

  shift <- function(x, lag) {
   n <- length(x)
    xnew <- rep(NA, n)
    xnew[(lag+1):n] <- x[1:(n-lag)]
    return(xnew)
  }

  values <-reactiveValues(df=data.frame(D=d,M_D=m,SD_D=k,Ord=o,Rec=r))

  newEntry <- observeEvent(input$update,{
   d_new <- c(values$df$D,as.numeric(input$c1))
   r_new <- shift(values$df$Ord,1)
   m_d_new <- rollapply(d_new, mean ,  fill=NA, width=list(-1:-4))
   k_new <- rollapply(d_new, sd ,  fill=NA, width=list(-1:-4))
   o_new <- m_d_new + k_new
   values$df <- data.frame(D=d_new,M_D=m_d_new,SD_D=k_new, Ord=o_new, 
 Rec=r_new)
  })

  output$example <- renderTable({values$df})

}

*************************编辑********************* ********************

我找到了一个包含我想要的列的脏解决方案。我使用相同的rollapply函数，只需更改width参数。

我的原始数据是

D        M_D     SD_D    Ord      Rec
100      100     100     100      100
100      100     100     100      100
100      100     100     100      100
100      100     100     100      100

当我包含值120,150,110,146时，结果是

D        M_D     SD_D    Ord     Rec
100.00   NA      NA      NA      NA
100.00   NA      NA      NA      NA
100.00   NA      NA      NA      NA
100.00   NA      NA      NA      NA
120.00   100.00  0.00    100.00  NA
150.00   105.00  10.00   115.00  100.00
110.00   117.50  23.63   141.13  115.00
146.00   120.00  21.60   141.60  141.13

我仍然想使用滞后作为参数的函数，因为我希望用户可以选择此值。我在我的ui代码中包含了一个selectInput，并且改变了我原来的功能。

在我的ui和服务器代码修改

之下

library(shiny)
library(zoo)

ui <- fluidPage(
    sidebarPanel(textInput("c1","Example"),

           actionButton("update", "Update Table"),

           selectInput(inputId = "L",label = "Lag value",
                       choices = c(1, 2, 3, 4), selected=1
           )
  ),#endsidebarPanel
  mainPanel(tableOutput("example")

  )
)

server <- function(input, output) {

 #Example
d <- rep(100,4)
m <- rep(100,4)
k <- rep(0,4)
r <- rep(100,4)
o <- rep(100,4)

## mylag function
mylag <- function(x, lag) {
         n <- length(x)
         xnew <- x[n-lag]
         return(xnew)
}


values <- reactiveValues(df = data.frame(D=d, M_D=m, SD_D=k, Ord=o, 
Rec=r)) 

 newEntry <- observeEvent(input$update,{
 d_new <- c(values$df$D,as.numeric(input$c1))
 m_d_new <- rollapply(d_new, mean ,  fill=NA, width=list(-1:-4))
 k_new <- rollapply(d_new, sd ,  fill=NA, width=list(-1:-4))
 o_new <- as.numeric(m_d_new + k_new)
 r_new <- rollapply(o_new, mean ,  fill=NA, width=list(-1:-1))     
 values$df <- data.frame(D=d_new,M_D=m_d_new,SD_D=k_new, Ord=o_new, 
 Rec=r_new)
  })

  output$example <- renderTable({values$df})

}

shinyApp(ui = ui, server = server)

使用反应值

0 个答案: