#######
rm(list = ls())
#Waffle charts in R
#Waffle charts is a nice way of showing the categorical composition of the total population.
library(tidyverse)
## -- Attaching packages ---------------------------------------------- tidyverse 1.3.0 --
## √ ggplot2 3.3.2 √ purrr 0.3.4
## √ tibble 3.0.3 √ dplyr 1.0.1
## √ tidyr 1.1.2 √ stringr 1.4.0
## √ readr 1.3.1 √ forcats 0.5.0
## -- Conflicts ------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(RColorBrewer)
nrows <- 10
categ_table <- round(table(mpg$class ) * ((nrows*nrows)/(length(mpg$class))))
categ_table
##
## 2seater compact midsize minivan pickup subcompact suv
## 2 20 18 5 14 15 26
sort_table <- sort(categ_table,index.return=TRUE,decreasing = FALSE)
sort_table
##
## 2seater minivan pickup subcompact midsize compact suv
## 2 5 14 15 18 20 26
class(sort_table)
## [1] "table"
Order<-sort(as.data.frame(categ_table)$Freq,index.return=TRUE,decreasing = FALSE)
df <- expand.grid(y = 1:nrows, x = 1:nrows)
df$category<-factor(rep(names(sort_table),sort_table), levels=names(sort_table))
Color<-brewer.pal(length(sort_table), "Set2")
head(df)
## y x category
## 1 1 1 2seater
## 2 2 1 2seater
## 3 3 1 minivan
## 4 4 1 minivan
## 5 5 1 minivan
## 6 6 1 minivan
dim(df)
## [1] 100 3
#####################################method_1 geom_tile
str(df)
## 'data.frame': 100 obs. of 3 variables:
## $ y : int 1 2 3 4 5 6 7 8 9 10 ...
## $ x : int 1 1 1 1 1 1 1 1 1 1 ...
## $ category: Factor w/ 7 levels "2seater","minivan",..: 1 1 2 2 2 2 2 3 3 3 ...
## - attr(*, "out.attrs")=List of 2
## ..$ dim : Named int [1:2] 10 10
## .. ..- attr(*, "names")= chr [1:2] "y" "x"
## ..$ dimnames:List of 2
## .. ..$ y: chr [1:10] "y= 1" "y= 2" "y= 3" "y= 4" ...
## .. ..$ x: chr [1:10] "x= 1" "x= 2" "x= 3" "x= 4" ...
ggplot(df, aes(x = y, y = x, fill = category)) +
geom_tile(color = "white", size = 0.25) +
#geom_point(color = "black",shape=21,size=5) +
coord_fixed(ratio = 1) +
scale_x_continuous(expand = c(0.1, 0.1)) +#,
scale_y_continuous(expand = c(0.1, 0.1),trans = 'reverse') +
scale_fill_manual(name = "Category",
#labels = names(sort_table),
values = Color) +
theme(#panel.border = element_rect(fill=NA,size = 2),
panel.background = element_blank(),
plot.title = element_text(size = rel(1.2)),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.title = element_blank(),
legend.position = "right")

#####################################################circle
ggplot(df, aes(x = y, y = x, fill = category)) +
#geom_tile(color = "white", size = 0.25) +
geom_point(color = "black",shape= 21,size=10) +
coord_fixed(ratio = 1) +
scale_x_continuous(expand = c(0.1, 0.1)) +#,
scale_y_continuous(expand = c(0.1, 0.1),trans = 'reverse') +
scale_fill_manual(name = "Category",
#labels = names(sort_table),
values = Color) +
theme(#panel.border = element_rect(fill=NA,size = 2),
panel.background = element_blank(),
plot.title = element_text(size = rel(1.2)),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.title = element_blank(),
legend.position = "right",
legend.key = element_rect(colour = NA, fill = NA))

#SHAPE
d=data.frame(p=c(0:25,32:127))
ggplot() +
scale_y_continuous(name="") +
scale_x_continuous(name="") +
scale_shape_identity() +
geom_point(data=d, mapping=aes(x=p%%16, y=p%/%16, shape=p), size=5, fill="red") +
geom_text(data=d, mapping=aes(x=p%%16, y=p%/%16+0.25, label=p), size=3)

#################OUT
ggsave(filename = paste0(Sys.Date(),"-Waffle charts.tif"), plot = last_plot(),
device = "tiff", path = NULL,
scale = 1, compression = "lzw", width = 13, height = 12, units = "cm",
dpi = 300, limitsize = TRUE)
######################################method_2
#install.packages("waffle")
library(waffle)
parts <- c(One=40, Two=30, Three=20, Four=10)
waffle(parts, rows=10, colors = c("deepskyblue", "red1", "forestgreen", "gold"))
