Comment puis-je étendre tidyr :: spread() tout en maintenant l'ordre des noms de colonnes?

Question

Comment se développer lorsqu'on maintient le rang des nombres lorsqu'on utilise la fonction de propagation?

library(tidyverse) 

data.frame(time = paste0("t_", 1:100)) %>% 
    rowwise() %>% 
    mutate(rnd = sample(1:100, size=1)) %>% 
    spread(time, rnd) 

Les noms de colonnes du résultat de l'exécution du code ci-dessus sont t_1, t_11, t_100, ..... Je veux obtenir les noms des colonnes dans l'ordre des nombres (t_1, t_2, t_3, ...).

Answer 1

Vous pouvez essayer deux choses:

(1) Marque "temps" un facteur avec des niveaux correspondant à l'ordre que vous voulez:

data.frame(time = factor(paste0("t_", 1:100), levels = paste0("t_", 1:100))) %>% 
    rowwise() %>% 
    mutate(rnd = sample(1:100, size=1)) %>% 
    spread(time, rnd) 

(2) Force l'ordre à l'aide d'une instruction select:

data.frame(time = paste0("t_", 1:100)) %>% 
    rowwise() %>% 
    mutate(rnd = sample(1:100, size=1)) %>% 
    spread(time, rnd) %>% 
    select(paste0("t_", 1:100)) 

Answer 2

Voici une nouvelle fonction qui conserve l'ordre des colonnes. Une seule petite modification est nécessaire (voir annotation):

my_spread <- function (data, key, value, fill = NA, convert = FALSE, drop = TRUE, 
      sep = NULL) { 
    key_col <- tidyr:::col_name(substitute(key)) 
    value_col <- tidyr:::col_name(substitute(value)) 
    tbl_df(my_spread_(data, key_col, value_col, fill = fill, convert = convert, 
        drop = drop, sep = sep)) 
} 

my_spread_ <- function (data, key_col, value_col, fill = NA, convert = FALSE, 
         drop = TRUE, sep = NULL) { 
    col <- data[key_col] 
    #col_id <- tidyr:::id(col, drop = drop)         # Old line 
    col_id <- seq_len(nrow(data))            # New line 1 
    attr(col_id, 'n') <- nrow(data)           # New line 2 
    col_labels <- tidyr:::split_labels(col, col_id, drop = drop) 
    rows <- data[setdiff(names(data), c(key_col, value_col))] 
    if (length(rows) == 0) { 
    row_id <- structure(1L, n = 1L) 
    row_labels <- as.data.frame(matrix(nrow = 1, ncol = 0)) 
    } 
    else { 
    row_id <- id(rows, drop = drop) 
    row_labels <- tidyr:::split_labels(rows, row_id, drop = drop) 
    rownames(row_labels) <- NULL 
    } 
    overall <- tidyr:::id(list(col_id, row_id), drop = FALSE) 
    n <- attr(overall, "n") 
    if (anyDuplicated(overall)) { 
    groups <- split(seq_along(overall), overall) 
    groups <- groups[vapply(groups, length, integer(1)) > 
         1] 
    str <- vapply(
     groups, 
     function(x) paste0("(", paste0(x, collapse = ", "), ")"), character(1) 
    ) 
    stop("Duplicate identifiers for rows ", paste(str, collapse = ", "), 
     call. = FALSE) 
    } 
    if (length(overall) < n) { 
    overall <- match(seq_len(n), overall, nomatch = NA) 
    } 
    else { 
    overall <- order(overall) 
    } 
    value <- data[[value_col]] 
    ordered <- value[overall] 
    if (!is.na(fill)) { 
    ordered[is.na(ordered)] <- fill 
    } 
    if (convert && !is.character(ordered)) { 
    ordered <- as.character(ordered) 
    } 
    dim(ordered) <- c(attr(row_id, "n"), attr(col_id, "n")) 
    colnames(ordered) <- enc2utf8(tidyr:::col_names(col_labels, sep = sep)) 
    ordered <- tidyr:::as_data_frame_matrix(ordered) 
    if (convert) { 
    ordered[] <- lapply(ordered, type.convert, as.is = TRUE) 
    } 
    tidyr:::append_df(row_labels, ordered) 
}