moin: Modelling Interactions

#' @title parse all types
#' 
#' Function which returns a data frame containing type of each feature. 
#' 
#' @param type_tibble a tibble with type information (eg. exampledata R1234)
#' @param index_col index for column to use
#' 
#' @return returns a data frame containg all features
#' @author Juliane Watson <\email{juliane.bonness@@web.de}>

parse_all_types <- function(type_tibble, index_col){
    typelist <- type_tibble[, index_col]
    typelist <- as.list(typelist)
    typelist <- unlist(typelist)
    return(typelist)
}


#' @title mtypes
#' 
#' Separating hierarchical type names, so upper levels will be returned. 
#'   R123 will be returned as R1, R12, R123.
#' 
#' @param type one type from list e.g. R12345
#' @param pre_size amount of letters e.g. charactes before typenumber
#' 
#' @return returns upper level of type hierarchy as list
#' 
#' @author Oliver Nakoinz <oliver.nakoinz@ufg.uni-kiel.de>

mtypes <- function(type, pre_size) {
    type <- as.character(type)
    type_length <- nchar(type)
    parts <- type_length - pre_size
    metatypes <- 1:parts
    for (i in 1:parts){
        metatypes[i] <- substr(type, 1, pre_size + i)
    }
    return(metatypes)
}


#' @title find missing types
#' 
#' Sanity check if each upper level of hierarchical types is represented once in `typelist`.
#' 
#' @param type_list a list with type information (eg. exampledata R1234)
#' @param pre_size amount of letters e.g. charactes before typenumber
#' 
#' @return returns list of types
#' 
#' @author Juliane Watson <\email{juliane.bonness@@web.de}>


find_missing_types <- function(type_list, pre_size){
    type_list <- type_list[!is.na(type_list)]
    typelistlist <- lapply(type_list, mtypes, pre_size = pre_size)
    typelist <- unlist(typelistlist)
    typelist <- sort(typelist)
    typelist <- unique(typelist)
    return(typelist)
}


#' @title create type generator
#' 
#' @param type_tibble a tibble with type information (eg. exampledata R1234)
#' @param type_col string for column with type information 
#' @param pre_size amount of letters e.g. charactes before typenumber
#' 
#' @examples 
#' 
#' features <- data.frame(x = sample(3433806:3581396, 100, replace = TRUE),
#'                    y = sample(5286004:5484972, 100, replace = TRUE),
#'                    type = paste0("B", c(rep(1, 5), rep(2,15), sample(11:19, 20, replace = TRUE), 
#'                    sample(111:119, 30, replace = TRUE), sample(1111:1115, 30, replace = TRUE)))
#'                    )
#'                    
#' create_type_generator(features, "type", 1)
#'  
#' @author Juliane Watson <\email{juliane.bonness@@web.de}>
#' 
#' @export


create_type_generator <- function(type_tibble, type_col, pre_size){
    index_col <- which(colnames(type_tibble) == type_col)
    list_of_types <- parse_all_types(type_tibble, index_col)
    complete_types <- find_missing_types(list_of_types, pre_size)
    return(complete_types)
}