对 R/RMd/Shiny 中我不知道的错误进行故障排除

Question

我正在使用 RMarkdown 和 ShinyApp 编写交互式 HTML 文档。我遇到问题的部分应该采用三种不同概率分布（用户输入）的参数并输出一个根据图表而变化的绘图。该图有 3 条线，每个概率分布一条。我得到的错误是length(lower) == 1 is not TRUE。

server/ui代码如下：

suppressWarnings(suppressMessages(library(ggplot2)))
suppressWarnings(suppressMessages(library(plotly)))
suppressWarnings(suppressMessages(library(tidyverse)))
suppressWarnings(suppressMessages(library(VGAM)))
source("mk_functions.R")

# UI ----
fluidPage(
  titlePanel("Graphs"),

  sidebarLayout(
    sidebarPanel(
      numericInput("alpha", "Pareto alpha", value = 1.5, min = 1, 
                   step = 0.2),
      numericInput("scalePareto", "Pareto scale", value = 1, min = 0,
                   step = 0.2),
      numericInput("lambda", "Exponential lambda", value = 1, min = 0, 
                   step = 0.2),
      numericInput("mean", "Folded Gaussian mean", value = 0, 
                   step = 0.2),
      numericInput("sd", "Folded Gaussian sigma", value = 1, min = 0, 
                   step = 0.2)),


    mainPanel(plotlyOutput("paretoPlot"))
  )
)

# Server ----
output$paretoPlot = renderPlotly({

  withProgress(message = "Progress:", expr={

    N = 1e03
    data = data.frame(p = c(1:N)/N)

    for (i in 1:nrow(data)){
      data[['Folded Gaussian']][i] = mk_foldnorm(data[['p']][i],
                                                 mean = input$mean,
                                                 sd = input$sd)
      data[['Exponential']][i] = mk_exponential(data[['p']][i],
                                                rate = input$rate)
      data[['Pareto']][i] = mk_pareto(data[['p']][i],
                                      shape = input$alpha,
                                      scale = input$scalePareto)
      incProgress(1/(nrow(shannon_portf)-1), 
                  message = paste("Progress: ", 
                                  round(100*i/nrow(data)), 
                                  "%", sep=""))
    }

  })


  data = data %>% 
    pivot_longer(-p, names_to = "Distribution", values_to = "mk", -p)

  plt = ggplot(data, aes(p, mk)) + 
    geom_line(aes(color=Distribution)) + 
    theme_bw()

  plt = ggplotly(plt)
  plt

})

我已经使用示例输入（实际上与初始输入值相同）运行此代码，并且运行良好。 VGAM 包在"mk_functions.R" 文件中使用。供参考，这里是文件"mk_functions.R"（很短）：

mk_foldnorm = function(p, mean=0, sd=1){
  k = qfoldnorm(1-p, mean = mean, sd = sd)
  f = function(x) x*dfoldnorm(x, mean = mean, sd = sd)
  numerator = integrate(f = f, lower = k, upper = Inf) 
  denominator = integrate(f = f, lower = -Inf, upper = Inf)
  mk = numerator$value / denominator$value
  print(mk)
}

mk_pareto = function(p, shape, scale=1){
  k = qpareto(1-p, scale = scale, shape = shape)
  f = function(x) x*dpareto(x, scale = scale, shape = shape)
  numerator = integrate(f = f, lower = k, upper = Inf) 
  denominator = integrate(f = f, lower = -Inf, upper = Inf)
  mk = numerator$value / denominator$value
  print(mk)
}

mk_exponential = function(p, rate=1){
  k = qexp(1-p, rate = rate)
  f = function(x) x*dexp(x, rate = rate)
  numerator = integrate(f = f, lower = k, upper = Inf) 
  denominator = integrate(f = f, lower = -Inf, upper = Inf)
  mk = numerator$value / denominator$value
  print(mk)
}

同样，错误是length(lower) == 1 is not TRUE。我尝试更改integrate(...) 的下限，但这不会更改输出。我尝试输出一个正常的ggplot2 图，它也不会改变输出。我在网上没有找到任何东西，也几乎没有其他要调试的东西。

我尝试更新所有软件包，我什至卸载了 R 和 RStudio 并重新安装了它们。依然没有。非常感谢任何帮助。

Answer 1

您的代码中似乎有几个问题：

• shannon_portf 不存在
• input$rate 不存在；但input$lambda 可以
• pivot_longer 语句返回错误 - 也许您想按 p 排序？
• 源文件中的函数应返回值 (return(mk))，而不是将其打印到控制台 (print(mk))

以下是给出情节的版本；你可能还想稍微调整一下……一些滑块似乎没有做任何事情，你可以隔离不需要重做的计算。

suppressWarnings(suppressMessages(invisible(
    lapply(c("ggplot2", "plotly", "tidyverse", "VGAM", "shiny"),
           require, character.only = TRUE))))
source("mk_functions.R")

# UI ----
ui <- shinyUI(fluidPage(
    titlePanel("Graphs"),

    sidebarLayout(
        sidebarPanel(
            numericInput("alpha", "Pareto alpha", value = 1.5, min = 1, 
                         step = 0.2),
            numericInput("scalePareto", "Pareto scale", value = 1, min = 0,
                         step = 0.2),
            numericInput("rate", "Exponential lambda", value = 1, min = 0, 
                         step = 0.2),
            numericInput("mean", "Folded Gaussian mean", value = 0, 
                         step = 0.2),
            numericInput("sd", "Folded Gaussian sigma", value = 1, min = 0, 
                         step = 0.2)),

        mainPanel(plotlyOutput("paretoPlot"))
    )
)
)

server <- shinyServer(function(input, output, session){
    # Server ----

    calcPareto <- reactive({
        withProgress(message = "Progress:", expr={

            N = 1e03
            data = data.frame(p = c(1:N)/N)

            for (i in 1:nrow(data)){
                data[['Folded Gaussian']][i] = mk_foldnorm(data[['p']][i],
                                                           mean = input$mean,
                                                           sd = input$sd)
                data[['Exponential']][i] = mk_exponential(data[['p']][i],
                                                          rate = input$rate)
                data[['Pareto']][i] = mk_pareto(data[['p']][i],
                                                shape = input$alpha,
                                                scale = input$scalePareto)
                incProgress(1/(nrow(data)-1), 
                            message = paste("Progress: ", 
                                            round(100*i/nrow(data)), 
                                            "%", sep=""))
            }


        })
        return(data)
    })

    output$paretoPlot = renderPlotly({
        req(calcPareto())
        data = calcPareto() %>% 
            pivot_longer(-p, names_to = "Distribution", values_to = "mk") %>% 
            dplyr::arrange(-p)

        plt = ggplot(data, aes(p, mk)) + 
            geom_line(aes(color=Distribution)) + 
            theme_bw()

        plt = ggplotly(plt)
        plt

    })

})

shinyApp(ui = ui, server = server)