Реактивные изменения в sliderInput для подмножеств

Question

Я пытаюсь разработать реактивный слайдер, но я не понимаю, почему он не работает и получает ошибку: «Предупреждение: ошибка в [.data.frame: неопределенные столбцы выбраны» , Любая помощь будет высоко оценена.

До сих пор я пытался использовать uiOutput («ползунок») для вызова объекта с сервера.

ui.r

library(shiny) 
    DF <- readRDS("data/SF.rds") 
    shinyUI(fluidPage(
    titlePanel("Cartera Total - Bancos"), 

    sidebarLayout(
    sidebarPanel(
    helpText("Evolución de la cartera total según entidad bancaria"), 

    selectInput("var", 
    label = "Entidad Financiera", 
    choices = c('B. AZTECA', 
       'B. CENCOSUD PERU', 
       'B. CONTINENTAL', 
       'B. DE COMERCIO', 
       'B. DE CREDITO DEL PERU', 
       'B. FALABELLA PERU', 
       'B. FINANCIERO', 
       'B. GNB', 
       'B. ICBC', 
       'B. INTERAMERICANO DE FINANZAS', 
       'B. RIPLEY', 
       'B. SANTANDER PERU', 
       'CITIBANK', 
       'INTERBANK', 
       'MIBANCO', 
       'SCOTIABANK PERU'), 
    selected = "BANCO AZTECA"), 

    uiOutput("slider") 

), 

mainPanel(
    fluidRow(
     column(12, 
      splitLayout(cellWidths = c("50%", "50%"), 
         plotlyOutput("deuda_dir"), 
         plotlyOutput("deuda_mora")) 
     ) 
     , 
     column(10, 
      tabsetPanel(id = 'Entidad', 
         DT::dataTableOutput("tabla") 
     )) 
    ) 
) 
) 
)) 

server.r:

library(shiny) 
    library(plotly) 
    library(ggplot2) 
    library(scales) 

    DF <- readRDS("data/SF.rds") 

    ban_sit <- function(df){ 
    # Seleccionas y luego : Ctrl+R 
    p <- ggplot(data = df, 
      aes(x = fec_cierre, 
       y = TotalCreditosDirectos/1000)) + 
geom_line(colour = "midnightblue")+ 
scale_y_continuous(labels = comma)+ 
xlab("Fecha de Cierre")+ 
ylab("Créditos Directos (En MM de Soles)") 
gg <- ggplotly(p) 
gg 
} 
ban_mora <- function(df){ 
p <- ggplot(data = df, 
      aes(x = fec_cierre, 
       y = Deuda_Mora_porc)) + 
geom_line(colour = "firebrick4")+ 
scale_y_continuous(labels = comma)+ 
xlab("Fecha de Cierre")+ 
ylab("Ratio de Mora (%)") 
gg <- ggplotly(p) 
gg 
} 


    shinyServer(
    function(input, output) { 
    tabla_seg <- reactive({ 
    args <- switch(input$var, 
    'B. AZTECA'='B001', # Solo entidades activas 
    'B. CENCOSUD PERU'='B002', 
    'B. CONTINENTAL'='B003', 
    'B. DE COMERCIO'='B004', 
    'B. DE CREDITO DEL PERU'='B005', 
    'B. FALABELLA PERU'='B007', 
    'B. FINANCIERO'='B008', 
    'B. GNB'='B009', 
    'B. ICBC'='B010', 
    'B. INTERAMERICANO DE FINANZAS'='B011', 
    'B. RIPLEY'='B012', 
    'B. SANTANDER PERU'='B014', 
    'CITIBANK'='B020', 
    'INTERBANK'='B023', 
    'MIBANCO'='B024', 
    'SCOTIABANK PERU'='B025') 

    tabla_seg = DF[DF$cod_ent == args] 
}) 

output$slider <- renderUI({ 
    sliderInput("inslider","Slider", 
       min = min(tabla_seg()$fec_cierre), 
       max = max(tabla_seg()$fec_cierre), 
       value = c(min(tabla_seg()$fec_cierre),  
          max(tabla_seg()$fec_cierre)) 
)}) 


tabla_fec <- reactive({ 

    tabla_fec = tabla_seg()[tabla_seg()$fec_cierre >= input$inslider[1] & 
         tabla_seg()$fec_cierre <= input$inslider[2],] 

    tabla_fec[order(tabla_fec$fec_cierre, 
           decreasing = TRUE),] 


}) 

output$deuda_dir <- renderPlotly({ 
    ban_sit(tabla_fec()) 
}) 

output$deuda_mora <- renderPlotly({ 
    ban_mora(tabla_fec()) 
}) 

output$tabla <- DT::renderDataTable({ 
    tab = tabla_fec() 
    row.names(tab) = NULL 
    tab$TotalCreditosDirectos <- formatC(tab$TotalCreditosDirectos, 
             format="d", 
             big.mark=',') 

    tab$Deuda_Mora_porc <- round(tab$Deuda_Mora_porc, 2)            

    tab <- tab[,c("fec_cierre", 
        "TotalCreditosDirectos", 
        "Deuda_Mora_porc")] 
    names(tab) <- c("Fecha de cierre", 
        "Deuda Directa (S/.)", 
        "Mora (%)")    
    DT::datatable(tab) 
}) 
    } 

Answer 1

Я проверил код. Ниже вы можете увидеть измененный код. Я думаю, что проблема в том, что входной $ inslider оказывает после вызова tabla_fec < - реактивный. Модифицированный код должен справиться с этим. Обратите внимание, что я дал put DF < - readRDS ("./ data/SF2.rds") в global.R, чтобы DF был доступен как в ui.R, так и server.R с чтением его два раза.

Это модифицированный server.R

library(shiny) 
    library(plotly) 
    library(ggplot2) 
    library(scales) 



    ban_sit <- function(df){ 
      # Seleccionas y luego : Ctrl+R 
      p <- ggplot(data = df, 
         aes(x = fec_cierre, 
          y = TotalCreditosDirectos/1000)) + 
        geom_line(colour = "midnightblue")+ 
        scale_y_continuous(labels = comma)+ 
        xlab("Fecha de Cierre")+ 
        ylab("Créditos Directos (En MM de Soles)") 
      gg <- ggplotly(p) 
      gg 
    } 
    ban_mora <- function(df){ 
      p <- ggplot(data = df, 
         aes(x = fec_cierre, 
          y = Deuda_Mora_porc)) + 
        geom_line(colour = "firebrick4")+ 
        scale_y_continuous(labels = comma)+ 
        xlab("Fecha de Cierre")+ 
        ylab("Ratio de Mora (%)") 
      gg <- ggplotly(p) 
      gg 
    } 


    shinyServer(
      function(input, output) { 
        tabla_seg <- reactive({ 
          args <- switch(input$var, 
              'B. AZTECA'='B001', # Solo entidades activas 
              'B. CENCOSUD PERU'='B002', 
              'B. CONTINENTAL'='B003', 
              'B. DE COMERCIO'='B004', 
              'B. DE CREDITO DEL PERU'='B005', 
              'B. FALABELLA PERU'='B007', 
              'B. FINANCIERO'='B008', 
              'B. GNB'='B009', 
              'B. ICBC'='B010', 
              'B. INTERAMERICANO DE FINANZAS'='B011', 
              'B. RIPLEY'='B012', 
              'B. SANTANDER PERU'='B014', 
              'CITIBANK'='B020', 
              'INTERBANK'='B023', 
              'MIBANCO'='B024', 
              'SCOTIABANK PERU'='B025') 

          tabla_seg = DF[DF$cod_ent == args, , drop = FALSE] 
        }) 

        output$slider <- renderUI({ 
          sliderInput("inslider","Slider", 
             min = min(tabla_seg()$fec_cierre), 
             max = max(tabla_seg()$fec_cierre), 
             value = c(min(tabla_seg()$fec_cierre),  
                max(tabla_seg()$fec_cierre)) 
          )}) 


        tabla_fec <- reactive({ 

          if (!is.null(input$inslider[1]) || !is.null(input$inslider[2])) { 
          tabla_fec = tabla_seg()[tabla_seg()$fec_cierre >= input$inslider[1] & 
                  tabla_seg()$fec_cierre <= input$inslider[2], ] 
          } else { 
            tabla_fec <- tabla_seg()   
          } 

          tabla_fec[order(tabla_fec$fec_cierre, 
              decreasing = TRUE), ] 


        }) 

        output$deuda_dir <- renderPlotly({ 
          ban_sit(tabla_fec()) 
        }) 

        output$deuda_mora <- renderPlotly({ 
          ban_mora(tabla_fec()) 
        }) 

        output$tabla <- DT::renderDataTable({ 
          tab = tabla_fec() 
          row.names(tab) = NULL 
          tab$TotalCreditosDirectos <- formatC(tab$TotalCreditosDirectos, 
                   format="d", 
                   big.mark=',') 

          tab$Deuda_Mora_porc <- round(tab$Deuda_Mora_porc, 2) 

          tab <- tab[,c("fec_cierre", 
              "TotalCreditosDirectos", 
              "Deuda_Mora_porc")] 
          names(tab) <- c("Fecha de cierre", 
              "Deuda Directa (S/.)", 
              "Mora (%)") 
          DT::datatable(tab) 
        }) 
        output$letsee <- renderText({ 
          class(tabla_fec()) 
        }) 
      }) 

Позвольте мне знать, если это помогает.