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){
#'
#' @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)){
DF = fd_melt_SINGLE(x, key1, id)
......@@ -70,6 +70,45 @@ fd_melt <- function(x, key1, key2 = NULL, id = NULL, keep = NULL){
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
#'
#' @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