R/paramsfunc.R

Defines functions paramsfunc

paramsfunc <- function(params) {

require(snakecase)
require(tidyverse)
require(neugelbtools)

  if (is_empty(params$type)==FALSE) {

    if (params$type %in% c('template','boolean')) {

      return_val <- tibble(newval = params$value) %>%
        mutate(newval = ifelse(newval %in% c('true','false'),rboolean(newval),newval))

        colname <- str_to_lower(to_snake_case(params$key,sep_out = "_"))

        colnames(return_val) <- colname
        
    } else if (params$type == 'list' & !params$key == 'fieldsToSet') {

      colval <- params$key

      return_val <- tibble()

      for (i in 1:length(params$list)) {

        new_vals <- tibble(parameter_type = colval,
                          parameter_index = params$list[[i]]$map[[1]]$value,
                          parameter_input = params$list[[i]]$map[[2]]$value)

        return_val <- bind_rows(return_val,new_vals)

      }

      return_val <- return_val %>%
        tidycols()

    } else if (params$key == 'fieldsToSet') {

      return_val <- tibble()

      for (i in 1:length(params$list)) {

        new_vals <- tibble(newkey = params$list[[i]]$map[[1]]$value,
                           newval = params$list[[i]]$map[[2]]$value)

        return_val <- bind_rows(return_val,new_vals)

      }

      newcols <- c(params$key,'input')

      colnames(return_val) <- newcols

      return_val <- return_val %>%
        tidycols()

    } else {

      print(params$type)
      stop('Need a new method for this one')

    }

  } else if (is_empty(params[[1]]$type) == FALSE & params[[1]]$type == 'list' | params$key == 'fieldsToSet') {

    return_val <- tibble()

    for (i in 1:length(params[[1]]$list)) {

      new_vals <- tibble(newkey = params[[1]]$list[[i]]$map[[1]]$value,
                        newval = params[[1]]$list[[i]]$map[[2]]$value)

      return_val <- bind_rows(return_val,new_vals)

    }

    newcols <- c(params[[1]]$key,'set_value')

    colnames(return_val) <- newcols

    return_val <- return_val %>%
      tidycols()

  } else {

    stop('We are working on this one')

  }

return(return_val)

}
neugelb/gtmr documentation built on June 25, 2020, 10:06 a.m.