Commit e299ab62 authored by Virgile Baudrot's avatar Virgile Baudrot
Browse files

update melt function key is LIST

parent d708a6e6
...@@ -53,7 +53,7 @@ fd_melt_SINGLE <- function(x, key1, id = NULL){ ...@@ -53,7 +53,7 @@ fd_melt_SINGLE <- function(x, key1, id = NULL){
#' #'
#' @export #' @export
#' #'
fd_melt <- function(x, key1, key2 = NULL, id = NULL, keep = NULL){ fd_melt_12 <- function(x, key1, key2 = NULL, id = NULL, keep = NULL){
if(is.null(key2)){ if(is.null(key2)){
DF = fd_melt_SINGLE(x, key1, id) DF = fd_melt_SINGLE(x, key1, id)
...@@ -70,6 +70,45 @@ fd_melt <- function(x, key1, key2 = NULL, id = NULL, keep = NULL){ ...@@ -70,6 +70,45 @@ fd_melt <- function(x, key1, key2 = NULL, id = NULL, keep = NULL){
return(DF) return(DF)
} }
#' @name fd_melt
#'
#' @param key a list or vector of column name to keep
#'
#' @export
#'
fd_melt <- function(x, key, id = NULL, keep = NULL){
lgth_key = lapply(1:length(key),
function(i){
sapply(x[[key[[i]]]], length)
})
if(length(lgth_key)>1){
if(!all(
sapply(2:length(lgth_key),
function(i) lgth_key[[1]] == lgth_key[[i]])
)) { stop("length of element within 'key' differ.")}
}
if(is.null(id)) {
id = 1:length(lgth_key[[1]])
} else{
id = x[[id]]
}
DF = data.frame(
id = do.call("c", lapply(1:length(id), function(i) rep(id[i], lgth_key[[1]][[i]])))
)
for(i in 1:length(key)){
DF[[key[[i]]]] = do.call("c", x[[key[[i]]]])
}
# --- keep
if(!is.null(keep)) {
for(i in 1:length(keep)){
DF[[keep[[i]]]] = fd_melt_STICK(x, key[[1]], keep[[i]])
}
}
return(DF)
}
#' @name fd_melt #' @name fd_melt
#' #'
#' @export #' @export
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment