#######
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"))