es.davy.ai

Preguntas y respuestas de programación confiables

¿Tienes una pregunta?

Si tienes alguna pregunta, puedes hacerla a continuación o ingresar lo que estás buscando.

Agregar la opción de casilla de verificación para efectos de filtrado.

15 Jun, 2023 Programación

Estoy construyendo una aplicación Shiny en la que estoy tratando de implementar un filtro de tipo checkbox.

En la entrada llamada “phones” hay una opción titulada “Sí”. Cuando se marca “Sí”, limitará a cualquiera en “df” cuyo campo para “teléfono” NO SEA NA. Cuando no está marcado, incluirá todos los campos bajo “teléfono” independientemente de si está o no NA.

El error que recibo:
Advertencia: Error en: Problema con la entrada de filter() ..1. ℹ La entrada ..1 es &.... x input$phones == "Yes" ~ !is.na(temp_data$phone),TRUE ~ !is.na(temp_data$phone) & is.na(temp_data$phone) debe tener una longitud de 0 o uno, no 10000

global.R:

biblioteca(civis)
biblioteca(dbplyr)
biblioteca(dplyr)
biblioteca(reluciente)
biblioteca(relucienteWidgets)
biblioteca(DT)

df <- leer.csv(‘https://raw.githubusercontent.com/datacfb123/testdata/main/sampleset_df.csv’)

ui:

de fluidPage(
  titlePanel(“Muestra”),
  sidebarLayout(
    sidebarPanel(
      selectizeInput(“data1”, “Seleccionar Estado”, opciones = c(“Todo”, único(df$estado))),
      selectizeInput(“data2”, “Seleccionar Condado”, opciones = NULL),
      selectizeInput(“data3”, “Seleccionar Ciudad”, opciones = NULL),
      selectizeInput(“data4”, “Seleccionar Demo”, opciones = c(“Todo”, único(df$demo))),
      selectizeInput(“data5”, “Seleccionar Estado”, opciones = c(“Todo”, único(df$status))),
      sliderInput(“edad”, etiqueta = h3(“Seleccionar rango de edad”), 18,
                  35, valor = c(18, 20), redondo = TRUE, paso = 1),
      sliderInput(“score1”, etiqueta = h3(“Seleccionar rango de puntuación1”), min = 0,
                  máx. = 100, valor = c(20,80)),
      sliderInput(“score2”, etiqueta = h3(“Seleccionar rango de puntuación2”), min = 0,
                  máx. = 100, valor = c(20,80)),
      prettyCheckboxGroup(“telefonos”, h3(“¿Incluir solo números de teléfono válidos?”), seleccionado = “Sí”, opciones = lista(“Sí”)),
      downloadButton(“descargar”, “Descargar datos”)
    ),
    panel principal(
      DTOutput(“tabla”)
    )
 ))

servidor:

  servidor <- función (entrada, salida, sesión) {

  observeEvent(input$data1, {
    if (input$data1 != “Todo”) {
      updateSelectizeInput(sesión, “data2”, “Seleccionar Condado”,  servidor = VERDADERO, opciones = c(“Todo”, único(df$condado[df$estado == input$data1])))
    } más {
      updateSelectizeInput(sesión, “data2”, “Seleccionar Condado”,  servidor = VERDADERO, opciones = c(“Todo”, único(df$condado)))
    }
  }, prioridad = 2)

  observeEvent(c(input$data1, input$data2), {
    if (input$data2 != “Todo”) {
      updateSelectizeInput(sesión, “data3”, “Seleccionar Ciudad”, servidor = VERDADERO, opciones = c(“Todo”, único(df$ciudad[df$condado == input$data2])))
    } más {
      if (input$data1 != “Todo”) {
        updateSelectizeInput(sesión, “data3”, “Seleccionar Ciudad”, servidor = VERDADERO, opciones = c(“Todo”, único(df$ciudad[df$estado == input$data1])))
      } más {
        updateSelectizeInput(sesión, “data3”, “Seleccionar Ciudad”, servidor = VERDADERO, opciones = c(“Todo”, único(df$ciudad)))
      }
    }
  }, prioridad = 1)

  datos_filtrados <- reactivo({
    temp_data <- df
    if (input$data1 != “Todo”) {
      temp_data <- temp_data[temp_data$estado == input$data1, ]
    }
    if (input$data2 != “Todo”) {
      temp_data <- temp_data[temp_data$condado == input$data2, ]
    }
    if (input$data3 != “Todo”) {
      temp_data <- temp_data[temp_data$ciudad == input$data3, ]
    }
    if (input$data4 != “Todo”) {
      temp_data <- temp_data[temp_data$demo == input$data4, ]
    }
    if (input$data5 != “Todo”) {
      temp_data <- temp_data[temp_data$status == input$data5, ]
    }

    temp_data %>% filtrar(temp_data$edad >= input$edad[1] &
temp_data$edad <= input$edad[2] &
temp_data$score1 >= input$score1[1] &
temp_data$score1 <= input$score1[2] &
temp_data$score2 >= input$score2[1] &
temp_data$score2 <= input$score2[2] &
case_when(input$telefonos == ‘Sí’ ~ !is.na(temp_data$teléfono),
TRUE ~ !is.na(temp_data$teléfono) & is.na(temp_data$teléfono)))

  })

  output$table <- renderDT(     filtered_data() %>% seleccionar(unique_id, first_name, last_name, phone)
  )

  output$download <- downloadHandler(     filename = function() {       paste("universo", "_", date(), ".csv", sep="")     },     contenido = function(file) {       write.csv(filtered_data() %>% seleccionar(unique_id, first_name, last_name, phone) %>% distinct_all(), file, row.names = FALSE)
    }
  )

}

Tags:  , , ,

Answer

  1. Avatar for davy.ai
    davy.ai

    En el archivo server.R, se ha añadido una condición de filtro para la entrada de casilla de verificación phones en el campo temp_data$phone. Cuando se marca la casilla, establece la condición de is.na en FALSE y cuando se desmarca, establece la condición en TRUE. El mensaje de error sugiere que la longitud de la declaración de la condición es 10000, lo cual no es lo que espera Shiny.

    El problema está en el uso del operador %>%. En lugar de encadenar las condiciones de filtro con %>%, podemos usar declaraciones if anidadas para construir la condición de filtro.

    Aquí está el código actualizado de server.R:

    server <- function(input, output, session){

  observeEvent(input$data1, {
    if (input$data1 != "All") {
      updateSelectizeInput(session, "data2", "Seleccionar provincia", server = TRUE, choices = c("All", unique(df$county[df$state == input$data1])))
    } else {
      updateSelectizeInput(session, "data2", "Seleccionar provincia", server = TRUE, choices = c("All", unique(df$county)))
    }
  }, priority = 2)

  observeEvent(c(input$data1, input$data2), {
    if (input$data2 != "All") {
      updateSelectizeInput(session, "data3", "Seleccionar ciudad", server = TRUE, choices = c("All", unique(df$city[df$county == input$data2])))
    } else {
      if (input$data1 != "All") {
        updateSelectizeInput(session, "data3", "Seleccionar ciudad", server = TRUE, choices = c("All", unique(df$city[df$state == input$data1])))
      } else {
        updateSelectizeInput(session, "data3", "Seleccionar ciudad", server = TRUE, choices = c("All", unique(df$city)))
      }
    }
  }, priority = 1)

  filtered_data <- reactive({
    temp_data <- df
    if (input$data1 != "All") {
      temp_data <- temp_data[temp_data$state == input$data1, ]
    }
    if (input$data2 != "All") {
      temp_data <- temp_data[temp_data$county == input$data2, ]
    }
    if (input$data3 != "All") {
      temp_data <- temp_data[temp_data$city == input$data3, ]
    }
    if (input$data4 != "All") {
      temp_data <- temp_data[temp_data$demo == input$data4, ]
    }
    if (input$data5 != "All") {
      temp_data <- temp_data[temp_data$status == input$data5, ]
    }

    if (input$phones == "Yes") {
      temp_data <- temp_data[!is.na(temp_data$phone), ]
    } else {
      temp_data <- temp_data[!is.na(temp_data$phone) | is.na(temp_data$phone), ]
    }

    temp_data <- if(input$age[1]!="" & input$age[2]!="") {
      if(nrow(temp_data)>0){
        temp_data <- temp_data[temp_data$age>=input$age[1]&temp_data$age<=input$age[2]]
      } else {
        temp_data <- df
        if (input$data1 != "All") {
          temp_data <- temp_data[temp_data$state == input$data1, ]
        }
        if (input$data2 != "All") {
          temp_data <- temp_data[temp_data$county == input$data2, ]
        }
        if (input$data3 != "All") {
          temp_data <- temp_data[temp_data$city == input$data3, ]
        }
        if (input$data4 != "All") {
          temp_data <- temp_data[temp_data$demo == input$data4, ]
        }
        if (input$data5 != "All") {
          temp_data <- temp_data[temp_data$status == input$data5, ]
        }
        if (input$phones == "Yes") {
          temp_data <- temp_data[!is.na(temp_data$phone), ]
        } else {
          temp_data <- temp_data[!is.na(temp_data$phone) | is.na(temp_data$phone), ]
        }
        temp_data
      }
    } else {
      temp_data
    }

    temp_data <- if(input$score1[1]!="" & input$score1[2]!="") {
      if(nrow(temp_data)>0){
        temp_data <- temp_data[temp_data$score1>=input$score1[1]&temp_data$score1<=input$score1[2]]
      } else {
        temp_data <- df
        if (input$data1 != "All") {
          temp_data <- temp_data[temp_data$state == input$data1, ]
        }
        if (input$data2 != "All") {
          temp_data <- temp_data[temp_data$county == input$data2, ]
        }
        if (input$data3 != "All") {
          temp_data <- temp_data[temp_data$city == input$data3, ]
        }
        if (input$data4 != "All") {
          temp_data <- temp_data[temp_data$demo == input$data4, ]
        }
        if (input$data5 != "All") {
          temp_data <- temp_data[temp_data$status == input$data5, ]
        }
        if (input$phones == "Yes") {
          temp_data <- temp_data[!is.na(temp_data$phone), ]
        } else {
          temp_data <- temp_data[!is.na(temp_data$phone) | is.na(temp_data$phone), ]
        }
        if(input$age[1]!="" & input$age[2]!=""){
          temp_data <- temp_data[temp_data$age>=input$age[1]&temp_data$age<=input$age[2]]
        }
        temp_data
      }
    } else {
      temp_data
    }

     temp_data <- if(input$score2[1]!="" & input$score2[2]!="") {
      if(nrow(temp_data)>0){
        temp_data <- temp_data[temp_data$score2>=input$score2[1]&temp_data$score2<=input$score2[2]]
      } else {
        temp_data <- df
        if (input$data1 != "All") {
          temp_data <- temp_data[temp_data$state == input$data1, ]
        }
        if (input$data2 != "All") {
          temp_data <- temp_data[temp_data$county == input$data2, ]
        }
        if (input$data3 != "All") {
          temp_data <- temp_data[temp_data$city == input$data3, ]
        }
        if (input$data4 != "All") {
          temp_data <- temp_data[temp_data$demo == input$data4, ]
        }
        if (input$data5 != "All") {
          temp_data <- temp_data[temp_data$status == input$data5, ]
        }
        if (input$phones == "Yes") {
          temp_data <- temp_data[!is.na(temp_data$phone), ]
        } else {
          temp_data <- temp_data[!is.na(temp_data$phone) | is.na(temp_data$phone), ]
        }
        if(input$age[1]!="" & input$age[2]!=""){
          temp_data <- temp_data[temp_data$age>=input$age[1]&temp_data$age<=input$age[2]]
        }
        if(input$score1[1]!="" & input$score1[2]!=""){
          temp_data <- temp_data[temp_data$score1>=input$score1[1]&temp_data$score1<=input$score1[2]]
        }
        temp_data
      }
    } else {
      temp_data
    }

    temp_data %>% select(unique_id, first_name, last_name, phone)
  })

  output$table <- renderDT(
    filtered_data()
  )

  output$download <- downloadHandler(
    filename = function() {
      paste("universo", "_", date(), ".csv", sep="")
    },
    content = function(file) {
      write.csv(filtered_data() %>% distinct_all(), file, row.names = FALSE)
    }
  )
}

    Ahora la condición de filtro para el campo phone se construye dentro de la declaración if-else, basada en el valor de la casilla de verificación, en lugar de encadenarla con %>%. Esto debería solucionar el error.

Comments are closed.