Visualization of Prime Factorization

prime_viz.R

# Recreation of https://twitter.com/stevenstrogatz/status/1295915404574040065/photo/1
library(tidyverse)
library(Polychrome)
fun <- function(x){
  n <- c()
  i <- 2
  r <- x
  while(prod(n)!=x){
    if(!r%%i) {n=c(n,i);r=r/i;i=1}
    i <- i+1
  }
  if(x==1){
    n <- 1
  }
  n
}

prime_cols <- glasbey.colors(n=26)

prfac_tbl <- tibble(number=1:100) %>% 
  rowwise() %>% 
  mutate(prfac=list(fun(number))) %>% 
  ungroup() %>% 
  mutate(factors=map_int(prfac,length)) %>% 
  mutate(is_prime = factors==1) 

primes <- which(prfac_tbl[["factors"]]==1)
names(prime_cols) <- primes

prfac_tbl %>% 
  unnest(prfac) %>% 
  group_by(number) %>% 
  mutate(x=1/factors,x=cumsum(x)) %>% 
  mutate(col=prime_cols[match(prfac,names(prime_cols))]) %>% 
ggplot()+
  geom_rect(aes(xmin=x-1/factors,xmax=x,fill=I(col)),ymin=0,ymax=1,col="black")+
  theme_void()+
  scale_x_continuous(limits=c(0,1))+
  scale_y_continuous(limits=c(0,1))+
  coord_fixed(expand = FALSE)+
  theme(strip.background = element_rect(color="black",size=0.8),
        panel.spacing = unit(0,"pt"),
        panel.border = element_rect(color="black",fill=NA,size=0.8))+
  facet_wrap(~factor(number,levels = c(t(t(matrix(1:100,10,10))[10:1,]))),
             strip.position = "bottom") -> p

ggsave("Pictures/prime_viz.png",p,width=10,height=10)