R/clean_requests.R

In Ingenuity-Inc/artlookR: Work with artlook data

#' artlookR reqeusts data cleaning
#'
#' The \code{requests} table in artlookR stores information about resources (i.e., \code{resourceable_type}s) that have been
#' requested by schools. It's parallel to the \code{get_allocations} function but in this case since requests can only be made by schools, there is no 
#' parallel to the \code{allocateable_type} that is used in that function. There are also fewer \code{resourceable_type}s available than is the case in that
#' other function. 
#' @usage clean_requests(
#'
#'     comm_name = NULL
#'
#'     type_of_resource = c("Discipline","ProgramType","ResourceType","SubDiscipline")
#'
#'     table_of_resource = c("disciplines","program_types","resource_types","sub_disciplines")
#'
#' )
#' @param comm_name The community name as recognized by artlookR
#' @param type_of_resource The \code{resourceable_type} to filter the requests table by. In other words, what type of resource is being provided to
#' the identified \code{school_org_prog_part}?
#' @param table_of_resource The meta-data table to which the \code{resourceable_type} must be connected to make sense of it. In other words, the
#' table_of_resource *must* correspond to the type_of_resource or the description of the \code{resourceable_type} will be wrong.
#'
#' The contents of these meta-data tables can be separately checked with a call to an artlookR meta-data function that starts with *meta_()*
#' (e.g., \code{meta_approaches}). Whether they are stored in the public schema or in community-specific schema impacts the call to the meta-data
#' function, but not the call to the table itself in this \code{get_requests} function.
#'   * **Public schema:** table_of_resource <-> type_of_resource (\code{meta-data function}):
#'     * disciplines <-> Discipline (\code{meta_disc(...)}) - NOTE this is only available in Chicago's schema because it became obsolete before launching
#'     in other communities. 
#'     * program_types <-> ProgramType (\code{meta_prog(...)})
#'     * sub_disciplines <-> SubDiscipline (\code{meta_subdisc(...)})
#'   * **Community schema:** table_of_resource <-> type_of_resource (\code{meta-data function}):
#'     * resource_types <-> ResourceType (\code{meta_resource(comm_name)})
#' @return A tibble / data frame with "cleaned" data from the allocations table. By clean, we mean data that is more suitable for end-users.
#' The exact data included will vary from one table to the next.
#' @details * You will need to run the \code{connection.R} script and create a connection object named \code{myconn} for this script to run.
#' @examples
#' clean_requests("chicago", "ProgramType", "program_types")
#' clean_requests("houston", "SubDiscipline", "sub_disciplines")
#'
#' # does not work because LeadershipCharacteristics are not requestable by Schools
#' clean_requests("jacksonville", "LeadershipCharacteristics", "leadership_characteristics")
#' @export
clean_requests <- function(comm_name, type_of_resource, table_of_resource) {
  
  #### Get data for cleaning ####
  fact_years <- meta_years(comm_name)
  factors <- eval(parse(text = paste0("meta_", table_of_resource, "(\'", comm_name, "\')")))
  fact_level <- factors$level
  fact_label <- factors$label
  fact_id <- factors$id
  temp <- get_requests(comm_name, type_of_resource, table_of_resource) 
  
  #### Cases where no data exists ####
  if(nrow(temp) == 0) {
    
    return(NA)
    
  }
  
  #### Cases where yes data exists ####
  if(nrow(temp) > 0) {
    
    rel_years <- unique(temp$school_year_id)
    
    #### Cases with tag ####
    if(sum(!is.na(temp$tag)) > 0){
      
      tag_values <- meta_allocation_tags(comm_name)
      
        others <- temp %>% 
          filter(!is.na(other_text)) %>% 
          select(school_id,
                 school_year_id,
                 other_text)
        
        output <- temp %>% 
          mutate(name = factor(name, levels = fact_level, labels = fact_label, ordered = TRUE),
                 tag = factor(tag, levels = tag_values$level, labels = tag_values$label, ordered = TRUE)) %>% 
          group_by(school_year_id, school_id, name) %>% 
          summarise(val = paste0(tag, collapse = ", ")) %>% 
          pivot_wider(id_cols = c(school_year_id, school_id),
                      names_from = name,
                      values_from = val) %>% 
          left_join(others,
                    by = c("school_year_id", "school_id")) %>% 
          mutate(other_text = trimws(other_text),
                 other_text = gsub("\\s+"," ", other_text)) %>% 
          mutate(school_year = factor(school_year_id, levels = fact_years$level, labels = fact_years$label, ordered = TRUE))
        
        if(all(is.na(output$other_text))) {
          
          output <- output %>% 
            select(-other_text)
          
        }
        
    }
    
    #### Cases with no tag ####
    if(sum(!is.na(temp$tag)) == 0){
      
        others <- temp %>% 
          filter(!is.na(other_text)) %>% 
          select(school_id,
                 school_year_id,
                 other_text)
        
        output <- temp %>% 
          mutate(name = factor(name, levels = fact_level, labels = fact_label, ordered = TRUE),
                 val = 1) %>% 
          pivot_wider(id_cols = c(school_year_id, school_id),
                      names_from = name,
                      values_from = val) %>% 
          left_join(others,
                    by = c("school_year_id", "school_id")) %>% 
          mutate(other_text = trimws(other_text),
                 other_text = gsub("\\s+"," ", other_text)) %>% 
          mutate(school_year = factor(school_year_id, levels = fact_years$level, labels = fact_years$label, ordered = TRUE)) 
        
        if(all(is.na(output$other_text))) {
          
          output <- output %>% 
            select(-other_text)
          
        }
        
    }
    
  }
  
  output <- fun_schools_list(comm_name) %>%
    filter(is_archived == "approved") %>% 
    select(-is_archived) %>% 
    rename(school_id = "school_id") %>% 
    inner_join(output,
               by = c("school_year_id", "school_id")) %>% 
    filter(school_year_id %in% rel_years) %>%
    select(any_of(c("school_year",
                    "school_name",
                    "category",
                    "district")),
           everything()) %>% 
    relocate(ends_with("_id"), .after = last_col()) %>% 
    arrange(desc(school_year_id))
  
  output
  
}