#' @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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.