Tutorial - Nadal 2021

Toni Rodon

Universitat Pompeu Fabra
www.tonirodon.cat

En molts països és comú enviar o donar un targetó per a celebrar un esdeveniment. Aniversaris, comiats, naixements… i, lògicament, targetons de nadal! Si, enlloc de comprar la postal de nadal, voleu fer-la amb R (quelcom que de ben segur a molts de vosaltres us ha passat pel cap), aquí teniu un breu tutorial que us guia en com plantejar-ho.

El tutorial genera quatre figures i una postal. És qüestió de cada usuari decidir quina imatge vol triar per enviar a amics, coneguts, familiars i saludats.

Arbre de nadal

Començarem fent un arbre de nadal. Aquesta part està basada en el codi que trobareu aquí.

# L'espai on dibuixarem l'arbre
plot(1:10,1:10,xlim=c(-5,5),ylim=c(0,10),type="n",xlab="",ylab="",xaxt="n",yaxt="n")
# Les banques i fulles
rect(-1,0,1,2,col="tan3",border="tan4",lwd=3)
polygon(c(-5,0,5),c(2,4,2),col="palegreen3",border="palegreen4",lwd=3)
polygon(c(-4,0,4),c(3.5,5.5,3.5),col="palegreen4",border="palegreen3",lwd=3)
polygon(c(-3,0,3),c(5,6.5,5),col="palegreen3",border="palegreen4",lwd=3)
polygon(c(-2,0,2),c(6.25,7.5,6.25),col="palegreen4",border="palegreen3",lwd=3)

#Afegir decoracions
points(x=runif(4,-5,5),y=rep(2,4),col=sample(c("blue","red"),size=4,replace=T),cex=3,pch=19)
points(x=runif(4,-4,4),y=rep(3.5,4),col=sample(c("blue","red"),size=4,replace=T),cex=3,pch=19)
points(x=runif(4,-3,3),y=rep(5,4),col=sample(c("blue","red"),size=4,replace=T),cex=3,pch=19)
points(x=runif(4,-2,2),y=rep(6.25,4),col=sample(c("blue","red"),size=4,replace=T),cex=3,pch=19)
points(0,7.5,pch=8,cex=5,col="gold",lwd=3)

#Afegir alguns regals i posar el títol
xPres = runif(10,-4.5,4.5)
xWidth = runif(10,0.1,0.5)
xHeight=runif(10,0,1)
for(i in 1:10){
  rect(xPres[i]-xWidth[i],0,xPres[i]+xWidth[i],xHeight[i],col=sample(c("blue","red"),size=1))
  rect(xPres[i]-0.2*xWidth[i],0,xPres[i]+0.2*xWidth[i],xHeight[i],col=sample(c("gold","grey87"),size=1))
}
mytitle = "Bon nadal"
mysubtitle = "I bon any nou!"
mtext(side=3, line=2,  cex=1.8, mytitle)
mtext(side=3, line=1, cex=1.4, mysubtitle)

my_plot <- recordPlot()        # Ho gravem en un objecte per exportar

Un cop fet, l’exportarem en format png.

png("arbre_nadal.png")
my_plot
dev.off()
## quartz_off_screen 
##                 2

Arbre de nadal amb ggplot

Si sou fans de ggplot, podeu aprofitar les seves potencialitats per fer un arbre de nadal (aquest i el següent arbre estan inspirats en això d’aquí).

library("ggplot2")

#Generem punts aleatoris

x1 <- runif(100000, -1, 1)
y1 <- runif(100000, -1, 1.6)

# equació pel cor de l'arbre
which1 <- x1^2+(y1-(x1^2)^(1/4))^2<=1
x1 <- x1[which1]
y1 <- y1[which1]

# segon nivell
x2 <- 1.5*x1 -1
y2 <- 1.5*y1 

# tercer nivell
x3 <- 2*x1 -2
y3 <- 2*y1


dt <- data.frame(c(x1,x2,x3),c(y1,y2,y3))
colnames(dt) <- c("x", "y")
dt$y <- dt$y - 0.25
dt <- dt[dt$x>-2 & dt$x<1 & dt$y>-2.25 & dt$y<0,]
dt <- data.frame(c(dt$x,dt$x), c(dt$y, -dt$y))
colnames(dt) <- c("x", "y")

#soca

p1 <- runif(1000, -0.5, 0.5)
p2 <- runif(1000, -2.5, -2)

soca <- data.frame(p1,p2)

colors <- c('green', 'green2', 'green4', 'darkgreen')
colors2 <- rep(colors,length.out=dim(dt)[1])

bolesnadal <- data.frame(c(-1.8, -1.7, -1.1, -0.6, 0, 0.3), c(-1,0.7,-0.9,0.1,-0.3,0.3))
colnames(bolesnadal) <- c("x", "y")

cadena <- data.frame(data.frame(x1 = -0.5, x2 = 1, y1 = 21.0, y2 = 15.0))

estrella <- data.frame(c(0), c(0.7))
colnames(estrella)<- c("x", "y")

ggplot(data=NULL) + geom_point(data=dt, aes(x = y, y=x), col=colors2) + 
  geom_point(data=bolesnadal, aes(x=y, y=x), size=10, col='blue') +
  geom_point (data=soca, aes(x=p1, y=p2), col='brown') + 
  geom_point(data=estrella, aes(x=x, y=y),size=10,shape=24, col="yellow", fill='yellow') +
  geom_point(data=estrella, aes(x=x ,y=y),size=10,shape=25, col="yellow", fill='yellow') +
  geom_curve(aes(x=-1,xend=1.2,y=-0.65,yend=-1.2), col='red',size=2, curvature = 0.3) + 
  geom_curve(aes(x=1.2, y=-1.2, xend=-1.2, yend=-1.5), size=2, col="red", curvature = -0.3) +
  geom_curve(aes(x=-1,xend=0.8,y=-0.65,yend=-0.5), col='red',size=2, curvature = 0.3) +
  geom_curve(aes(x=-0.8,xend=0.8,y=-0.2,yend=-0.5), col='red',size=2, curvature = 0.2) +
  geom_curve(aes(x=-0.8,xend=0.9,y=-0.2,yend=0.15), col='red',size=2, curvature = 0.3) +
  geom_curve(aes(x=-0.65,xend=0.9,y=0.35,yend=0.15), col='red',size=2, curvature = 0.3) +
  theme(axis.line=element_blank(),axis.text.x=element_blank(),
        axis.text.y=element_blank(),axis.ticks=element_blank(),
        axis.title.x=element_blank(),
        axis.title.y=element_blank(),legend.position="none",
        panel.background=element_blank(),panel.border=element_blank(),panel.grid.major=element_blank(),
        panel.grid.minor=element_blank(),plot.background=element_blank()) +
  ggtitle("Bon nadal!")

ggsave("arbreggplot.png") #El gravem
## Saving 6 x 6 in image

Arbre de nadal animat

Potser sou de crear felicitacions de nadal animades i enviar-los en format gifs. També ho podeu fer! El codi que teniu a continuació triga una mica. Paciència.

library("ggplot2")
library("gganimate")
library("svglite")
library("dplyr")
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
HEIGTH <- 100

gen_data_v <- function(n_points, n_states) {
  
  
  id <- rep(1:n_points, each = n_states)
  time <- rep(1:n_states, times = n_points)
  
  velocity <- abs(rnorm(n_points, 1, 0.5))
  
  y1 <- runif(n_points, 0, HEIGTH)
  
  y <- as.vector(crossprod(t(0:(n_states-1)), -velocity) + 
                   matrix(rep(y1, n_states), byrow = TRUE, n_states, n_points))
  y <- y %% HEIGTH
  
  x1 <- matrix(runif(n_points, 0, HEIGTH), 1, n_points)
  for(i in 2:n_states) {
    x1 <- rbind(x1, x1[i-1,] + rnorm(n_points, 0, 0.4))
  }
  
  x <- (as.vector(x1) %% HEIGTH) - 50
  
  data.frame(id, x, y, time)
} 

dat <- gen_data_v(10000, 100)

x <- ggplot(data = dat, aes(x = x, y = y, color = id)) +
  geom_point(data = dat %>% filter(y < HEIGTH - 3*x & y < HEIGTH + 3 * x), size = 2) +
  geom_point(x=0, y=100, color = "#ffc20c", shape = 8, size = 10) +
  scale_color_gradient(low = "#addd8e", high = "#11673A", guide = FALSE) +
  theme_void() +
  coord_fixed() +
  transition_time(time) +
  ease_aes('linear') 

y <- animate(x, renderer = magick_renderer(),width = 600, height = 1000)
y

save_animation(y, "arbre_animat.gif") #El gravem

Caganer

Finalment, farem un dels símbols del Nadal català per excel·lència: el caganer! El codi està basat (i lleugerament adaptat) de la llibreria christmas, que podeu trobar aquí.

És un codi molt llarg, però està anotat perquè els diferents passos s’entenguin.

#Preparem la finestra
newwindow <- function() {
  sc <- switch(Sys.info()[['sysname']],
               Windows = "windows",
               Linux  = "x11",
               Darwin = "quartz")
  eval(parse(text = paste(sc, "(width = 10, height = 7)", sep = "")))
}
#Funció per dibuixar el caganer
xmas2021caganer <- function(seed = NULL) {
  # "seed":
  if(!is.null(seed) & (is.na(seed) || !is(seed, "numeric")))
    stop("'seed' must be numeric or NULL")
  if (!is.null(seed)) set.seed(seed)

  t <- 0.8

  # Fons:
  newwindow()
  Sys.sleep(0.2 * t)
  u <- runif(2000, -6, 9)
  v <- runif(2000, -4, 10)
  plot(u, v, type = "n", xlim = c(-6, 9), ylim = c(-4, 10), asp = 1, axes = F, xlab = "", ylab = "")
  title(main = "", col.main = "forestgreen", cex.main = 1.5)
  polygon(c(-6, -6, 9, 9), c(-4, 1, 1, -4), border = NA, col = "azure2")
  polygon(c(-6, -6, 9, 9), c(1, 10, 10, 1), border = NA, col = "darkblue")
  lines(u[1:500], v[1:500], type = "p", pch = 8, lwd = 1, cex = 0.1, col = rainbow(180)[90])
  x <- seq(-6, 9, by = 0.01)
  lines(x, rnorm(length(x), 1, 0.05), type = "l", lwd = 3, col = "blue4")
  # El cos:
  Sys.sleep(t)
  a <- seq(0, 2 * pi, 0.05)
  x0 <-       cos(a)
  y0 <- 0.5 * sin(a)
  theta <- 75 * pi / 180
  x <- -0.3 + x0 * cos(theta) - y0 * sin(theta)
  y <-  0.5 + x0 * sin(theta) + y0 * cos(theta)
  polygon(x, y, border = NA, col = "white")
  # El cap:
  Sys.sleep(t)
  x <- 0.3 + 0.5 * cos(a)
  y <- 1.6 + 0.5 * sin(a)
  polygon(x, y, border = NA, col = "wheat3")
  # Nas:
  Sys.sleep(t)
  x <- 0.7 + 0.1 * cos(a)
  y <- 1.3 + 0.1 * sin(a)
  polygon(x, y, border = NA, col = "wheat3")
  # Ulls:
  Sys.sleep(t)
  x <- 0.6 + 0.05 * cos(a)
  y <- 1.5 + 0.05 * sin(a)
  polygon(x, y, border = NA, col = "black")
  x <- 0.7 + 0.05 * cos(a)
  y <- 1.5 + 0.05 * sin(a)
  polygon(x, y, border = NA, col = "black")
  # Bufanda:
  Sys.sleep(t)
  d <- seq(0, pi / 2)
  x <-       0.3 * cos(d)
  y <- 1.3 + 0.3 * sin(d)
  lines(x, y, lwd = 6)
  # Barretina:
  Sys.sleep(t)
  c <- seq(pi / 4, 5 * pi / 4, 0.05)
  x <- 0.10 + 0.77 * cos(c)
  y <- 1.65 + 0.52 * sin(c)
  polygon(x, y, border = NA, col = "red")
  polygon(c(-0.15, 0.75, 0.60, -0.25), c( 1.40, 1.90, 2.05,  1.50), border = NA, col = "black")
  # Cames:
  Sys.sleep(t)
  x0 <- 0.9 * cos(a)
  y0 <- 0.4 * sin(a)
  theta <- 30 * pi / 180
  x <- x0 * cos(theta) - y0 * sin(theta)
  y <- x0 * sin(theta) + y0 * cos(theta)
  polygon(x, y, col = "black")
  # Cul:
  Sys.sleep(t)
  x <- -0.55 + 0.35 * cos(a)
  y <- -0.34 + 0.35 * sin(a)
  polygon(x, y, border = NA, col = "wheat3")
  # Cames:
  Sys.sleep(t)
  x0 <-       cos(a)
  y0 <- 0.3 * sin(a)
  theta <- 70 * pi / 180
  x <-  0.42 + x0 * cos(theta) - y0 * sin(theta)
  y <- -0.45 + x0 * sin(theta) + y0 * cos(theta)
  polygon(x, y, col = "black")
  # ...més cames:
  Sys.sleep(t)
  b <- seq(0.98 * pi, 1.37 * pi, 0.05)
  x <- 0.65 * cos(b)
  y <- 0.65 * sin(b)
  polygon(x, y, border = NA, col = "black")
  # Peus:
  Sys.sleep(t)
  x <-  0.4 + 0.50 * cos(a)
  y <- -1.3 + 0.15 * sin(a)
  polygon(x, y, border = NA, col = "tan4")
  # Cinturó:
  Sys.sleep(t)
  polygon(c(-0.85, 0.25, 0.25, -0.85), c(-0.20, 0.50, 0.70,  0.15), border = "NA", col = "red")
  # ...Més cames:
  Sys.sleep(t)
  polygon(c(-0.31, 0.27, 0.25, -0.60), c(-0.61, 0.22, 0.50, -0.05), border = "NA", col = "black")
  # Braços:
  Sys.sleep(t)
  polygon(c(0.10, -0.25, -0.6, -0.3), c(0.25,  0.10,  0.5,  0.9), border = "NA", col = "white")
  polygon(c(0, -0.05, -0.30, 0.10), c(0, -0.10,  0.15, 0.28), border = "NA", col = "white")
  x <- 0.50 + 0.2 * cos(a)
  y <- 0.08 + 0.2 * sin(a)
  Sys.sleep(t)
  polygon(x, y, border = NA, col = "wheat3")
  polygon(c(-0.05, 0.08, 0.40,  0.40), c(-0.10, 0.28, 0.28, -0.10), border = "NA", col = "white")
  # Ca...:
  Sys.sleep(t)
  x <- -0.5 + 0.30 * cos(a)
  y <- -1.3 + 0.15 * sin(a)
  polygon(x, y, border = NA, col = "darkorange4")
  # ...ga...:
  Sys.sleep(t)
  x <- -0.50 + 0.2 * cos(a)
  y <- -1.15 + 0.1 * sin(a)
  polygon(x, y, border = NA, col = "darkorange4")
  # ...rada:
  Sys.sleep(t)
  x0 <- 0.13 * cos(a)
  y0 <- 0.07 * sin(a)
  theta <- 70
  x <- -0.5 + x0 * cos(theta * pi / 180) - y0 * sin(theta * pi / 180)
  y <- -1.0 + x0 * sin(theta * pi / 180) + y0 * cos(theta * pi / 180)
  polygon(x, y, border = NA, col = "darkorange4")
  # Tronc:
  Sys.sleep(t)
  x <- c(-2.4, -1.6, -1.6, -2.4) + rnorm(4, 0, 0.02)
  y <- c( 2.5,  2.5, -1.2, -1.2) + rnorm(4, 0, 0.02)
  polygon(x, y, border = NA, col = "brown")
  x <- runif(9, -2.3, -1.7)
  y <- runif(9, -0.5,  2.2)
  lines(x, y, type = "p", pch = "|", cex = 1.4, col = "orangered4")
  x <- seq(-2.4, -1.6, by = 0.01)
  lines(x, rnorm(length(x), -1.2, 0.05), col = "azure2")
  Sys.sleep(t)
  # Arbre 1:
  x <- c(-5.0, 1.0, -2)
  y <- c( 2.5, 2.5,  6)
  polygon(x, y, border = NA, col = "forestgreen")
  t <- seq(0, 1, by = 0.01)
  x <- -5 + 6 * t
  y <-  6 - 7 * abs(t - 0.5)
  y <- y + rnorm(length(y), 0, 0.05)
  lines(x, y, col = "forestgreen", lwd = 6)
  lines(x, rnorm(length(x), 2.7, 0.1), col = "white", lwd = 15)
  # Arbre 2:
  Sys.sleep(t)
  x <- c(-4.0, 0.0, -2)
  y <- c( 4.5, 4.5,  7)
  polygon(x, y, border = NA, col = "forestgreen")
  x <- -4 + 4 * t
  y <-  7 - 5 * abs(t - 0.5)
  y <- y + rnorm(length(y), 0, 0.05)
  lines(x, y, col = "forestgreen", lwd = 6)
  lines(x, rnorm(length(x), 4.7, 0.1), col = "white", lwd = 15)
  # Arbre 3:
  Sys.sleep(t)
  x <- c(-3.5, -0.5, -2)
  y <- c( 6.0,  6.0,  8)
  polygon(x, y, border = NA, col = "forestgreen")
  x <- -3.5 + 3 * t
  y <-  8.0 - 4 * abs(t - 0.5)
  y <- y + rnorm(length(y), 0, 0.05)
  lines(x, y, col = "forestgreen", lwd = 6)
  lines(x, rnorm(length(x), 6.2, 0.1), col = "white", lwd = 15)
  # Text:
  Sys.sleep(t)
  x <- c(3.0, 4.0, 4.8, 5.4, 6.1, 7.0, 3.9, 5,5.9,4.4,5.3,6,6.5,7)
  y <- c(8.0, 7.6, 8.0, 7.6, 7.7, 7.8, 5.7,6,5.4,4,4.1,3.2,3.7,4.2)
  ms <- c("B", "o", "n", "A", "n", "y", "N","o","u", "2", "0", "2", "2", "!")
  col.text <- c(rep("red", 6), rep("forestgreen", 3), rep("red", 5))
  mida <- c(rep(4, 10), rep(5, 3), 4, 1)
  for (i in 1:15) text(x[i], y[i], ms[i], col = col.text[i], cex = mida[i], font = 1)
  # More snow:
  Sys.sleep(t)
  lines(u[501:2000], v[501:2000], type = "p", pch = 8, lwd = 1, cex = 0.05, col = "white")
}

Un cop el tenim fet, l’exportem en format png.

xmas2021caganer()
quartz.save("caganer.png", type="png")

## quartz_off_screen 
##                 2

Targeta de nadal

Per tal de fer la targeta, el més fàcil és fer-ho en un nou document a banda. A RStudio obriu-hi un document d’R markdown. En l’apartat del yaml, afegiu-hi el codi que veieu a sota. De moment no hi ha cap llibreria que dissenyi postals. Tanmateix, partirem de la llibreria pagedown, la qual té una plantilla per targetes de professionals. La podeu veure aquí. L’adaptarem al nostre cas. L’exemple següent és amb el caganer, però lògicament podeu fer servir qualsevol de les imatges que hem creat. Un petit avís: convé tenir el Google Chrome obert perquè R markdown converteix la felicitació, originalment en format html, en pdf utilitzant aquest navegador.

---
name: Toni Rodon
url: www.tonirodon.cat
logo: "caganer.png"
googlefonts: ["Roboto Condensed", "Raleway"]
color: white
output: pagedown::business_card
cardwidth: 5in 
knit: pagedown::chrome_print
---

Si la voleu adaptar, podeu retocar el CSS de la forma següent:

{css}
.logo {
  display: block;
  height: 90%;
  padding: .3in 0 0;
  float: right;
}
.name {
  margin-top: .1in;
}

Si us ha sortit correctament, hauríeu de veure un targetó semblant al de sota.

Bon nadal a tothom!