convert list to data frame from the list of reactive values (generated from dynamic UI input)

shiny
, ,
1

Hello, I need help of how to convert a list of reactive values from dynamic UI input into a dataframe. I have tried unlist() and unest() but non worked.

This is how I group the reactive values from the ui input together.

  return(c(reactive({input$FilmProducer}), 
           reactive({input$Series}),
           reactive({input$Episode})
  ))
}

And here is how I read it and render it as text (which works)

ui <- fluidPage(  
  div(id="placeholder"),
  actionButton("submit", "Add Selection:"),
  verbatimTextOutput("out")
)

server <- function(input, output, session) {
  handler <- reactiveVal(list())
  observeEvent(input$submit, {
    new_id <- paste("row", input$submit, sep = "_")
    insertUI(
      selector = "#placeholder",
      where = "beforeBegin",
      ui = row_ui(new_id)
    )
    handler_list <- isolate(handler())
    new_handler <- callModule(row_server, new_id)
    handler_list <- c(handler_list, new_handler)
    names(handler_list)[length(handler_list)] <- new_id
    handler(handler_list)
  })
  
  output$out <- renderPrint({
    lapply(handler(), function(handle) {
      handle()
    })
  })
}

However I cannot convert this list into a dataframe and render as table output. Please help.

I included the full code below.
My input

structure(list(FilmProducer = c("Amazon Prime Video", "Amazon Prime Video", 
"Amazon Prime Video", "Amazon Prime Video", "Amazon Prime Video", 
"Amazon Prime Video", "Amazon Prime Video", "Amazon Prime Video", 
"The Walt Disney Company", "The Walt Disney Company", "The Walt Disney Company", 
"The Walt Disney Company", "The Walt Disney Company"), Series = c("Mirzapur", 
"Mirzapur", "Mirzapur", "Mirzapur", "The Boys", "The Boys", "The Boys", 
"The Boys", "AndiMack", "AndiMack", "Lizzie McGuire", "Lizzie McGuire", 
"Lizzie McGuire"), Episode = c("Ep 1", "Ep 2", "Ep 3", "Ep 4", 
"Ep 1", "Ep 2", "Ep 3", "Ep 4", "Ep 1", "Ep 2", "Ep 1", "Ep 2", 
"Ep 3")), class = "data.frame", row.names = c("1", "2", "3", 
"4", "5", "6", "7", "8", "9", "10", "11", "12", "13"))

My code:

library(tidyr)
library(shiny)
library(dplyr)
row_ui <- function(id) {
  ns <- NS(id)
  fluidRow(
    column(2, textInput(ns("SelectionID"), label = "Enter the name of your selection:")),
    column(2, uiOutput(ns("FilmProducer"))),
    column(2, uiOutput(ns("Series"))),
    column(2, uiOutput(ns("Episode")))
  )
}


setwd("~")
getwd()
FilmOption <- read.csv("~SampleforStackOverflow.csv", header=T, encoding = "UTF-8")
FilmOption <- rename(FilmOption,"FilmProducer" = "X.U.FEFF.FilmProducer")

row_server <- function(input, output, session) {
  output$FilmProducer <- renderUI({
    ns <- session$ns
    type <- req(input$SelectionID)
    if(!is.null(type)) {
      selectInput(ns("FilmProducer"),"Choose the Film Producer:",choices = c("Amazon Prime Video","The Walt Disney Company"), selected = NULL) 
    } 
  })
  
  output$Series <- renderUI({
    ns <- session$ns
    type <- req(input$SelectionID)
    if(!is.null(type)) {
      selectInput(ns("Series"),"Choose the Series name:",choices = NULL, multiple = TRUE, selected = NULL)
    }
  }
  )
  
  observeEvent(input$FilmProducer, {
    ProducerList <- FilmOption %>% 
      filter(FilmProducer == input$FilmProducer) %>% 
      select(Series) %>% distinct() %>% arrange(Series)
    ProducerList <- rbind(ProducerList,"")
    ProducerList[2:nrow(ProducerList),] <- ProducerList[1:(nrow(ProducerList)-1),]
    ProducerList[1,] <- "Select All"
    if (nrow(ProducerList) == 1) {
      updateSelectInput(session, "Series","Choose the Series name:",
                        choices = as.character(ProducerList))
    }
    else {updateSelectInput(session, "Series","Choose the Series name:",
                            choices = ProducerList)}
  })      
  
  observeEvent(input$Series,{
    if("Select All" %in% input$Series) {
      ProducerList <- FilmOption %>%
        filter(FilmProducer == input$FilmProducer) %>% 
        select(Series) %>% distinct() %>% arrange(Series)
      ProducerList <- rbind(ProducerList,"")
      ProducerList[2:nrow(ProducerList),] <- ProducerList[1:(nrow(ProducerList)-1),]
      ProducerList[1,] <- "Select All"
      selected_choices= ProducerList[-1,]}
    else
      selected_choices=input$Series
    updateSelectInput(session, "Series", "Choose the Series name:", selected = selected_choices)
  })
  
  output$Episode <- renderUI({
    ns <- session$ns
    type <- req(input$SelectionID)
    if(!is.null(type)) {
      selectInput(ns("Episode"),"Choose the Episode:",choices = NULL, multiple = TRUE, selected = NULL)
    } 
  })
  
  observeEvent(input$Series, {
    SeriesList <- FilmOption %>% 
      filter(FilmProducer == input$FilmProducer) %>% 
      filter(Series == input$Series) %>% 
      select(Episode) %>% distinct() %>% arrange(Episode)
    SeriesList <- rbind(SeriesList,"")
    SeriesList[2:nrow(SeriesList),] <- SeriesList[1:(nrow(SeriesList)-1),]
    SeriesList[1,] <- "Select All"
    if (nrow(SeriesList) == 1) {
      updateSelectInput(session, "Episode","Choose the Episode:",
                        choices = as.character(SeriesList))
    }
    else {updateSelectInput(session, "Episode","Choose the Episode:",
                            choices = SeriesList)}
  })
  
  observeEvent(input$Episode, {
    SeriesList <- FilmOption %>% 
      filter(FilmProducer == input$FilmProducer) %>% 
      filter(Series == input$Series) %>% 
      select(Episode) %>% distinct() %>% arrange(Episode)
    SeriesList <- rbind(SeriesList,"")
    SeriesList[2:nrow(SeriesList),] <- SeriesList[1:(nrow(SeriesList)-1),]
    SeriesList[1,] <- "Select All"
    if("Select All" %in% input$Episode) {
      selected_choices= SeriesList[-1,]}
    else
      selected_choices=input$Episode
    updateSelectInput(session, "Episode", "Choose the Episode:", selected = selected_choices)
  })
  

  return(c(reactive({input$FilmProducer}), 
           reactive({input$Series}),
           reactive({input$Episode})
  ))
}


ui <- fluidPage(  
  div(id="placeholder"),
  actionButton("submit", "Add Selection:"),
  verbatimTextOutput("out")
)

server <- function(input, output, session) {
  handler <- reactiveVal(list())
  observeEvent(input$submit, {
    new_id <- paste("row", input$submit, sep = "_")
    insertUI(
      selector = "#placeholder",
      where = "beforeBegin",
      ui = row_ui(new_id)
    )
    handler_list <- isolate(handler())
    new_handler <- callModule(row_server, new_id)
    handler_list <- c(handler_list, new_handler)
    names(handler_list)[length(handler_list)] <- new_id
    handler(handler_list)
  })
  
  output$out <- renderPrint({
    lapply(handler(), function(handle) {
      handle()
    })
  })
}

shinyApp(ui, server)
3 
library(tidyverse)
library(shiny)

row_ui <- function(id) {
  ns <- NS(id)
  fluidRow(
    column(2, textInput(ns("SelectionID"), label = "Enter the name of your selection:")),
    column(2, uiOutput(ns("FilmProducer"))),
    column(2, uiOutput(ns("Series"))),
    column(2, uiOutput(ns("Episode")))
  )
}


# FilmOption <- read.csv("~SampleforStackOverflow.csv", header=T, encoding = "UTF-8")
# FilmOption <- rename(FilmOption,"FilmProducer" = "X.U.FEFF.FilmProducer")
FilmOption <- structure(list(FilmProducer = c(
  "Amazon Prime Video", "Amazon Prime Video",
  "Amazon Prime Video", "Amazon Prime Video", "Amazon Prime Video",
  "Amazon Prime Video", "Amazon Prime Video", "Amazon Prime Video",
  "The Walt Disney Company", "The Walt Disney Company", "The Walt Disney Company",
  "The Walt Disney Company", "The Walt Disney Company"
), Series = c(
  "Mirzapur",
  "Mirzapur", "Mirzapur", "Mirzapur", "The Boys", "The Boys", "The Boys",
  "The Boys", "AndiMack", "AndiMack", "Lizzie McGuire", "Lizzie McGuire",
  "Lizzie McGuire"
), Episode = c(
  "Ep 1", "Ep 2", "Ep 3", "Ep 4",
  "Ep 1", "Ep 2", "Ep 3", "Ep 4", "Ep 1", "Ep 2", "Ep 1", "Ep 2",
  "Ep 3"
)), class = "data.frame", row.names = c(
  "1", "2", "3",
  "4", "5", "6", "7", "8", "9", "10", "11", "12", "13"
))
row_server <- function(input, output, session) {
  output$FilmProducer <- renderUI({
    ns <- session$ns
    type <- req(input$SelectionID)
    if (!is.null(type)) {
      selectInput(ns("FilmProducer"), "Choose the Film Producer:", choices = c("Amazon Prime Video", "The Walt Disney Company"), selected = NULL)
    }
  })

  output$Series <- renderUI({
    ns <- session$ns
    type <- req(input$SelectionID)
    if (!is.null(type)) {
      selectInput(ns("Series"), "Choose the Series name:", choices = NULL, multiple = TRUE, selected = NULL)
    }
  })

  observeEvent(input$FilmProducer, {
    ProducerList <- FilmOption %>%
      filter(FilmProducer == input$FilmProducer) %>%
      select(Series) %>%
      distinct() %>%
      arrange(Series)
    ProducerList <- rbind(ProducerList, "")
    ProducerList[2:nrow(ProducerList), ] <- ProducerList[1:(nrow(ProducerList) - 1), ]
    ProducerList[1, ] <- "Select All"
    if (nrow(ProducerList) == 1) {
      updateSelectInput(session, "Series", "Choose the Series name:",
        choices = as.character(ProducerList)
      )
    }
    else {
      updateSelectInput(session, "Series", "Choose the Series name:",
        choices = ProducerList
      )
    }
  })

  observeEvent(input$Series, {
    if ("Select All" %in% input$Series) {
      ProducerList <- FilmOption %>%
        filter(FilmProducer == input$FilmProducer) %>%
        select(Series) %>%
        distinct() %>%
        arrange(Series)
      ProducerList <- rbind(ProducerList, "")
      ProducerList[2:nrow(ProducerList), ] <- ProducerList[1:(nrow(ProducerList) - 1), ]
      ProducerList[1, ] <- "Select All"
      selected_choices <- ProducerList[-1, ]
    }
    else {
      selected_choices <- input$Series
    }
    updateSelectInput(session, "Series", "Choose the Series name:", selected = selected_choices)
  })

  output$Episode <- renderUI({
    ns <- session$ns
    type <- req(input$SelectionID)
    if (!is.null(type)) {
      selectInput(ns("Episode"), "Choose the Episode:", choices = NULL, multiple = TRUE, selected = NULL)
    }
  })

  observeEvent(input$Series, {
    SeriesList <- FilmOption %>%
      filter(FilmProducer == input$FilmProducer) %>%
      filter(Series == input$Series) %>%
      select(Episode) %>%
      distinct() %>%
      arrange(Episode)
    SeriesList <- rbind(SeriesList, "")
    SeriesList[2:nrow(SeriesList), ] <- SeriesList[1:(nrow(SeriesList) - 1), ]
    SeriesList[1, ] <- "Select All"
    if (nrow(SeriesList) == 1) {
      updateSelectInput(session, "Episode", "Choose the Episode:",
        choices = as.character(SeriesList)
      )
    }
    else {
      updateSelectInput(session, "Episode", "Choose the Episode:",
        choices = SeriesList
      )
    }
  })

  observeEvent(input$Episode, {
    SeriesList <- FilmOption %>%
      filter(FilmProducer == input$FilmProducer) %>%
      filter(Series == input$Series) %>%
      select(Episode) %>%
      distinct() %>%
      arrange(Episode)
    SeriesList <- rbind(SeriesList, "")
    SeriesList[2:nrow(SeriesList), ] <- SeriesList[1:(nrow(SeriesList) - 1), ]
    SeriesList[1, ] <- "Select All"
    if ("Select All" %in% input$Episode) {
      selected_choices <- SeriesList[-1, ]
    }
    else {
      selected_choices <- input$Episode
    }
    updateSelectInput(session, "Episode", "Choose the Episode:", selected = selected_choices)
  })



  return(reactive({
    list(
      selid = input$SelectionID,
      fp = input$FilmProducer,
      s = input$Series,
      e = input$Episode
    )
  }))
}


ui <- fluidPage(
  div(id = "placeholder"),
  actionButton("submit", "Add Selection:"),
  verbatimTextOutput("out"),
  tableOutput("out2")
)

server <- function(input, output, session) {
  handler <- reactiveVal(list())
  observeEvent(input$submit, {
    new_id <- paste("row", input$submit, sep = "_")
    insertUI(
      selector = "#placeholder",
      where = "beforeBegin",
      ui = row_ui(new_id)
    )
    handler_list <- isolate(handler())
    new_handler <- callModule(row_server, new_id)
    handler_list <- c(handler_list, new_handler)
    names(handler_list)[length(handler_list)] <- new_id
    handler(handler_list)
  })

  output$out <- renderPrint({
    lapply(handler(), function(handle) {
      handle()
    })
  })

  pre_process_candidate <- function(x) {
    is_good <- map_lgl(
      x(),
      isTruthy
    )
    if (!all(is_good)) {
      return(NA)
    }
    x()
  }

  use_as_filter <- function(x) {
    if (!isTruthy(x)) {
      return(NA)
    }
    first_sel <- FilmOption %>% filter(
      FilmProducer == x$fp,
      Series %in% x$s
    )
    second_sel <- first_sel
    if (!isTruthy(x$e)) {
      second_sel <- filter(first_sel, FALSE)
    } else if (!"Select All" %in% x$e) {
      second_sel <- first_sel %>% filter(Episode %in% x$e)
    }
    second_sel %>%
      mutate(`My Selection` = x$selid) %>%
      relocate(
        `My Selection`
      )
  }

  output$out2 <- renderTable({
    h <- handler()
    complete_ones <- map(
      h,
      pre_process_candidate
    )
    complete_ones <- complete_ones[!is.na(complete_ones)]
    filtered <- map(
      complete_ones,
      use_as_filter
    )

    to_show <- filtered %>% bind_rows()

    validate(need(nrow(to_show) > 0,
      message = "no selection present"
    ))

    return(to_show)
  })
}

shinyApp(ui, server)
4

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.