iterating over creation of mini-tables as strings

library(palmerpenguins)
library(janitor)
#> Warning: replacing previous import 'vctrs::data_frame' by 'tibble::data_frame'
#> when loading 'dplyr'
#> 
#> Attaching package: 'janitor'
#> The following objects are masked from 'package:stats':
#> 
#>     chisq.test, fisher.test
library(glue)

# this is a simple example (minimal reprex) for a larger problem

data <- palmerpenguins::penguins

species_vec <- data %>% distinct(species) %>% pull()
#> Error in distinct(., species): could not find function "distinct"

data %>% 
  filter(species == "Adelie") %>% 
  tabyl(island) %>% 
  adorn_totals("row") %>% 
  arrange(desc(n)) ->
table1
#> Warning in data.matrix(data): NAs introduced by coercion
#> Warning in data.matrix(data): NAs introduced by coercion

#> Warning in data.matrix(data): NAs introduced by coercion
#> Error in filter(., species == "Adelie"): object 'species' not found

table1[1,1] <- "All Islands"
#> Error in table1[1, 1] <- "All Islands": object 'table1' not found

table2 <- table1 %>% 
  mutate(new_col = paste0(n, " ", island, "\n")) %>% 
  select(new_col)
#> Error in eval(lhs, parent, parent): object 'table1' not found

# store max character width for later use in box sizing
islands_char_width <- max(nchar(table2$new_col))
#> Error in nchar(table2$new_col): object 'table2' not found

island_label <- glue_collapse(table2$new_col)
#> Error in glue_collapse(table2$new_col): object 'table2' not found
island_label
#> Error in eval(expr, envir, enclos): object 'island_label' not found

# I would like to make an island_label 
# (essentially a mini-table with line breaks) as a single string
# for each species of penguin
# and put the text on a ggplot with geom_text
# with a surrounding box (geom_rect) sized to the text

# but first I need to make the island_labels for each species.
# I would like to do this iteratively (over species_vec) with purrr and end up with a 1 column dataframe
# I can wrap this into a function, but I am struggling to make this work with purrr and map_dfr
# 
# Or am I going about this in a wrongheaded way and is there a better way to plot mini tables in boxes 
# requirement: in which I know exactly where the boxes are located (for drawing arrows between them later)?

Created on 2020-08-26 by the reprex package (v0.3.0)

The method is to make your code into a function. then you can use map

library(tidyverse)
library(palmerpenguins)
library(janitor)
library(glue)

data <- palmerpenguins::penguins

species_vec <- data %>% pull(species) %>% unique()


make_table <- function(chosen_species){
data %>% 
  filter(species == chosen_species) %>% 
  tabyl(island) %>% 
  adorn_totals("row") %>% 
  arrange(desc(n)) ->
  table1

table1[1,1] <- "All Islands"


table2 <- table1 %>% 
  mutate(new_col = paste0(n, " ", island, "\n")) %>% 
  select(new_col)

# store max character width for later use in box sizing
islands_char_width <- max(nchar(table2$new_col))


island_label <- glue_collapse(table2$new_col)
island_label
}

purrr::map(species_vec,
           ~make_table(.))
[[1]]
152 All Islands
56 Dream
52 Torgersen
44 Biscoe


[[2]]
124 All Islands
124 Total
0 Dream
0 Torgersen


[[3]]
68 All Islands
68 Total
0 Biscoe
0 Torgersen
1 Like

Thank you!
I can just unlist() this result to get the vector of three strings that I need.

I was having the hardest time figuring out the purrr syntax.
I was trying to make it work with map_dfr(), but getting an error
Error: Argument 1 must have names.

which I was struggling to understand.

Just for my understanding, is there a way to make this work with map_df() or map_dfr()?

map_chr because island_label is a char. If island label was a dataframe then mapdfr might be appropriate

Thank you!

that makes sense.

Your reply also led me to discover this workaround, which produces a similar (but slightly different structure) result.

purrr::map(species_vec,
           ~make_table(.)) %>% 
  set_names(species_vec) %>% 
  bind_rows() %>% 
  pivot_longer(cols = species_vec, names_to = "species")
1 Like

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.