第 10 章 Theme design

xfun::download_file("https://www.dropbox.com/s/ysqu9z6an6chv0g/drake_theme.Rdata?dl=1")
load("drake_theme.Rdata")

Think of UX before you design

10.1 UX first

gg_themeApply <- themes(ggObject)

gg_themeApply$theme1$show()
gg_themeApply$theme2$show()

gg_themeApply$theme1$show()
gg_themeApply$theme1$export() 
gg_themeApply$theme1$adopt() # for the purpose of imposing another theme design on top of the current one
gg_themeApply$export()

More flexibility.

gg_themeApply$addThemes(...) # add themes ad hoc
gg_themeApply$restore()  # counter act against themeX$adopt()
gg_themeApply$change_ggObject(ggObjNew) # If themes adopted are to applied to more ggObjects, replace ggObject with ggObjNew without going through all preceding application experimental process

All tools to operate on an object is inside the object. This kind of programming is called encapsulation.

10.2 Skeleton building: backward construction

gg_themeApply$theme1$show()
gg_themeApply$theme1$export() 
gg_themeApply$theme1$adopt() # for the purpose of imposing another theme design on top of the current one

emptyFun <- function(){}
theme1 <- list(
  show = emptyFun,
  export = emptyFun,
  adopt = emptyFun
)

gg_themeApply$theme1
gg_themeApply$export()
gg_themeApply$restore()
gg_themeApply$addThemes(...)
gg_themeApply$change_ggObject(ggObjNew)

gg_themeApply <- 
  list(
    theme1 = theme1,
    export = emptyFun,
    restore= emptyFun,
    addThemes = emptyFun,
    change_ggObject = function(ggObjNew){}
  )

Menu testing

gg_themeApply$theme1$show()
gg_themeApply$theme1$export()
gg_themeApply$theme1$adopt()

gg_themeApply$export()
gg_themeApply$restore()
gg_themeApply$addThemes()
gg_themeApply$change_ggObject()

10.3 Generator function template

gg_themeApply <- Theme(ggObject)

Theme <- function(ggObject){
  gg_themeApply <- list()
  
  gg_themeApply$.self <- ggObject
  
  showFun <- function(){
    print(gg_themeApply$.self)
  }
    
  exportFun <- adoptFun <- 
    exportFun <- restoreFun <- addThemesFun <- function(){}
  change_ggObjectFun <- function(ggObjNew){}
  
  theme1 <- list(
    show = showFun,
    export = exportFun,
    adopt = adoptFun
  )
  
  gg_themeApply <- 
    append(
      gg_themeApply,
      list(
        theme1 = theme1,
        export = exportFun,
        restore= restoreFun,
        addThemes = addThemesFun,
        change_ggObject = change_ggObjectFun
      )
    )
    
  return(gg_themeApply)
}

• Create a self object inside gg_themeApply to store the main value (which is a ggplot object) that all methods are to work upon it.

• All methods are created within the capsule function body. Hence, they can see and call each other if necessary.

• All methods can access the value of self.

We usually called:

• Theme an instance generator, and its evaluated call (i.e. Theme(ggplot)) an instance.

• Instance generator is actually a counterpart of Class definition. Programmer usually names it with a starting CAPITAL letter, while its instance will start with a lower case letter. For example, Theme is class definition, while theme is one instance.

ggplot_fake <- "You got me."
theme_ggfake <- Theme(ggplot_fake)
theme_ggfake$.self
theme_ggfake$theme1$show()

10.4 Environment as a Vessel

We are going to have the instance mutable. It is wise to use environment as a vessel of instance rather than list

a <- list()
a$x <- 5
a$changeX=function(y) a$x <- y
a$changeX(3)
a$x

b <- new.env()
b$x <- 5
b$changeX <- function(y) b$x <- y
b$changeX(3)
b$x

rm(list=ls())
Theme <- function(ggObject){
  gg_themeApply <- new.env()
  
  gg_themeApply$.self <- ggObject
  
  showFun <- exportFun <- adoptFun <- 
    exportFun <- restoreFun <- addThemesFun <- function(){}
  change_ggObjectFun <- function(ggObjNew){}
  
  theme1 <- list(
    show = showFun,
    export = exportFun,
    adopt = adoptFun
  )
  
  rlang::env_bind(
    .env = gg_themeApply,
    
    theme1 = theme1,
    export = exportFun,
    restore= restoreFun,
    addThemes = addThemesFun,
    change_ggObject = change_ggObjectFun
  )
  
  return(gg_themeApply)
}

10.5 Helper functions

When an instance is created through calling instance generator, its creation environment is called caller environment.

Theme = function(ggObject){
  gg_themeApply <- new.env()
  
  gg_themeApply$.self <- ggObject
  
  # no showFun in execution environment
  exportFun <- adoptFun <- 
    exportFun <- restoreFun <- addThemesFun <- function(){}
  change_ggObjectFun <- function(ggObjNew){}
  
  theme1 <- list(
    show = showFun,
    export = exportFun,
    adopt = adoptFun
  )
  
  rlang::env_bind(
    .env = gg_themeApply,
    
    theme1 = theme1,
    export = exportFun,
    restore= restoreFun,
    addThemes = addThemesFun,
    change_ggObject = change_ggObjectFun
  )
  
  return(gg_themeApply)
}

ggplot_fake <- "You got me."
theme_ggfake <- Theme(ggplot_fake)

Error in Theme(ggplot_fake) : object ‘showFun’ not found

showFun <- function(){
  print(gg_themeApply$.self)
}

ggplot_fake <- "You got me."
theme_ggfake <- Theme(ggplot_fake)
theme_ggfake$theme1$show()

showFun is created in global environment. Therefore,

environment(theme_ggfake$theme1$show) # is global environment

10.5.1 Solution 1: instance as input

showFun <- function(){
  print(theme_ggfake$.self)
}

theme_ggfake <- Theme_sol1(ggplot_fake)
theme_ggfake$theme1$show()

# But
rm(theme_ggfake)
theme_ggfake2 <- Theme_sol1(ggplot_fake)
theme_ggfake2$theme1$show()

showFun_sol1 <- function(instance){
  print(instance$.self)
}

showFun <- showFun_sol1
# due to lazy evaluation, call Theme again will update showFun automatically
theme_ggfake2 <- Theme(ggplot_fake)
theme_ggfake2$theme1$show(instance=theme_ggfake2)

10.5.2 Solution 2: function generator

• When a function returns a function, it is a function generator.

• The returned function can take any generator’s input argument value as a fixed value. (Therefore, when the returned function is called, it will not re-evaluate itself–not lazy evaluation.)

Theme_sol2 = function(ggObject){
  gg_themeApply <- new.env()
  
  gg_themeApply$.self <- ggObject
  
  exportFun <- adoptFun <- 
    exportFun <- restoreFun <- addThemesFun <- function(){}
  change_ggObjectFun <- function(ggObjNew){}
  
  theme1 <- list(
    show = showFun_sol2(gg_themeApply),
    export = exportFun,
    adopt = adoptFun
  )
  
  rlang::env_bind(
    .env = gg_themeApply,
    
    theme1 = theme1,
    export = exportFun,
    restore= restoreFun,
    addThemes = addThemesFun,
    change_ggObject = change_ggObjectFun
  )
  
  return(gg_themeApply)
}

showFun_sol2 <- function(instance){
  return(
    function(){
      print(instance$.self)
    }
  )
}
showFun_sol2

instance <- 
  list(
    .self = "You got me."
  )
showFun_sol2(instance)
showFun1 <- showFun_sol2(instance)
showFun1()

instance <- 
  list(
    .self = "You DIDNOT get me."
  )
showFun1()

10.5.3 Template of Solution 2

rm(list=ls())
Theme <- function(ggObject){
  gg_themeApply <- new.env()
  
  gg_themeApply$.self <- ggObject
  
  exportFun <- adoptFun <- 
    exportFun <- restoreFun <- addThemesFun <- function(){}
  change_ggObjectFun <- function(ggObjNew){}
  
  theme1 <- list(
    show = showFun(gg_themeApply),
    export = exportFun,
    adopt = adoptFun
  )
  
  rlang::env_bind(
    .env = gg_themeApply,
    
    theme1 = theme1,
    export = exportFun,
    restore= restoreFun,
    addThemes = addThemesFun,
    change_ggObject = change_ggObjectFun
  )
  
  return(gg_themeApply)
}

# helpers -----------------------------------------------------------------
showFun <- function(instance){
  return(
    function(){
      print(instance$.self)
    }
  )
}

ggplot_fake <- "fake plot 1"
theme_ggfake <- Theme(ggplot_fake)
theme_ggfake$theme1$show()

Since you very likely to use the same function(instance){ return(function(){...})} for adopt, export, etc. methods. It is move efficient to code as:

rm(list=ls())
Theme <- function(ggObject){
  gg_themeApply <- new.env()
  
  gg_themeApply$.self <- ggObject
  
  exportFun <- adoptFun <- 
    exportFun <- restoreFun <- addThemesFun <- function(){}
  change_ggObjectFun <- function(ggObjNew){}
  
  theme1List <- list(
    show = theme_generateFuns(
              instance = gg_themeApply, 
              myFun = showFun,
              targetTheme = targetTheme1),
    export = exportFun,
    adopt = adoptFun
  )
  
  rlang::env_bind(
    .env = gg_themeApply,
    
    theme1 = theme1List,
    export = exportFun,
    restore= restoreFun,
    addThemes = addThemesFun,
    change_ggObject = change_ggObjectFun
  )
    
  return(gg_themeApply)
}

# helpers -----------------------------------------------------------------

theme_generateFuns <- function(instance, myFun, targetTheme){
  holderFunction <- function(){} # ensure the function environment of holderFunction can see instance
  formals(holderFunction) <- formals(myFun)
  body(holderFunction) <- body(myFun)
  return(
    holderFunction
  )
}

showFun <- function(){
  print(instance$.self)
}

Be aware that within Theme function body, there is:

...

  theme1List <- list(
    show = theme_generateFuns(
              instance = gg_themeApply, 
              myFun = showFun,
              targetTheme = theme1Target),
    export = exportFun,
    adopt = adoptFun
  )

...

The three VALUES are passed into theme_generateFuns

ggplot_fake <- "fake plot 1"
theme_ggfake <- Theme(ggplot_fake)
theme_ggfake$theme1$show()

ggplot_fake <- "fake plot 2"
theme_ggfake$theme1$show()
theme_ggfake <- Theme(ggplot_fake)
theme_ggfake$theme1$show()

10.6 Theme design

• 年度國內主要經濟指標

jsonlite::fromJSON("https://www.dropbox.com/s/48dath1cfsrckgm/A17000000J-030243-KjC.json?dl=1") -> stat_taiwan
library(dplyr)
library(ggplot2)
xfun::download_file("https://www.dropbox.com/s/cz32f4kwj117txx/Theme1.R?dl=1")
source("Theme1.R")

stat_taiwan %>%
  mutate(
    across(
      .fns=as.numeric
    )
  ) -> df_taiwanTheme
df_taiwanTheme

graph1_theme <- {
  df_taiwanTheme %>%
    ggplot() +
    geom_line(
      aes(
        x=年度, y=儲蓄率
      )
    )
}
graph1_theme

graph2_theme <- {
  df_taiwanTheme %>%
    ggplot() +
    geom_line(
      aes(
        x=年度, y=`消費者物價-年增率`
      )
    )
}
graph2_theme

10.6.1 economist_timeSeries

economist_timeSeriesThm <- theme_classic(
  ) +
  theme(
    axis.line.y = element_blank(),
    panel.grid.major.y = element_line(
      color="#d8d8d8"
    ),
    axis.ticks.y = element_blank(),
  )

graph2_theme + economist_timeSeriesThm +
  scale_y_continuous(
    expand = expansion(mult = 0, add = 0)
  )

y_touchDownThm <- scale_y_continuous(
      expand = expansion(mult = 0, add = 0)
    )

graph1_themeTry <- Theme1(graph1_theme)
graph1_themeTry$.self
graph1_themeTry$economist_timeSeries$show()
graph1_themeTry$economist_timeSeries$adopt()
graph1_themeTry$.self
graph1_themeTry$y_touchDown$show()
graph1_themeTry$y_touchDown$adopt()
graph1_themeTry$.self

10.7 Package

• Cheat sheet

10.7.1 In development stage

• Start project: Work in your package project.

• Load project: Use Build -> More -> Load All instead of library(mytheme).

• For functions to show up in help, insert Roxygen function explanations,

then devtools::document() or

• Specify packages dependency using usethis::use_package(...) for packages available in R CRAN; using usethis::use_github(...) for your own packages stored in github.

Try import only the function you need from a package using

lubridate::ymd_hms()

instead of all the functions from a package

library(lubridate)
lubridate::ymd_hms()

10.7.2 In distribution

• Upload to github, then remotes::install_github("username/packagename"); OR

• Build binary then give the binary file to others for installation. (Unfortunately, for Windows, you need to go for further steps to let it happen. Please google the right way. One possible solution is to use Win builder website.)