0

agradecería me pudierais ayudar con un problema. El siguiente código funciona sin problemas:

years <- c(2017,2018,2019,2017,2017,2018,2018,2019)
obs <- c("a","b","c","d","e","f","g","h")
df <- data.frame(years,obs)

anos <- unique(df$years)

for (val in anos){
    assign(paste0("df_",val), filter(df, years == val))
}

Me genera tres dataframes para los valores de cada año.

Sin embargo cuando intento hacer lo mismo en shiny:

library(shiny)

years <- c(2017,2018,2019,2017,2017,2018,2018,2019)
obs <- c("a","b","c","d","e","f","g","h")
df <- data.frame(years,obs)

ui <- fluidPage(
    sidebarPanel(
    radioButtons("year","year",choices=c(2017,2018,2019)),
    pickerInput("valor","valor",choices=obs,selected=obs,multiple=TRUE)
    ),
  mainPanel(
    htmlOutput("result")
  )
)

server <- function(input,output,session){
    df_val <- reactive({
            filter(df, obs %in% input$valor)
    })

    anos <- reactive(unique(df_val()$years))

    for (val in anos){
            assign(paste0("df_",val),filter(df_val(), years == val))
    }
}      

shinyApp(ui=ui,server=server)

Me genera el siguiente error:

Error in server(...) : 
  long vectors not supported yet: ../../../../R-3.5.3/src/main/eval.c:2204

Me podríais explicar el porqué de este comportamiento, y si hay alguna forma de solucionarlo o hacer algo parecido. Necesito crear nuevos dataframes basados en los valores de un input. Este es un ejemplo para explicar el problema, pero la aplicación en la que trabajo es mucho más compleja; sin embargo necesito que el código genere lo mismo: si el usuario establece que quiere desagregar los datos por años, preciso de crear dataframes para esos años para graficar y analizar los datos de esos años.

Muchas gracias por adelantado, un saludo

4
  • 1
    El error que mencionas no perece ser un error que pueda reproducirse con tu ejemplo. De hecho el ejemplo produce otro, producto que el loop pareciera tener que estar dentro de alguno de los reactive. Tu error parece ser más bien alguna manipulación mediante un índice, de un vector mayor a 2^31 elementos en un plataforma de 64 bits. Te sugiero que copies el código exacto del error, y el mensaje completo del mismo. Otra cosa que puedes probar es migrar a R 3.6 que según parece ha corregido varios de estos problemas. Commented el 20 may. 2019 a las 16:06
  • Muchas gracias @PatricioMoracho como siempre por tu ayuda. Lamentablemente, aun migrando a 3.6 el problema persiste. Me extraña que no puedas reproducir el error con el código que adjunté, pues a mí me genera el mismo error tanto el código original como el que cree para adjuntarlo a mi pregunta. El por qué no aportar el código original es porque es excesivamente largo (más de 600 líneas de código por el momento) y con continuas referencias a inputs y outputs a través de observe y reactive, con lo que es casi imposible extraer el trozo problemático, pero también reside en el loop. Commented el 21 may. 2019 a las 19:21
  • La idea del loop es que la aplicación se alimenta de una base de datos de varios años de observaciones y de hecho la estamos completando retroactivamente y también esperamos que continue recibiendo insumos por un tiempo. Cuando el usuario requiere los datos desagregados por años o meses, la idea es que a través de ese loop, se puedan general datos anuales, sin depender de ninguna operación manual ni de cuantos años haya registrados. Me pareció una solución elegante, general dataframes anuales tanto para no depender de facet exclusivamente en los gráficos y para desagregar las cifras. Commented el 21 may. 2019 a las 19:25
  • El ejemplo, agregándole library(shinyWidgets), al ejecutarlo me da el siguiente error: 52: server [/home/pmoracho/app.R#25] Error in for (val in anos) { : secuencia loop for() inválida. Corrigiendo esto, no he tenido ningún otro error. Además, no veo el por que de ese mensaje con el código que tienes. Insisto que el error pareciera estar asociado a una limitación de R al acceder por medio de un índice a objetos de gran tamaño. stackoverflow.com/questions/24335692/… Commented el 22 may. 2019 a las 3:44

1 respuesta 1

0

Pues por fin lo he conseguido...después de varios días de ensayo y error. No sé los fundamentos de ello, pero para que funcione, había que modificar el código en algunos aspectos:

  1. En el bucle for, había un error, puesto que anos debe llevar paréntesis, puesto que se había construido como asignación reactiva.
  2. El bucle debe ir dentro de un observe, y dentro del bucle se deben construir todos los objetos, y dentro del observe debe estar la salida también. No sé por qué pero si intento llamar desde fuera a un objeto creado dentro del bucle, no lo reconoce, mientras que desde dentro del bucle, sí.

El código queda así:

library(shiny)
years <- c(2017,2018,2019,2017,2017,2018,2018,2019,2017)
obs <- c("a","b","c","d","e","f","g","h","i")
df <- data.frame(years,obs)
ui <- fluidPage(
       sidebarPanel(
    checkboxGroupInput("year","year",choices=c(2017,2018,2019),selected=c(2017,2018,2019)),
    checkboxGroupInput("ob","ob",choices=obs,selected=obs)
                               ),
    mainPanel(
         verbatimTextOutput("result")
             )
        )

    server <- function(input,output,session){
                dfval <- reactive({
                        filter(df, obs %in% input$ob)
                        })
                anos <- reactive(unique(dfval()$years))
                cadena <- ""      
                observe({
                 for (val in anos()){
                   assign(paste0("dfval",val),filter(dfval(), years == val))
                   assign(paste0("str0",val),paste0("Año: ",val))
                   assign(paste0("str1",val),paste0("Longitud :", length(get(paste("dfval",val,sep=""))[[1]])))    
                   cadena <- paste(cadena, get(paste("str0",val,sep="")), get(paste("str1",val,sep=""))) 
                      }
                  output$result <- renderPrint({
                    cadena
                      })      
                   })     
                 }
    shinyApp(ui=ui,server=server)

Con este código de ejemplo, he podido arreglar el código de la aplicación original, que tiene cierta complejidad, y por ello sólo muestro aquí el extracto donde se crean de esta forma todas las variables en función de los insumos del usuario:

anos <- reactive ({unique(data_DA_y()$ano)})
cadena <- ""

observe({
  if (input$plottypeDA ==2){
    if(input$genderDA == TRUE){
      if(input$ageDA == FALSE){
        for (val in anos()){
          assign(paste0("data_DA",val), data_DA_y() %>% filter(ano == val))
          assign(paste0("women_DA",val), data_DA_y() %>% filter(gender == "Female", ano == val))
          assign(paste0("men_DA",val), data_DA_y() %>% filter(gender == "Male", ano == val))

          assign(paste0("str0",val),paste0("<b> Year: ",val,"</b>"))
          assign(paste0("str1",val),paste0("Number total of people receiving MHPSS:",length(get(paste("data_DA",val,sep=""))[[1]])))
          assign(paste0("str2",val),paste0("Women: ", length(get(paste("women_DA",val,sep=""))[[1]])))
          assign(paste0("str3",val),paste0("Men: ",length(get(paste("men_DA",val,sep=""))[[1]])))

          cadena <- paste(cadena,get(paste("str0",val,sep="")),get(paste("str1",val,sep="")),get(paste("str2",val,sep="")),get(paste("str3",val,sep="")),sep="<br/>")
        }
          output$figuresDA <- renderUI({HTML(cadena)})

        } else {
        for (val in anos()) { 
          assign(paste0("data_DA",val), data_DA_y() %>% filter(ano == val))
          assign(paste0("adult_DA",val), data_DA_y() %>% filter(age > 17, ano == val))
          assign(paste0("child_DA",val), data_DA_y() %>% filter(age < 18, ano == val))
          assign(paste0("adult_women_DA",val), data_DA_y() %>% filter(gender == "Female", age > 17, ano == val))
          assign(paste0("child_women_DA",val), data_DA_y() %>% filter(gender == "Female", age < 18, ano == val))
          assign(paste0("adult_men_DA",val), data_DA_y() %>% filter(gender == "Male", age > 17, ano == val))
          assign(paste0("child_men_DA",val), data_DA_y() %>% filter(gender == "Male", age < 18, ano == val))

          assign(paste0("str0",val),paste0("<b> Year: ",val,"</b>"))
          assign(paste0("str1",val),paste0("Number total of people receiving MHPSS: ",length(get(paste("data_DA",val,sep=""))[[1]])))
          assign(paste0("str2",val),paste0("Women: ", length(get(paste("adult_women_DA",val,sep=""))[[1]])))
          assign(paste0("str3",val),paste0("Men: ",length(get(paste("adult_men_DA",val,sep=""))[[1]])))
          assign(paste0("str4",val),paste0("Girls: ", length(get(paste("child_women_DA",val,sep=""))[[1]])))
          assign(paste0("str5",val),paste0("Boys: ",length(get(paste("child_men_DA",val,sep=""))[[1]])))

          cadena <- paste(cadena,get(paste("str0",val,sep="")),get(paste("str1",val,sep="")),get(paste("str2",val,sep="")),get(paste("str3",val,sep="")),get(paste("str4",val,sep="")),get(paste("str5",val,sep="")),sep="<br/>")

          }
          output$figuresDA <- renderUI({HTML(cadena)})

        } 
      } else {
          if(input$ageDA == FALSE){
            for (val in anos()){
              assign(paste0("data_DA",val), data_DA_y() %>% filter(ano == val))

              assign(paste0("str0",val),paste0("<b> Year: ",val,"</b>"))
              assign(paste0("str1",val),paste0("Number total of people receiving MHPSS:",length(get(paste("data_DA",val,sep=""))[[1]])))

              cadena <- paste(cadena,get(paste("str0",val,sep="")),get(paste("str1",val,sep="")),sep="<br/>")
            }
            output$figuresDA <- renderUI({HTML(cadena)})

          } else {
            for (val in anos()) { 
              assign(paste0("data_DA",val), data_DA_y() %>% filter(ano == val))
              assign(paste0("adult_DA",val), data_DA_y() %>% filter(age > 17, ano == val))
              assign(paste0("child_DA",val), data_DA_y() %>% filter(age < 18, ano == val))

              assign(paste0("str0",val),paste0("<b> Year: ",val,"</b>"))
              assign(paste0("str1",val),paste0("Number total of people receiving MHPSS: ",length(get(paste("data_DA",val,sep=""))[[1]])))
              assign(paste0("str2",val),paste0("Adults : ", length(get(paste("adult_DA",val,sep=""))[[1]])))
              assign(paste0("str3",val),paste0("Children: ",length(get(paste("child_DA",val,sep=""))[[1]])))

              cadena <- paste(cadena,get(paste("str0",val,sep="")),get(paste("str1",val,sep="")),get(paste("str2",val,sep="")),get(paste("str3",val,sep="")),sep="<br/>")
            }
            output$figuresDA <- renderUI({HTML(cadena)})
        }
      }
  } else {
    if(input$genderDA == TRUE) {
      if(input$ageDA == FALSE){
        str1 <- paste("Number total of people receiving MHPSS:",length(data_DA()[[1]]))
        str2 <- paste("Women: ", length(women_DA()[[1]]))
        str3 <- paste("Men: ",length(men_DA()[[1]]))

        output$figuresDA <- renderUI({HTML(paste(str1,str2,str3,sep="<br/>"))})

      } else {
        str1 <- paste("Number total of people receiving MHPSS: ",length(data_DA()[[1]]))
        str2 <- paste("Women: ", length(adult_women_DA()[[1]]))
        str3 <- paste("Men: ",length(adult_men_DA()[[1]]))
        str4 <- paste("Girls: ", length(child_women_DA()[[1]]))
        str5 <- paste("Boys: ",length(child_men_DA()[[1]]))

        output$figuresDA <- renderUI({HTML(paste(str1,str2,str3,str4,str5, sep="<br/>"))})
      }
    } else {
      if(input$ageDA == FALSE){
        str1 <- paste("Number total of people receiving MHPSS: ",length(data_DA()[[1]]))

        output$figuresDA <- renderUI({HTML(str1)})
      } else {
        str1 <- paste("Number total of people receiving MHPSS: ",length(data_DA()[[1]]))
        str2 <- paste("Adults : ", length(adult_DA()[[1]]))
        str3 <- paste("Children: ",length(child_DA()[[1]]))

        output$figuresDA <- renderUI({HTML(paste(str1,str2,str3,sep="<br/>"))})
      }
    }

    }
})

Ahora tengo un nuevo problema...en local, funciona sin problema, pero en shinyapps.io no consigo que se cargue la información porque se desconecta del servidor antes de que se cargue la página. Me pongo a ello.

5
  • 1
    Puedes revisar el log de la aplicación en shinyapps.io para ver cual es el error que provoca que se desconecte el servidor. Commented el 24 may. 2019 a las 22:42
  • Gracias Rolando por tu sugerencia. Mirando el log no encuentro la razón de la desconexión. Pienso que puede estar relacionado con el hecho de que la versión gratuita establece determinados límites en lo que respecta a memoria y carga de datos. Ahora estoy trabajando en desplegar la aplicación en un servidor shiny a través de una instancia de aws. Gracias. Commented el 29 may. 2019 a las 5:43
  • Pedro como vas, encontraste la solución? Commented el 10 jun. 2019 a las 21:02
  • Hola Rolando, pues antes de intentar instalar un servidor de shiny en una instancia de AWS, he seguido trabajando en la aplicación en sí misma que se ha vuelto bastante compleja y farragosa en terminos de código. Y cuando he acabado la primera version completa, para mi sorpresa, al republicarla en shinyapps.io pues ahora parece que funciona y no da problemas de desconexion de servidor! Se carga con un poco de lentitud pero no se desconecta! Si quieres echarle un vistazo este es el link: gis4health-pjporrino.shinyapps.io/MdM_Palestine_Dashboard Gracias Commented el 17 jun. 2019 a las 18:21
  • Hola Pedro, gracias por compartir tu aplicación me parece muy interesante. Te comento que en mi caso particular no tuve problemas con la velocidad de carga. Que bueno que ya no tienes problema de desconexion con shinyapps.io! Parece haber varias posibles causas encontré este articulo que te da un poco más de información sobre el tema (por si regresa) support.rstudio.com/hc/en-us/articles/… . Commented el 18 jun. 2019 a las 1:28

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.