Reactive changes in sliderInput for subsets

Question

I'm trying to develop a reactive slider but I don't understand why it doesn't work and get the error: "Warning: Error in [.data.frame: undefined columns selected". Any help would be much appreciated.

So far I've tried to use uiOutput("slider") to call the object from server.

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)
})
  }

Here you can download a sample of SF.rds: https://1drv.ms/u/s!Aiohja7mVQ6xkB14sqWkrR2dvrw6 — José Vallejo, Sep 20 '16 at 19:53
What I have noticed now is that tabla_seg = DF[DF$cod_ent == args] is not selecting any column this should probably be tabla_seg = DF[DF$cod_ent == args, ]. Let me know if this improves the situation... — Valter Beaković, Sep 20 '16 at 20:06
Though it works now, there are three warning messages that appear **before** showing the objects. These are: "Error in order: argument 1 is not a vector" for the graphics, and "Error in $<-.data.frame: replacement has 1 row, data has 0" for the table. :S — José Vallejo, Sep 20 '16 at 20:39

score 0 · Answer 1 · answered Sep 22 '16 at 17:15

I have checked the code. Below you can see the modified code. I think that the problem is that the input$inslider renders after the call tabla_fec <- reactive. The modided code should handle that. Note that I gave put DF <- readRDS("./data/SF2.rds") in global.R so that DF is available both in ui.R and server.R with reading it two times.

This is the modified 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())
                    })
            })

Let me know if this helps.

Reactive changes in sliderInput for subsets

1 Answers1