Динамический UiOutput, вызывающий проблему при добавлении входных данных в DataFrame Shiny

У меня есть приложение, в котором пользователь выбирает акции, которые хочет проанализировать. В зависимости от количества выбранных акций приложение будет отображать равное количество UIOuputs, где пользователь может выбрать вес для каждой акции. Так, например, если вы выберете 6 акций для анализа, 6 пользовательских выходов отобразят каждый запрос на выбор веса.

Проблема, с которой я столкнулся, заключается в том, что я хотел бы создать фрейм данных с входами. Итак, если пользователь выбирает AAP1 и MSFT с весами .50 и .50. Я хочу создать df:

Ticker  Weight
AAPL    .50
MSFT    .50

Однако, когда я пытаюсь создать фрейм данных, я получаю сообщение об ошибке разной длины. Я считаю, что это из-за того, как работает блестящая реактивность (не заказана). Любой вклад будет очень признателен. Ниже находится приложение.

library(shiny)
library(purrr)
library(tidyverse)
library(DT)
tickers = c("SPY", "IWM", "QQQ", "TLT", "AGG", "GLD", "SLV")

ui <- fluidPage(

    # Application title
    titlePanel("Portfolio Builder"),

    #select the stocks you want to analyze
    mainPanel(
       selectizeInput("mult", "chose stock", choices = tickers, selected = "SPY", multiple = T),
       uiOutput("plo"),
       dataTableOutput("dataTab")
    )


)

# Define server logic required to draw a histogram
server <- function(input, output) {

 output$plo = renderUI({
     z = length(input$mult)
     name = input$mult
     map2(seq(z), name,  ~ numericInput(inputId = paste0("hey",.x), label = paste("weight", .y), value = 10))

     })

 weights = reactiveValues()

 observe({weights$current = map(seq(length(input$mult)),~input[[paste0("hey",.x)]]) %>% unlist()})

 mat = reactive({
   #if(length(weights$current) == length(input$mult)){
   df = data.frame(ticker = input$mult, weight = weights$current) %>% mutate(weightPct = weights$current/sum(weights$current))
  # }else{NULL}
 })

 output$dataTab = renderDataTable({
   mat()
 })


observe(print(weights$current))
observe(print(input$mult))



}

r shiny purrr
person Jordan Wrong    schedule 10.08.2019    source источник
comment
Я добавил: output$my_df <- renderDataTable({mat()}) на сервер и dataTableOutput("my_df") в пользовательский интерфейс. Оказалось, что фрейм данных создан правильно. Что мне не хватает?   -  person Ryan Morton    schedule 11.08.2019
comment
Привет, Райан, я обновил код, чтобы добавить в вашу таблицу данных + преобразование. Теперь вы должны увидеть ошибку, когда добавляете новую акцию. Я добавил решение в # if (length ...). Однако я думаю, что это решение - не лучший способ   -  person Jordan Wrong    schedule 11.08.2019
comment
Вы можете добавить req() необходимый. Меня смущает ваш призыв к наблюдению. Если все находится в реактивном контексте, вам не нужно использовать наблюдателя.   -  person Ryan Morton    schedule 12.08.2019

Ответы (1)


arrow_upward
1
arrow_downward

Я преобразовал ваши observe() и reactiveValues() в один reactive() объект. Таким образом, он без труда реагирует на изменения. Другое большое отличие состоит в том, что я преобразовал объект weights в список, но я думаю, что за ним все равно будет легко следить. Ошибка кадра данных сохранялась, поскольку длина пользовательского ввода и веса на мгновение не совпадали, поэтому я вернул проверку длины, которая у вас уже была:

library(shiny)
library(purrr)
library(tidyverse)
library(DT)
tickers = c("SPY", "IWM", "QQQ", "TLT", "AGG", "GLD", "SLV")
suppressWarnings()

ui <- fluidPage(

  # Application title
  titlePanel("Portfolio Builder"),

  #select the stocks you want to analyze
  mainPanel(
    selectizeInput("mult", "chose stock", choices = tickers, selected = "SPY", multiple = T),
    uiOutput("plo"),
    dataTableOutput("dataTab")
  )


)

# Define server logic required to draw a histogram
server <- function(input, output) {

  output$plo = renderUI({
    z = length(input$mult)
    name = input$mult
    map2(seq(z), name,  ~ numericInput(inputId = paste0("hey",.x), label = paste("weight", .y), value = 10))

  })

  weights = reactive({
    req(input$mult)
    list(current = map(seq(length(input$mult)),~input[[paste0("hey",.x)]]) %>% unlist())
  })


  mat = reactive({
    req(weights()$current)
    if(length(weights()$current) == length(input$mult)){
      df = data.frame(ticker = input$mult, weight = weights()$current) %>% mutate(weightPct = weights()$current/sum(weights()$current))
    }
  })

  output$dataTab = renderDataTable({
    req(mat())
    mat()
  })


}

shinyApp(ui, server)
person Ryan Morton    schedule 13.08.2019