R/lopo_editable_fields.R

In kismet303/lopo3000: LoPo 3000 Experimental package using RShiny for interactive LoPo

lopo_editable_fields <- function(typeName, lopo_row, edit.cols=NULL) {
  
  stopifnot(is.data.frame(lopo_row))
  stopifnot(nrow(lopo_row) == 1)
  
  
  if (!is.null(edit.cols)) {
    lopo_row <- lopo_row[edit.cols]
  }
  
  if (is.null(edit.cols)) edit.cols <- names(lopo_row)
  edit.label.cols = edit.cols
  
  inputTypes <- sapply(lopo_row, FUN = function(x) {
    switch(class(x),
           list = 'selectInputMultiple',
           character = 'textInput',
           Date = 'dateInput',
           factor = 'selectInput',
           integer = 'numericInput',
           numeric = 'numericInput')
  })
  
  if("Footnotes" %in% names(inputTypes)) inputTypes$Footnotes = 'textAreaInput'
  if("Titles" %in% names(inputTypes))  inputTypes$Footnotes = 'textAreaInput'
  
  # # Convert any list columns to characters before displaying
  # for(i in 1:ncol(result$thedata)) {
  #   if(nrow(result$thedata) == 0) {
  #     result$thedata[,i] <- character()
  #   } else if(is.list(result$thedata[,i])) {
  #     result$thedata[,i] <- sapply(result$thedata[,i], FUN = function(x) { paste0(x, collapse = ', ') })
  #   }
  # }
  
  fields <- list(length(names(lopo_row)))
  for(i in seq_along(edit.cols)) {
    if(inputTypes[i] == 'dateInput') {
      value <- ifelse(missing(lopo_row),
                      as.character(Sys.Date()),
                      as.character(lopo_row[ ,edit.cols[i]]))
      fields[[i]] <- dateInput(paste0("myLopo", typeName, edit.cols[i]),
                               label = edit.label.cols[i],
                               value = value,
                               width = date.width)
    } else if(inputTypes[i] == 'selectInputMultiple') {
      value <- ifelse(missing(lopo_row), '',  lopo_row[ , edit.cols[i]])
      if(is.list(value)) {
        value <- value[[1]]
      }
      choices <- ''
      if(!missing( lopo_row)) {
        choices <- unique(unlist(lopo_row[ ,edit.cols[i]]))
      }
      if(!is.null(input.choices)) {
        if(edit.cols[i] %in% names(input.choices)) {
          choices <- input.choices[[edit.cols[i]]]
        }
      }
      if(length(choices) == 1 & choices == '') {
        warning(paste0('No choices available for ', edit.cols[i],
                       '. Specify them using the input.choices parameter'))
      }
      fields[[i]] <- selectInputMultiple(paste0("myLopo", typeName, edit.cols[i]),
                                         label = edit.label.cols[i],
                                         choices = choices,
                                         selected = value,
                                         width = select.width)
      
    } else if(inputTypes[i] == 'selectInput') {
      value <- ifelse(missing(lopo_row), '', as.character(lopo_row[,edit.cols[i]]))
      fields[[i]] <- shiny::selectInput(paste0("myLopo", typeName, edit.cols[i]),
                                        label = edit.label.cols[i],
                                        choices = levels(result$thedata[,edit.cols[i]]),
                                        selected = value,
                                        width = select.width)
    } else if(inputTypes[i] == 'numericInput') {
      value <- ifelse(missing(lopo_row), 0,  lopo_row[,edit.cols[i]])
      fields[[i]] <- shiny::numericInput(paste0("myLopo", typeName, edit.cols[i]),
                                         label = edit.label.cols[i],
                                         value = value,
                                         width = numeric.width)
    } else if(inputTypes[i] == 'textAreaInput') {
      value <- ifelse(missing(lopo_row), '',  lopo_row[,edit.cols[i]])
      fields[[i]] <- shiny::textAreaInput(paste0("myLopo", typeName, edit.cols[i]),
                                          label = edit.label.cols[i],
                                          value = value,
                                          width = textarea.width, 
                                          height = textarea.height)
    } else if(inputTypes[i] == 'textInput') {
      value <- ifelse(missing(lopo_row), '',  lopo_row[,edit.cols[i]])
      fields[[i]] <- shiny::textInput(paste0("myLopo", typeName, edit.cols[i]),
                                      label = edit.label.cols[i],
                                      value = value,
                                      width = text.width)
    } else if(inputTypes[i] == 'passwordInput') {
      value <- ifelse(missing(lopo_row), '',  lopo_row[,edit.cols[i]])
      fields[[i]] <- shiny::passwordInput(paste0("myLopo", typeName, edit.cols[i]),
                                          label = edit.label.cols[i],
                                          value = value,
                                          width = text.width)
    } else {
      stop('Invalid input type!')
    }
  }
  return(fields)
}

# testing
# s_path <- "inst/example_lopo/BP40657.sqlite"
# myLopo <- getLopo("BP40657", s_path)
# col_list <- c('See', 'Action' , 'Domain', 'Titles', 'Footnotes', 'Filters', 'GDS Template', 'Program ID','outType','idbis')
# 
# lopo_editable_fields("edit", myLopo[1,], edit.cols= col_list)