Kirill Müller пре 7 година
родитељ
комит
b1e8cab2c6
No account linked to committer's email address
8 измењених фајлова са 166 додато и 165 уклоњено
  1. +1
    -1
      R/00_base_tidyr.R
  2. +4
    -3
      R/02_functions.R
  3. +7
    -7
      R/tidyr_spread_gather.R
  4. BIN
      images/static/png/tidyr-gather.png
  5. BIN
      images/static/png/tidyr-spread.png
  6. +83
    -83
      images/static/svg/tidyr-gather.svg
  7. +71
    -71
      images/static/svg/tidyr-spread.svg
  8. BIN
      images/tidyr-spread-gather.gif

+ 1
- 1
R/00_base_tidyr.R Прегледај датотеку

z = letters[5:6] z = letters[5:6]
) )


long <- tidyr::gather(wide, key, val, x:z)
long <- tidyr::gather(wide, key, val, -id)

+ 4
- 3
R/02_functions.R Прегледај датотеку

color = colors[idc], color = colors[idc],
) %>% ) %>%
filter(!is.na(color)) %>% filter(!is.na(color)) %>%
mutate(alpha = ifelse(label != "id" & .y < 0, 0.6, 1.0)) %>%
mutate(alpha = ifelse(.y < 0, 1.0, 0.2)) %>%
mutate(.text_color = ifelse(.y < 0, "white", "black")) %>%
select(-idc) select(-idc)
} }


plot_data <- function(x, title = "") {
plot_data <- function(x, title = "", title_size = 20) {
if (!"alpha" %in% colnames(x)) x$alpha <- 1 if (!"alpha" %in% colnames(x)) x$alpha <- 1
if (!".text_color" %in% colnames(x)) x$`.text_color` <- "white" if (!".text_color" %in% colnames(x)) x$`.text_color` <- "white"
if (!".text_size" %in% colnames(x)) x$`.text_size` <- 12 if (!".text_size" %in% colnames(x)) x$`.text_size` <- 12
coord_equal() + coord_equal() +
ggtitle(title) + ggtitle(title) +
theme_void() + theme_void() +
theme(plot.title = element_text(family = "Fira Mono", hjust = 0.5, size = 24)) +
theme(plot.title = element_text(family = "Fira Mono", hjust = 0.5, size = title_size)) +
guides(fill = FALSE) guides(fill = FALSE)
} }



+ 7
- 7
R/tidyr_spread_gather.R Прегледај датотеку

sg_long <- wide %>% sg_long <- wide %>%
tidyr::gather("key", "val", -id) %>% tidyr::gather("key", "val", -id) %>%
proc_data("3-tall", color_fun = function(x, y) x) %>% proc_data("3-tall", color_fun = function(x, y) x) %>%
mutate(.text_color = if_else(label == "key", "black", "white")) %>%
split(.$label) split(.$label)


sg_long$id <- sg_long$id <-
select(label, color) %>% select(label, color) %>%
left_join(sg_long$key, ., by = c("value" = "label")) %>% left_join(sg_long$key, ., by = c("value" = "label")) %>%
distinct() %>% distinct() %>%
mutate(alpha = 1)
mutate(alpha = 0.6)


sg_long$val <- sg_long$val <-
sg_wide %>% sg_wide %>%
filter(label != "id", .y < 0) %>% filter(label != "id", .y < 0) %>%
select(value, color) %>% select(value, color) %>%
left_join(sg_long$val, ., by = "value") %>% left_join(sg_long$val, ., by = "value") %>%
mutate(alpha = 0.6)
mutate(alpha = 1)


sg_long <- bind_rows(sg_long) %>% mutate(frame = 2) sg_long <- bind_rows(sg_long) %>% mutate(frame = 2)


sg_long_labels <- data_frame(id = 1, a = "id", x = "key", y = "val") %>% sg_long_labels <- data_frame(id = 1, a = "id", x = "key", y = "val") %>%
proc_data("4-label") %>% proc_data("4-label") %>%
filter(label != "id") %>% filter(label != "id") %>%
mutate(color = "#FFFFFF", .y = 0, .x = .x -1, frame = 2, alpha = 1, label = recode(label, "a" = "id"))
mutate(color = "white", .text_color = "black", .y = 0, .x = .x -1, frame = 2, alpha = 1, label = recode(label, "a" = "id"))


sg_wide_labels <- data_frame(id = 1, a = "id") %>% sg_wide_labels <- data_frame(id = 1, a = "id") %>%
proc_data("2-label") %>% proc_data("2-label") %>%
filter(label != "id") %>% filter(label != "id") %>%
mutate(color = "#FFFFFF", .y = 0, .x = .x -1, frame = 1, alpha = 1, label = recode(label, "a" = "id"))
mutate(color = "white", .text_color = "black", .y = 0, .x = .x -1, frame = 1, alpha = 1, label = recode(label, "a" = "id"))


sg_long_extra_keys <- map_dfr( sg_long_extra_keys <- map_dfr(
seq_len(nrow(wide) - 1), seq_len(nrow(wide) - 1),
mutate( mutate(
label = ifelse(value %in% setdiff(colnames(wide), "id"), "key", label), label = ifelse(value %in% setdiff(colnames(wide), "id"), "key", label),
label = ifelse(value %in% c("key", "val"), "zzz", label), label = ifelse(value %in% c("key", "val"), "zzz", label),
.text_color = ifelse(grepl("label", .id), "black", "white"),
.text_size = ifelse(grepl("label", .id), 8, 12)
.text_size = ifelse(grepl("label", .id) | .y == 0, 8, 12)
) %>% ) %>%
arrange(label, .id, value) %>% arrange(label, .id, value) %>%
mutate(frame = factor(frame, labels = c('spread(long, key, val)', 'gather(wide, key, val, x:z)'))) %>%
mutate(frame = factor(frame, labels = c('spread(long, key, val)', 'gather(wide, key, val, -id)'))) %>%
select(.x, .y, everything()) select(.x, .y, everything())


sg_static <- sg_static <-

BIN
images/static/png/tidyr-gather.png Прегледај датотеку

Before After
Width: 3429  |  Height: 4658  |  Size: 373KB Width: 2100  |  Height: 2100  |  Size: 39KB

BIN
images/static/png/tidyr-spread.png Прегледај датотеку

Before After
Width: 3429  |  Height: 4658  |  Size: 347KB Width: 2100  |  Height: 2100  |  Size: 32KB

+ 83
- 83
images/static/svg/tidyr-gather.svg
Разлика између датотеке није приказан због своје велике величине
Прегледај датотеку


+ 71
- 71
images/static/svg/tidyr-spread.svg
Разлика између датотеке није приказан због своје велике величине
Прегледај датотеку


BIN
images/tidyr-spread-gather.gif Прегледај датотеку

Before After
Width: 480  |  Height: 480  |  Size: 789KB Width: 480  |  Height: 480  |  Size: 893KB

Loading…
Откажи
Сачувај