termco icon indicating copy to clipboard operation
termco copied to clipboard

Consider adding tags2list and list2tags functions

Open trinker opened this issue 5 years ago • 1 comments

## convert names columns with one hot encoding to list of column names
tags2list <- function(data, ...){

    data %>%
        select(...) %>%
        {Map(function(x, y){
            ifelse(x > 0, y, NA)
        }, ., names(.))} %>%
        unlist(use.names = FALSE)

}


list2tags <- function(data, ncol = length(unique(na.omit(unlist(data))))){
# browser()
    lapply(data, function(x){
            x %>%
                matrix(ncol = ncol) %>%
                as.data.frame()
        }) %>%
        bind_rows() %>%
        {Map(function(x){

            setNames(tibble(x = ifelse(is.na(x), 0L, 1L)), unique(na.omit(x)) )

        }, .)} %>%
        bind_cols()

}

trinker avatar Aug 14 '20 17:08 trinker

## convert names columns with one hot encoding to list of column names
tags2list <- function(data, ...){

    `%>%` <- dplyr::`%>%`

    if (length(list(...)) > 0  && !is.null(...)) {

        m <- data %>%
            dplyr::select(...) 

    } else {

        m <- data 

    }

    m %>%
        {Map(function(x, y){
            ifelse(x > 0, y, NA)
        }, ., names(.))} 

#%>%
#        unlist(use.names = FALSE)

}


list2tags <- function(data, ncol = length(unique(na.omit(unlist(data))))){

    `%>%` <- dplyr::`%>%`

    lapply(data, function(x){
            x %>%
                matrix(ncol = ncol) %>%
                as.data.frame()
        }) %>%
        dplyr::bind_rows() %>%
        {Map(function(x){

            stats::setNames(tibble(x = ifelse(is.na(x), 0L, 1L)), unique(na.omit(x)) )

        }, .)} %>%
        dplyr::bind_cols()

}


library(dplyr)
data.frame(matrix(sample(0:1, 100, T), ncol = 10)) %>%
    tags2list()


trinker avatar Aug 25 '20 17:08 trinker