在 R Shiny 中，如何删除不再需要的自定义函数？

Question

我正在简化一个混乱的代码网络，我已经完成了下面 MWE 的一半。以下发布的内容按预期运行（对我而言）。如果代码看起来很混乱，那之前的情况就更糟了。

请查看 server 部分中的 vectorVariable，标有 # ???。为什么第一个 vectorVariable 有效，而第二个 vectorVariable 在其正下方，被注释掉，在未注释（和第一个被注释掉）和运行应用程序时导致错误消息？第一个 vectorVariable 引用 vectorMultiFinal，它已通过将其值直接传递给 vectorMulti 而被阉割，第二个 vectorVariable 直接传递给 vectorMulti 函数。（在我简化的过程中，我将 vectorMultiFinal 的功能合并到 vectorMulti 并留下 vectorMultiFinal 作为传递“shell”，这样我可以确保应用程序继续工作的每一步简化）。

该应用程序的目的是向用户显示滑块输入中的默认 x 值和第一个矩阵（flatRate 函数）中的默认 y 值，然后围绕该基数“构建曲线”在第二个矩阵（curveRate 函数）中通过矩阵中的 manipulating/adding x 和 y 值。

请注意，在我运行的 shinyMatrix 包版本中，当出现 2+ 列矩阵时，我必须先输入最右边的列，然后再向左输入。 shinyMatrix 中有一个小错误，我需要从 gitHub.

下载修复程序

MWE 代码：

rm(list = ls())

library(shiny)
library(shinyMatrix)

### 1st user input matrix ###
flatRate <- function(inputId){
  matrixInput(inputId, 
              value = matrix(c(0.05), 1, 1, dimnames = list(c("Initial rate (Y)"),NULL)),
              rows = list(extend = FALSE, names = TRUE),
              cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")} 

### 2nd user input matrix ###
curveRate <- function(InputId,x,y){ # x = period to apply y, y = variable applied in period x
  matrixInput(InputId,
              value = matrix(c(x,y),1,2,dimnames=list(NULL,c("Period X","Curved rate Y"))),
              rows = list(extend = TRUE,  names = FALSE),
              cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
              class = "numeric")}  

### Corrects user inputs in "curveRate" input matrix ###
curveCorrect <- function(x,y){ # x = slider input model periods, y = "curveRate" inputs
  a <- y
  a[,1][a[,1]>x] <- x          # a assigns value of period x to any input period in "curveRate" > x
  b <- diff(a[,1,drop=FALSE])  # b ensures "curveRate" period inputs are in increasing order
  b[b<=0] <- NA                # flag any instances of period inputs in decreasing order with NA
  b <- c(1,b)                  # See above 2 explanations
  a <- cbind(a,b)
  a <- na.omit(a)              # deletes rows with element NA
  a <- a[,-c(3),drop=FALSE]    # deletes column inserted above to flag NA
  return(a)}

### Interpolates & spreads matrix inputs across even time horizon ###
vectorMulti <- function(x,y){ # x = number of modeled periods, y = "curveCorrect" output
  a <- rep(NA, x)                                                     # generates single column vector of NA numbering x periods
  a[y[,1]] <- y[,2]                                                   # places each variable y[,2] in position indicated by its respective period y[,1]
  a[seq_len(min(y[,1])-1)] <- a[min(y[,1])]                           # if 1st period y[,1] > 1, applies that variable y[,2] to all periods <= y[,1]
  if(max(y[,1]) < x){a[seq(max(y[,1])+1, x, 1)] <- 0}                 # applies 0 to all periods after max period specified in y[,1] up to period x
  a <- approx(seq_along(a)[!is.na(a)],a[!is.na(a)],seq_along(a))$y    # the only NA's remaining, after the above, are periods to interpolate using approx
  b <- seq(1:x)                                                       # creates single column vector for number of x periods
  c <- data.frame(x=b,y=a)                                            # merges b and a into data frame, assigns column header labels of x and y
  return(c)}

vectorMultiFinal <- function(x,y){vectorMulti(x,curveCorrect(x,y))} # ???

ui <- fluidPage(
        column(9,
                sliderInput('periods','Periods (X):',min=1,max=12,value=6),
                flatRate("ratesBaseInput"),
                actionButton('resetRatesVectorBtn','Reset'),
                uiOutput("ratesVectors"),
                plotOutput("plot1"),
        )
      )

server <- function(input,output,session)({
  
  periods        <- reactive(input$periods)
  ratesBaseInput <- reactive(input$ratesBaseInput)
  ratesInput     <- reactive(input$ratesInput)
  
  vectorVariable <- function(y){vectorMultiFinal(periods(),curveCorrect(periods(),y))} # ???
  # vectorVariable <- function(y){vectorMulti(periods(),curveCorrect(periods(),y))}    # ???
  
  rates <- function(){vectorVariable(ratesInput())}
  
  output$ratesVectors <- renderUI({
    input$resetRatesVectorBtn
    curveRate("ratesInput",input$periods,input$ratesBaseInput[1,1])
  }) # close render UI
  
  output$plot1 <-renderPlot({plot(rates())})
 
}) # close server

shinyApp(ui, server)

Answer 1

使用 req() 解决您的问题。

server <- function(input,output,session)({
  
  periods        <- reactive(input$periods)
  ratesBaseInput <- reactive(input$ratesBaseInput)
  ratesInput     <- reactive(input$ratesInput)
  
  #vectorVariable <- function(y){vectorMultiFinal(periods(),curveCorrect(periods(),y))} # ???
  vectorVariable <- function(y){vectorMulti(periods(),curveCorrect(periods(),y))}    # ???
  
  rates <- function(){vectorVariable(req(ratesInput()))}  ####<-------   use req()
  
  output$ratesVectors <- renderUI({
    req(input$periods,input$ratesBaseInput)
    input$resetRatesVectorBtn
    curveRate("ratesInput",input$periods,input$ratesBaseInput[1,1])
  }) # close render UI
  
  output$plot1 <-renderPlot({req(rates())
    plot(rates())})
  
}) # close server

在 R Shiny 中，如何删除不再需要的自定义函数？

In R Shiny, how to eliminate a custom function that is no longer needed?

debugging

r

shiny