Устранение неполадок ошибка, которую я не знаю в R / RMd / Shiny - PullRequest
Новая
       18

Устранение неполадок ошибка, которую я не знаю в R / RMd / Shiny

0 голосов
/ 23 апреля 2020

Я пишу интерактивный HTML документ с использованием RMarkdown и ShinyApp. Часть, с которой у меня проблемы, должна взять параметры для трех различных распределений вероятностей (пользовательский ввод) и вывести график, который меняется в зависимости от графиков. Этот график имеет 3 линии, по одной на каждое распределение вероятности. Я получаю ошибку: length(lower) == 1 is not TRUE.

Код сервера / пользовательского интерфейса выглядит следующим образом: 

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 и переустановил их. Еще ничего. Любая помощь очень ценится.

1 Ответ

0 голосов
/ 23 апреля 2020

В вашем коде, похоже, есть несколько проблем:

  • 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)
...