UsefulCode_ggplot.Rmd

---
title: Useful R code in `ggplot`
author: |
 | Matthew Malishev
 | @darwinanddavis 
fontsize: 10
geometry: margin=1in
documentclass: article
linkcolor: pink
urlcolor: blue
citecolor: red
always_allow_html: yes
output:
  html_document:
    highlight: tango
    code_folding: show
    toc: yes
    toc_depth: 4
    number_sections: no
    toc_float: yes
  md_document: 
    variant: markdown_github
  pdf_document:
    includes:
      in_header: # add .tex file with header content
    highlight: tango
    template: null
    toc: yes
    toc_depth: 4
    number_sections: false
    fig_width: 4
    fig_height: 5
    fig_caption: true
    df_print: tibble 
    citation_package: biblatex # natbib
    latex_engine: xelatex #pdflatex # lualatex
    keep_tex: true # keep .tex file in dir 
  word_document:
    highlight: tango
    keep_md: yes
    pandoc_args: --smart
    #reference: mystyles.docx
    toc: yes
    toc_depth: 4
inludes:
  before_body: before_body.tex
subtitle: 
tags:
- nothing
- nothingness
params: 
  dir: "/Users/malishev/Documents/Melbourne Uni/Programs/R code/UsefulCode"
  date: !r Sys.Date()
  version: !r getRversion()
  email: "matthew.malishev [at] gmail.com"
  doi: https://github.com/darwinanddavis/UsefulCode
classoption: portrait
# ^['https://github.com/darwinanddavis/UsefulCode'] # footnote
vignette: >
  %\VignetteIndexEntry{Useful R code}
  %\VignetteEncoding{UTF-8}
  %\VignetteEngine{knitr::rmarkdown}
---

<script type="text/x-mathjax-config">
  MathJax.Hub.Config({ TeX: { equationNumbers: {autoNumber: "all"} } });
</script>

```{r echo = FALSE}
 library(rmarkdown)
# setwd("")
# f <- list.files()[1]
# render(f, output_format='pdf_document')
# render(f, output_format='pdf_document')
```

```{r, set-options, echo = FALSE, cache = FALSE}
options(width=100)
knitr::opts_chunk$set(
 eval = T, # run all code
 results='hide',
 # echo = FALSE, # show code chunks in output 
 comment = "",
 tidy.opts=list(width.cutoff=100), # set width of code chunks in output
 tidy=TRUE, # make output as tidy
 message = FALSE,  # mask all messages
 warning = FALSE, # mask all warnings 
 size="small" # set code chunk size
)

# https://github.com/ucb-stat133/stat133-fall-2016/blob/master/hws/hw02-tables-ggplot.Rmd
knitr::opts_knit$set(root.dir=paste0(params$dir,"/")) # set working dir

setwd(paste0(params$dir,"/")) # for running just in R not knitr
```

\  

Date: `r params$date`  
`R` version: `r params$version`  
*Corresponding author: `r params$email`  
This document can be found at `r params$doi`

\newpage  

## Overview

Same deal as Useful Code 1 and 2 except just `gglot` because it's too difficult sifting through the other docs.  


### Remove annoying stock gridlines from plot window    
```{r, ggplot1, results='hide',eval=F}
# option 1
p1 <- p + labs(title="Option 1") +
  theme_classic()
p1

# option 2 with inputs to toggle 
p2 <- p + labs(title="Option 2") +
  theme_bw() + 
  theme(panel.border = element_blank(), 
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(), 
        axis.line = element_line(colour = "black")
        )
p2
# alternative (after loading ggridges library)
# theme_ridges(grid=F,center_axis_labels = T)
```

### Setting global graphics theme for ggplot
```{r, ggplot2, results='hide',eval=F}
plot_it_now <- function(bg){ # bg = colour to plot bg
  theme(panel.border = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_rect(fill = bg,
                                        colour = bg),
        plot.background = element_rect(fill=bg)
  ) +
    theme(axis.line = element_line(color = "white")) +
    theme(axis.ticks = element_line(color = "white")) +
    theme(plot.title = element_text(colour = "white")) +
    theme(axis.title.x = element_text(colour = "white"), 
          axis.title.y = element_text(colour = "white")) +
    theme(axis.text.x = element_text(color = "white"),
          axis.text.y = element_text(color = "white")) +
    theme(legend.key = element_rect(fill = bg)) + 
    theme(legend.title = element_text(colour="white")) + 
    theme(legend.text = element_text(colour="white")) 
} 
plot_it_now("black")
```

### Put plot in function to take dynamic data inputs  
Ref: http://jcborras.net/carpet/visualizing-political-divergences-2012-local-elections-in-helsinki.html
```{r, ggplot3, results='hide',eval=F}
hr.mass.plot <- function(d) {
  p <- ggplot(d, aes(HR, Mass, color = colfunc)) + 
    geom_density_2d(data=d, aes(x = HR, y = Mass), 
                    stat = "density2d",position="identity", 
                    color=adjustcolor("orange",alpha=0.8), size=1.5, contour = T, lineend="square",linejoin="round") 
  p <- p + geom_point(data=d, aes(x = HR, y = Mass),
                      color=colfunc,
                      fill=colfunc) +
    scale_color_manual(values = magma(8))
  p <- p + scale_y_continuous(limits=c(-200,200), name="Mass lost (g)") 
  p <- p + scale_x_continuous(limits=c(0,0.35),name=expression("Home range area (km^2)")) 
  p <- p + theme_classic()
  print(p)
}
hr.mass.plot(d)
```

### Using `ggplot` when looping through `for` loop and saving to dir  
```{r, ggplot4,eval=F}
pdf("mypdf.pdf",onefile = T)
for(i in 1:3){ 
par(bty="n", las = 1)
  grid.arrange( 
  ggplot(data, aes(x = X, y = Y, fill = ..x..)) + 
    geom_point() +
    labs(title = paste0("Title_",i)) +
    xlab("X") +
    ylab("Y")
  )
} 
# end loop 
dev.off()



# geom_density_ridges() # scale = overlap

# geom_density_ridges(scale = 5, size=0.2,color="white", rel_min_height = 0.01,fill=col,alpha=0.5) +

# scale_fill_viridis option =  "magma", "inferno","plasma", "viridis", "cividis"

```

### Converting lists and dataframes to usable format for `ggplot` (`melt` package)
```{r, ggplot5, results='hide',eval=F}
require(reshape2) # melt package   
nn <- 10 # reps
mm <- data.frame("X"=rep(LETTERS,nn),"Y"=sample(nn,replace = T),"Z"=rep(paste(LETTERS,"_",rnorm(1)),nn))
# plot 
y_m <- melt(mm); head(y_m)
ggplot(data = y_m, aes(x = X, y = value, group = Z, colour=factor(value))) +
  geom_point(aes(size=value)) + geom_line() + theme_classic() 

```

### Insert math expression in plot or legend title
```{r, ggplot6, results='hide',eval=F}
xx = sample(100, 100)
yy = rnorm(100)

title1 <- bquote("Density = " ~ r[xy] ~ "and" ~ B^2 ~ + beta ~ alpha)
ggplot() + 
  geom_point(aes(x=xx,y=yy),color=xx) +
  labs(title = title1, 
       xlab = title1,
       yab = title1,
       colour=title1)
```

### Create double line break with expression in legend title (and labels)      
```{r, ggplot7, results='hide',eval=F}
ggplot() +
  scale_color_manual(
    expression(atop("text", 
    atop(textstyle(epsilon))))
    )

ggplot() +
  scale_color_manual(
    name=expression(
      atop("Productivity",
           atop(textstyle(
          (mg~C~L^{-1}~d^{-1}) # this is bracketed text
          ))))
  )

```

### Adding text lables to plots
```{r, t1,eval=T}
require(ggplot2)
xx = sample(100, 100)
yy = rnorm(100)
df <- data.frame("X"=xx,"Y"=yy)

ggplot(df) +
  geom_point(aes(xx,yy,size=5),colour=xx,show.legend = F) +
  geom_text(aes(xx,yy,label=xx),check_overlap = T,size=yy+5) +
  theme_classic()

# add bg label
ggplot() +
  geom_line(aes(xx,yy,size=5),colour=xx,show.legend = F) +
  geom_label(aes(xx,yy,label=xx),size=yy+5,color = yy +5, fill=xx) +
  theme_classic() 
```

Add text only to final point (plus other methods)  
```{r, t2, eval=F}
require(directlabels)
df <- tibble("x" = sample(10,5),
             "y" = sample(10,5),
             "label" = LETTERS[1:5])

ggplot() +
  geom_point(data = df, aes(x,y)) +
  geom_dl(aes(label = label), 
          method = list(
            dl.trans(x = x + 0.3, y = y + 0), # expand x/y axis to fit in labels  
            list(dl.combine("first.points","last.points")), cex = 0.5 # add labels to first and last points
            )
          ) +
  scale_x_continuous( ..., expand = c(0, 1.5))

```


### Calling data frame columns with weird formatting 
```{r,gg9, eval = F}
# use ticks, not quotations

require(ggplot2)
df <- data.frame("X"=rnorm(1000),"Y col with spaces"=sample(1000,replace = T))

# incorrect y col, but doesn't throw error
ggplot(df, aes(X, "Y col with spaces")) + 
  geom_line()

# same issue even when matching col name
ggplot(df, aes(X, "Y.col.with.spaces")) + 
  geom_line()

# usable y col
ggplot(df, aes(X, `Y.col.with.spaces`)) + 
  geom_line()
```

### Use POSIX format

**Code	Meaning**    
%a	Abbreviated weekday  
%A	Full weekday  
%b	Abbreviated month  
%B	Full month  
%c	Locale-specific date and time  
%d	Decimal date  
%H	Decimal hours (24 hour)  
%I	Decimal hours (12 hour)  
%j	Decimal day of the year  
%m	Decimal month  
%M	Decimal minute  
%p	Locale-specific AM/PM  
%S	Decimal second  
%U	Decimal week of the year (starting on Sunday)  
%w	Decimal Weekday (0=Sunday)  
%W	Decimal week of the year (starting on Monday)  
%x	Locale-specific Date  
%X	Locale-specific Time  
%y	2-digit year  
%Y	4-digit year  
%z	Offset from GMT  
%Z	Time zone (character)  

```{r,gg10}
require(nycflights13);require(dplyr);require(ggplot2)
flights %>% str
flights$time_hour %>% class # already posix
flights_mod <- flights$time_hour %>% as.character() # convert posix to character

# turn into posix year month day hour minute second format
require(lubridate)
flights_mod <- flights_mod %>% ymd_hms()  
flights_mod %>% class

# make new df with fewer data 
df <- data.frame("Date"=flights_mod[1:100000],
                 "Delay"=flights$arr_delay[1:100000])

ggplot(df, aes(Delay,Date)) + geom_tile() +
  scale_y_datetime(date_breaks = "1 month", 
                   date_minor_breaks = "1 week", # optional 
                   date_labels = "%B %Y" # full month and year
                  ) +
  theme_classic()

```

### Plotting multiple plots per window (with different plot size ratios) with `gridExtra`    
```{r,mp1}
require(gridExtra)

nn <- 100 # create sample
p <- ggplot()+geom_point(aes(sample(nn,replace=T),rnorm(nn),size=runif(nn),color=rainbow(nn)),show.legend = F)+theme_classic()

# put plots into list 
ggplot_list <- list(p,p,p,p)

# 3 plots above, 1 below
grid.arrange(
  grobs = ggplot_list, # list with ggplots or grobs
  widths = c(1, 1, 1),
  layout_matrix = rbind(c(1, 2, 3),
                        c(4, 4, 4))
)

# 3 plots above with first plot 2 plots wide 
grid.arrange(
  grobs = ggplot_list, # list with ggplots or grobs
  widths = c(2, 1, 1), # widths (2,1,1) of total plots for each row (3) 
  layout_matrix = rbind(c(1, 2, 3), 
                        c(4, 4, 4))
)

# 2 plots below with third plot 3 plots wide 
grid.arrange(
  grobs = ggplot_list, # list with ggplots or grobs
  widths = c(2, 1, 1),
  layout_matrix = rbind(c(1, 2, NA),
                        c(3, 3, 4))
)

```

Arranging multiplot panels  
```{r, mp2}
# https://patchwork.data-imaginist.com/articles/guides/assembly.html
# devtools::install_github("thomasp85/patchwork")
require(patchwork)

p1 <- ggplot(mtcars) + 
  geom_point(aes(mpg, disp, col = cyl), show.legend = F) + 
  ggtitle('Plot 1') + theme_classic()
p2 <- ggplot(mtcars) + 
  geom_point(aes(mpg, cyl, col = disp), show.legend = F) + 
  ggtitle('Plot 2')  + theme_classic()

p3 <- p1; p4 <- p2

# 2 plots, 2 cols
p1 + p2 

# multi rows
(p1 | p2 | p3) / p4 # 3 plots top, 1 bottom (2 rows)  
p1 / (p2 | p3) # 1 plot top, 2 bottom (2 rows)  

# 2 plots, 2 rows and 2 cols
wrap_plots(p1, p2, p3, p4)

# 3 plots, 2 cols 
patch <- p1 + p2
p3 + patch

# non ggplot content eg. text  
p1 + grid::textGrob('Some text')  
p1 + gridExtra::tableGrob(mtcars[1:10, c('mpg', 'disp')])

# title, subs, and captions
patchwork <- (p1 + p2) / p3
patchwork + plot_annotation(
  title = "ttl",
  subtitle = "subttl",
  caption = "caption"
)

```


### Setting legend to custom aes elements, e.g. color, shape, linetype    
```{r,gg12,eval=T}
# set 'labs' arguments to same title as in 'scale_color_manual'
# legend values automatically matches arguments passed to colvec
# NB specifying the labels arg in scale_color_manual overrides labs  

require(ggplot2)

snack_df <- data.frame(
  "X"=sample(100,10,replace=F),
  "Y"=sample(100,10,replace=F),
  "Sum"=runif(10),
  "Size"=rep(LETTERS[1:5],each=2)
)
colvec <- colorspace::sequential_hcl(length(unique(snack_df$Size)), "SunsetDark")
legend_ttl <- "This is your legend"
legend_pars <- unique(snack_df$Size) # not run
                       
ggplot(snack_df,aes(X,Y)) +
  geom_line(aes(group=Size,color=Size,linetype=Size),size=1) +
  geom_point(aes(group=Size,color=Size,shape=Size),size=3) +
  scale_color_manual(name=legend_ttl,
                     # labels = legend_pars, # this overrides labs 
                     values = colvec) +
  geom_text(aes(X,Y,
                label=c(Size)
                ),
            check_overlap = T,
            size=5,vjust=-1,hjust=1.2) +
  labs(title="Plot title",x="X",y="Y",
       # ----- these are the legend key arguments
       colour=legend_ttl,
       fill=legend_ttl,
       linetype=legend_ttl,
       shape=legend_ttl) + # check shape 
  theme_classic() 

```

### Pass variables as user arguments to plotting function 

Option 1  
```{r, gg13, eval =T}
# http://www.rebeccabarter.com/blog/2020-02-05_rstudio_conf/
require(tidyverse);require(dplyr)
midwest %>% head
plotMidwestTidy <- function(var1, var2) {
  ggplot(midwest) +
    geom_point(aes(
      x = {{ var1 }}, y = {{ var2 }} # wrap vars in double curly braces  
      )) 
}

plotMidwestTidy(popdensity, poptotal) +
  theme_bw()
```

Option 2
Can't use character class as user argument   
```{r,gg13b, eval=F, echo = T}
require(ggplot2)
my_theme <- theme_classic()
colour_var <- "class"
facet_var <- "drv"

ggplot(mpg) +
  geom_point(aes(displ, hwy, colour = colour_var)) +
  facet_wrap(vars(facet_var)) + my_theme
```

Placing `.data` in front of your variables and wrapping them with double square braces '[[]]' solves this.    
```{r, eval = T}
require(ggplot2)
my_theme <- theme_classic()
colour_var <- "class"
facet_var <- "drv"

ggplot(mpg) +
  geom_point(aes(displ, hwy, colour = .data[[colour_var]])) +
  facet_wrap(vars(.data[[facet_var]])) + my_theme +
  ggtitle(paste0(colour_var, " vs ", facet_var))
```

### Use conditional statements in `ggplot` objects  
```{r,gg14,eval=T}
require(ggplot2)
cond1 <- F
cond2 <- T
p <- ggplot(mtcars) +
        geom_point(aes(mpg,hp,size=3),show.legend = F) +
  theme_classic()
p <- p + if(cond1==T){ # execute condition 1 and add to plot 
        geom_line(aes(mpg,hp,size=3),color="red",show.legend = F)
      }
p <- p + if(cond2==T){ # execute condition 2 and add to plot 
        geom_line(aes(mpg,hp,size=2),color="blue",show.legend = F)
      }
p
```

Make calendar plot  
```{r, gg15}
require(sugrrants)
require(nycflights13)
ff <- flights 
ff <- ff %>% mutate(date = flights$time_hour %>% as.Date())
fdf <- frame_calendar(ff,
                 x = distance, 
                 y = arr_delay, 
                 date = date,
                 nrow = 4)
p <- ggplot(fdf) +
  geom_line(aes(x = .distance, 
                y = .arr_delay, 
                group = date)) + theme_void()
p %>% prettify()
```

### Plot benchmark results  
https://stackoverflow.com/questions/29803253/r-extracting-coordinates-from-spatialpolygonsdataframe
```{r, gg16, eval=F}
res <- microbenchmark(raster::geom(atf_sp),
                      ggplot2::fortify(atf_sp),
                      spbabel::sptable(atf_sp),
                      as.data.frame(as(as(atf_sp, "SpatialLinesDataFrame"),
                                       "SpatialPointsDataFrame")))
ggplot2::autoplot(res)
```


### Flip, rotate, and reorder

Flip axis directions
```{r, f1, eval=F}
# rotate 
print(p, vp=viewport(angle=-30))
p + coord_flip()
p + scale_y_reverse()
graphics.off()

```


Reorder data within variables to have custom plot order
```{r, f2, eval = F}
ggplot() +
  geom_bar(data = df, aes(year, value, 
                          fill = factor(var1, level = unique(var1)) # reorder to match order data is listed within variable
                          ))

```

### Colour palettes 

Match df column/variable to custom colour scale  
```{r, col1, eval = F}
require(colorspace)
mycolors <- sequential_hcl(d %>% pull(var1) %>% n_distinct(), "Tofino")
names(mycolors) <- d$var1 %>% unique %>% factor %>% levels
custom_colors <- scale_colour_manual(name = "Title",
                                     values = mycolors)

ggplot() +
  geom_sf(data = d) +
  custom_colors # add scale 

require(colorspace)
require(scales)

# match sequential colpal as sequential values in df
colv <- colorRampPalette(colors = c(col_low ,col_high))
colpal <- colv(d$value %>% length)
d$colpal <- colpal

# match sequential colpal to unique values in df var
colpal <- sequential_hcl(d$value %>% length, "Sunset")
pal <- col_numeric(palette = colpal, domain = d$value)
d <- d %>% mutate("colpal" = pal(value))

# match custom palette colpal to unique values in df var
colv <- colorRampPalette(colors = c(col_low ,col_high))
colpal <- colv(d$value %>% length)
pal <- col_numeric(palette = colpal, domain = d$value)
d <- d %>% mutate("colpal" = pal(value))

# add optional highlight colours
d <- d %>% mutate_at("colpal", funs(case_when(
  id_name == "name1" ~ "red",
  TRUE ~ colpal
)))

# match colours based on df variable values  
d <- d %>% 
  mutate("colpal" = case_when(
  id_name %in% "name1" ~ "red",
  TRUE ~ colpal # or e.g. "blue"
))
ggplot() +
  geom_sf(data = d, aes(col = colpal)) +
  scale_color_manual(values = d$colpal %>% unique) # then add manual colpal from df 
  


```

Loop through different colpals and save plots to dir
```{r}
vars <- df$var1 %>% unique
colv <- c("Peach", "PinkYl", "Burg")
for(i in seq_along(vars)){
df <- df %>% filter(var1 == vars[i]) 
xlab <- "Month"
ylab <- "Day"
nn <- df %>% pull(var2) %>% n_distinct()
colpal <- c(sequential_hcl(nn,colv[i]) %>% .[nn],sequential_hcl(nn,colv[i]) %>% .[1]) # set col gradient
ggplot() +
  geom_tile(data = df, aes(v1,v2,fill = ar2)) +
  scale_fill_gradient(low = colpal[1], high = colpal[2], guide = "colourbar",na.value = "transparent")  # create custom gradient
  
ggsave(here::here("plot",var1[i],"_activity.png"),device = "png")
}
  
```

Create gradient colour for area plot (AUC)
<!-- https://datacornering.com/how-to-create-gradient-shade-under-the-line-chart-in-r/ -->
```{r, col4, eval = F}
library(minisvg)
library(devout)
library(devoutsvg)  
library(poissoned)
library(svgpatternsimple)
require(ggplot2)
require(ggdark)

# create gradient 
gradient_pattern  <- create_pattern_gradient(
  id = "p1",
  angle = 90,
  colour1 = "#1A1A1A",
  colour2 = "#63CB99",
  alpha = 0.8
)

gradient_pattern$show()

# save gradient as svg
my_pattern_list <- list(`#000001` = list(fill = gradient_pattern))

svgout(
  filename = "line-chart-with-gradient-shade.svg",
  pattern_list = my_pattern_list,
  width = 10,
  height = 5
)

# plot
ggplot(btc, aes(x = Date, y = Price)) +
  geom_line(color = "#63CB99",
            size = 0.4,
            alpha = 0.9) +
  geom_area(alpha = 0.3,
            fill = "#000001",
            color = alpha(0.1)) +
  ggtitle("BTC price, USD") +
  scale_y_continuous(labels = scales::comma) 
  

```

Glow effect for line plot
<!-- https://datacornering.com/how-to-add-glow-effect-in-r-plot/ -->
```{r, col5, eval = F}
require(ggshadow)
require(ggplot2)
require(ggthemes)

ggplot(btc, aes(x = Date, y = Price)) +
  geom_glowline(color = "gold", shadowcolour = "orange") +
  theme_solarized_2(light = FALSE) +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) 
```


### Images  
Fill plot view with image   
```{r, gg19, eval=F}
require(png)
require(jpeg)
imgr <- img %>% readPNG()
ggplot() +
  annotation_raster(imgr, -Inf, Inf, -Inf, Inf)

```

Fill geom with patterns/images 
https://coolbutuseless.github.io/package/ggpattern/index.html  
```{r, gg20, eval=F}

```

Read in png, recolor, write as svg, and append to df 
```{r, eval =F}

here::here("img",paste0(ifh,".png")) %>% 
  image_read(strip = T) %>% 
  # image_scale(c(100,100)) %>% 
  image_fill("transparent") %>%
  image_colorize(color = colv_hi,opacity = 70) %>%  # recolor img
  image_write(here::here("img",paste0(ifh,"2.png")) ,format = "png", depth=NULL)

# append to df 
df$img <- here::here("img",paste0(ifh,"2.png"))
```


### Create custom geom

```{r, gg21, eval=F}
library(ggplot2)
x <- 1:100

my_geom_y <- function(yy, colour = "black"){
  list(
    geom_line(aes(y= yy), 
              col = colour), 
              data = data.frame(x, yy),
    geom_point(aes(y = yy), 
               col = colour, 
               data = data.frame(x, yy))
  )
 }

ggplot(aes(x))  + 
  my_geom_y(x, "red") + 
  my_geom_y(dlnorm(x), "blue") +
  my_geom_y((x^1.1), "black") +
  my_geom_y(x/2, "yellow")
```

Highlight variables in plot 

```{r, gg22, eval=T}
library(ggplot2)
library(gghighlight)
ggplot(mpg, aes(x = cty, y = hwy)) +
  geom_point(color = "red",
             size=2) +
  gghighlight(class == "midsize")
```

Set inner circle width for circular barplot
```{r, gg23, eval=F}
ylim <- 40
ggplot() +
  geom_histogram(data = d, 
                 aes(xx,id,fill = yy), size = 0, position = "stack", stat = "identity", show.legend = F) + 
  scale_fill_manual(values = adjustcolor(colv,1),aesthetics = c("col","fill")) +  
  facet_wrap(~zz) +
  theme_classic() +
  coord_polar(start = 0.25) +
  scale_x_continuous(breaks = 1:12, labels = xtick) +
   # option 1
  scale_y_continuous(expand = c(0.2,0)) +
  # option 2
  scale_y_continuous(limits = c(-10,NA), breaks = seq(0,ylim,ylim/4), labels = seq(0,ylim,ylim/4)) 
  
```

Add histogram dist to boxplots (from Eli data)  
```{r, gg24, eval = F}
limits <- d$yy %>% unique
colv <-  colorspace::sequential_hcl(limits, "Blues")
require(ggdist)
ggplot(data = d, aes(x = xx, y = yy, 
                     col = yy, fill = yy
                     )) +
  geom_boxplot(outlier.color = NA) + # boxplot
  geom_jitter(height = 0.2) + # jitter points
  ggdist::stat_dots(binwidth = 0.2, # opt 1: dot plot
                    side = "left", 
                    justification = 1.1,
                    col = NA) + 
  ggdist::stat_halfeye(slab_type = "pdf",
                       limits = c(1, NA), # rm data < 1
                       adjust = 0.5, # opt 2: point dist
                       width = 0.5, 
                       .width = 0, # decrease iqr line width
                       justification = -0.5, # move dist above box
                       point_colour = NA) +
  scale_y_discrete(limits=limits) + # reorder xaxis
  scale_colour_manual(values = colv,aesthetics = "col", limits = limits, labels = limits) + # keep solid col for boxplot
  scale_fill_manual(values = adjustcolor(colv,0.7), aesthetics = "fill",limits = limits, labels = limits) + # add alpha to boxplot fill
  theme_classic()
```

Maintain order of variables in df when plotting
```{r, c1, eval = F}
limits <- df$var1 %>% pull
df %>% ggplot() +
  geom_col(aes(x,y)) +
  scale_x_discrete(limits = limits) 

# option 2 (works for factor variables with barplot)
require(forcats)
df %>% ggplot() +
  geom_bar(aes(fct_infreq(y))) 

# reverse variable order 
df %>% ggplot() +
  geom_bar(aes(fct_rev(y))) 

```


### Insert plot inset within main plot    
```{r, inset1, eval = F}

### opt 1
# first create and save plot inset to local dir
plot_inset <- ggplot() +
  geom_point(data = inset_data)
#
ggsave("plot_inset.png",plot_inset) 
plot_inset <- "plot_inset.png" %>% readPNG() # read in saved plot

# main plot
ggplot() +
  geom_sf(data = data) +
  # add plot inset
  annotation_raster(plot_inset,xmin = xmin, xmax = xmax, ymin = ymin ,ymax = ymax) +
  # themes
  theme_nothing()

### opt 2
ggdraw() +
  draw_plot(main1, 0, 0, 1, 1) +
  draw_plot(legend1, 0.15, 0.7, 0.18, 0.18)

```


### Legends    
Custom shape for legend  
```{r, gg25, eval=T}
# ?draw_key # see available glyphs 
require(ggplot2)
require(dplyr)
require(colorspace)

glyph <- "pointrange"
df <- data.frame(xx = rep(1:5,each=3),
                 yy = 1:15,
                 group = rep(c("A","B","C"),each=5))
ggplot(data=df,aes(xx,yy,col = group, fill = group)) + 
  geom_line(key_glyph = glyph) + # set shape for legend
  scale_fill_discrete_sequential(name = paste0(glyph, " legend"), "Reds", aesthetics = "col") +
  theme_bw() +
  guides(col = guide_legend(
    override.aes = list(size = 1)  # set custom legend size 
    ))
```

Fine tune legend features e.g. text, padding, vertical/horizontal spacing       
<!-- https://stackoverflow.com/questions/11366964/is-there-a-way-to-change-the-spacing-between-legend-items-in-ggplot2 -->
```{r, gg26, eval=T}
df <- data.frame(xx = sample(100, 100),
                 yy = rnorm(100))
ggplot(data=df,aes(xx,yy,col = yy, fill = yy)) +
  geom_point() +
  theme_classic() +
  theme(legend.position = "bottom") +
  # legend guide for colourbar
  guides(fill = guide_colorbar(title = "Continuous",
                               label.position ="left")) + 
  # legend guid for categorical
  guides(fill = guide_legend(title = "Categorical",
                               label.position ="right"))
  
```

Toggle legend when using `scale_*_()` functions
```{r, gg27, eval=F}
ggplot() + 
  geom_point(data = df, aes(fill = var1)) + 
scale_fill_manual(values = colpal, aesthetics = "fill", guide = F) # T/F to toggle show legend 
```

Customise attributes of two separate legends e.g. size and colour bar  
```{r, legend4, eval = F}
# set colourbar for var1 (color gradient) but also change colour/fill of legend for var2 (size)

ggplot() +
  geom_sf(data = df,aes(col=var1,fill=var1,size=var2)) +
  # var 1 attributes (colour/fill gradient)
  scale_fill_gradientn(name = title1, colours = adjustcolor(colpal,0.5),aesthetics = c("col","fill"), na.value = "#EFEFEF") +
  # var 2 attributes (size)
  guides(size = guide_legend(title = title2,
    override.aes = list(fill = col_var2, alpha = 0.5, col = col_var2)  # change colour for size legend (var2)
  ))



```

Change legend font, size, bg, opacity, and position
```{r,legend5, eval =F}
opac <- 0.5
theme(legend.position=c(0.2,0.2), #xy from bottom left
        legend.key.size = unit(0.5, "cm"), # size
        legend.background = element_rect(fill=alpha(fg, opac)), # legend background
        legend.title = element_text(family = family,colour = col_font),
        legend.text = element_text(family = family,colour = col_font)
  ) 
```

Biscale legend 
<!-- https://github.com/richardvogg/30DayMapChallenge21/blob/master/day17_land/day17_land.R -->
```{r, legend6, eval = F}
require(biscale)

data <- bi_class(df, sf1, sf2, dim = 3)
legend <- bi_legend(pal = "GrPink",
                    dim = 3,
                    xlab = "More sf1",
                    ylab = "More sf2",
                    size = 12)
map <- ggplot() +
  geom_tile(data = data , aes(x = x, y = y, fill = bi_class), show.legend = F) +
  bi_scale_fill(pal = "GrPink", dim = 3) + # create biscale
  bi_theme()
  
# combine legend and map 
ggdraw() +
  draw_plot(map, 0, 0, 1, 1) +
  draw_plot(legend, 0.15, 0.7, 0.18, 0.18)

```


Blank theme with full legend 
```{r, legend7}
require(ggthemes)
p1 + theme_map() +
  theme(legend.background = element_rect(fill = "transparent"))

```

Setting custom legend position for wrapped/stacked plots 
```{r, legend8}
require(patchwork)
# can specify legend position using  theme(legend.position=...)  
wrap_plots(p,p1,p2, ncol = 2,
           guides = "collect" #"keep" "auto"
           )

```

Combine df aes elements (e.g. colour and size) into one legend
```{r, legend9}
require(dplyr)
require(ggplot2)
require(colorspace)
df <- tibble("x" = 1:10,
             "y" = 11:20,
             "size" = 1:10)
colpal <- sequential_hcl(df$size %>% n_distinct(),"Burg")
ggplot() + 
  geom_point(data = df, aes(x,y,size = size, colour = size)) +
  scale_colour_gradientn(colours = colpal, 
                         aesthetics = "colour",
                         guide = "legend")
  
```

Update legend title  
```{r, legend10, eval = F}

ggplot() + labs(fill = "title") # opt 1
ggplot() + guides(fill = guide_legend(title = "title")) # opt 2
ggplot() + scale_fill_discrete(name = "title") # opt 3

```


### Axes    
Add brackets to axes 
```{r}
# install.packages("lemon")
require(lemon)  
ggplot() +  
  geom_jitter(data = mpg, aes(cyl,hwy, colour = class), width = 0.2) +
  coord_flex_cart(bottom = brackets_horizontal(tick.length=0))
```

Extract variable name as character  
```{r}
require(ggplot2)
require(palmerpenguins)
my_theme <- theme_classic()
plot_penguin <- function(v1,v2,v3){
  var1 <- ensym(v1) # turn var into character 
  var2 <- ensym(v2)
  var3 <- ensym(v3)
  ggplot(penguins) +
  geom_point(aes({{var1}}, {{var2}}, colour = {{var3}})) +
  my_theme +
  ggtitle(paste0(var1, " vs ", var2, " by ", var3))
}
plot_penguin(bill_depth_mm,bill_length_mm,species)

```

Remove buffer around maps to crop map to plot edges
```{r, ax3}
p1 + 
  scale_x_continuous(expand = c(0,0)) +
  scale_y_continuous(expand = c(0,0)) 
  

```


### Text/titles

Set text behind plot area/map/data
```{r, text1, eval = F}
ggplot() +
  geom_text(data = ttl, aes(x,y,label=label),check_overlap = T) +
  geom_sf(data = sf) +
  coord_sf(crs = prj, xlim = c(bbox[1],bbox[3]), ylim = c(bbox[2],bbox[4])) +
  labs(x=NULL,y=NULL) +
  # themes
  theme_nothing()+
  theme(panel.grid.major = element_line(colour = border, linetype = 3, size = 0.2),
        plot.background = element_rect(fill = "transparent", colour = NA),
        panel.background = element_rect(fill = "transparent"),
        axis.text = element_blank(), 
        axis.ticks.length=unit(0, "null"),
        plot.margin=unit(c(0.1,0.1,0.1,0.1),"mm"),
        panel.ontop = F)  
```


Customise ggplot text with colours  
```{r, text2, eval=F}
require(ggtext)
ttl <- paste0("<span style='font-family: Avenir;'>Climate risk in Vietnam <br>
<span style='font-size: 30pt'> Exposure of 
  <span style='color:",colv1,";'>Coffee</span>, 
  <span style='color:",colv2,";'>Cashew</span>, and 
  <span style='color:",colv3,";'>Cassava</span>  
  </span></span>") %>% purrr::map(htmltools::HTML)

p + theme(plot.title = element_markdown(lineheight = 1)) + # add custom ggtext
  labs(title = ttl) 

# vlist <- c(coff,cash,cass)
# lapply(vlist,function(x) {colnames(x) = rep(c('Index',"geometry"),times = vlist %>% length/2)})

```

Add curved arrows/points to text labels, unicode chars, math expressions, etc  
```{r, text3}
require(ggrepel)
require(ggplot2)
set.seed(42)
ggplot(mtcars, aes(wt, mpg, label = carb)) +
  geom_point(color = "red") +
  geom_text_repel(
    nudge_x = .15,
    box.padding = 0.5,
    nudge_y = 1,
    segment.curvature = -0.1,
    segment.ncp = 3,
    segment.angle = 20
  )
```

Use sf geometry coords when adding text
```{r, text4, eval = F}
var1 <- df$size
ggplot() +
  geom_sf(data = sf) +
  geom_text(data = df, aes(
    df$geometry %>% st_coordinates %>% .[,1],
    df$geometry %>% st_coordinates %>% .[,2],
    label = .data[[var1]]
    )
            )
```


Repel labels (df and sf)  
```{r, text5, eval = F}
city_df_labels <- city_df %>% 
  mutate_at("city",str_to_upper) %>% 
  mutate_at("city",~str_replace_all(., " ","\n"))#  %>% 
# slice(-c(6,8,10,18,28)) 

# repel labels for sf and projected sf 
ggplot() +
  geom_text_repel(data = city_df_labels, aes(label = city, geometry = geometry),
                  stat = "sf_coordinates", col = path_col, size = city_label_size, min.segment.length = Inf, max.overlaps = Inf) 
  
# repel labels for df 
  ggplot() +
  geom_text_repel(data = city_df_labels, aes(lon, lat, label = city), col = path_col, size = city_label_size, min.segment.length = Inf, max.overlaps = Inf) 
  

```


Add text grob as plot area
```{r, text6, eval = F}
require(patchwork)
require(gridExtra)
require(grid)

# opt 1
fh_grob <- "Some text"
(p1 + p2) + grid::textGrob(fh_grob) 

# opt 2 - display df in plot window 
fh_grob <- data.frame(1:10)
pft <- gridExtra::tableGrob(fh_grob)
gridExtra::grid.arrange(p1, pft)



```


### Save/saving plots  

Save as any output
```{r, save1, eval = F}
require(rstudioapi)
p %>% rstudioapi::savePlotAsImage("p.png", format = "png",width, height)
```

### Size

Scale size of points manually
```{r, size1, eval = F}
ggplot() +
  geom_point(data = df, aes(x,y, size = var1)) +
  scale_size("size_area", range = c(-20,20))
```


### Plot types  

Contour/heatmap
```{r, tp1, eval = F}
bins = 50 
ll <- 6 # match to 'levels' in plot (get from plotting first)
lcol <- sequential_hcl(ll,"Reds")
ggplot() +
  geom_density2d_filled(data = df, aes(lon,lat, fill = ..level.., col = ..level.., bins = bins)) +
  scale_fill_gradientn(colors = colpal, aesthetics = c("col", "fill"))
```

Freescale grid layout
```{r, tp2, eval = F}
require(tmap)

# opt 1 - convert to spdf
spp <- sf %>% as("Spatial")
ggplot() +
  geom_spatial_tile(data = spp) + 
  facet_wrap(~id, scales = "free")

# opt 2 - tmap
require(tmap)
sf %>% 
  tm_shape() +
  tm_borders(group = "id") + # set plot area
  tm_polygons("area",palette = "BuPu",legend.show = F) +
  tm_facets(by = "id") + # facet by var
  tm_layout(frame = F, 
            frame.lwd = NA, 
            panel.label.bg.color = NA,
            panel.label.size = 2,
            main.title = ttl, 
            main.title.position = "center",
            main.title.size = 3,
            main.title.fontface = "bold") 
```

Mosaic/tile plot
<!-- https://twitter.com/thomasp85/status/1445357060758151175 -->
```{r, tp3, eval = T, echo = T }
require(ragg)
# tile, pattern and mosaic plots {ragg}

```

Animated plots  (see commented out examples below)  
<!-- https://www.alexcookson.com/post/2020-10-18-building-an-animation-step-by-step-with-gganimate/ -->

```{r}

```

Value dot plot (see commented out examples below) 
<!-- https://r-graph-gallery.com/web-valued-dots-map-bertin.html -->
```{r}

```

Interactive map and chart plots (ggiraph)
<!-- https://github.com/walkerke/map-challenge-2023/blob/main/scripts/day-28-chart-or-map.R -->
```{r, eval = F}
library(tidycensus)
library(tidyverse)
library(ggiraph)
library(scales)
library(patchwork)
library(tigris)

us_wfh <- get_acs(
  geography = "state",
  variables = "DP03_0024P",
  year = 2022,
  survey = "acs1",
  geometry = TRUE
) %>%
  filter(GEOID != "11") %>%
  shift_geometry(position = "outside") %>%
  mutate(tooltip = paste(NAME, estimate, sep = ": "))

gg <- ggplot(us_wfh, aes(fill = estimate)) +
  geom_sf_interactive(aes(tooltip = tooltip, data_id = GEOID),
                      size = 0.1) +
  scale_fill_viridis_c(option = "rocket", direction = -1,
                       labels = label_percent(scale = 1)) +
  labs(title = "Percent of workers who work at home",
       caption = "Data source: 2022 1-year ACS, US Census Bureau",
       fill = "ACS estimate") +
  theme_void()

gg_bar <- ggplot(us_wfh, aes(y = estimate, x = reorder(NAME, -estimate),
                             fill = estimate)) +
  geom_col_interactive(aes(data_id = GEOID)) +
  scale_fill_viridis_c(guide = "none", option = "rocket", direction = -1) +
  scale_y_continuous(labels = scales::label_percent(scale = 1)) +
  theme_minimal(base_size = 8) +
  labs(x = "",
       y = "") +
  theme(axis.text.x = element_text(angle = 45, vjust = 1,
                                   hjust = 1),
        legend.position = "bottom",
        legend.direction = "horizontal")

girafe(ggobj = wrap_plots(gg, gg_bar, widths = c(8, 8), heights = c(6, 2),
                          ncol = 1),
       options = list(
         opts_hover(css = ""),
         opts_hover_inv(css = "opacity:0.25;")
       ))
```


Word clouds    
```{r, eval = F}
devtools::install_github("lchiffon/wordcloud2") # need to use dev ver
figpath <- here::here("face.png") # needs to be black and white
wcld <- data.frame("keyword" = LETTERS[1:20],
                   "freq" = sample(100,20))

# run twice if first time doesn't run  
wordcloud2(wcld, figPath = figpath,
           color = c("skyblue","red"),
           backgroundColor = "pink")

# other options  
# https://spencerschien.info/post/data_viz_how_to/dense_word_clouds/
# https://lepennec.github.io/ggwordcloud/
# https://stackoverflow.com/questions/42028462/wordcloud-with-a-specific-shape
```