Feliz Navidad 2016 (en R)

Quisiera desearle a mis lectores una feliz Navidad 2016 ... al estilo R. Vacílense mi arbolito navideño 3d creado usando el paquete plot3D de R:

Aunque esto sería aún otra decoración navideña hecha en R, lo original de esta es que el árbol se muestra en perspectiva tridimensional. Hace un tiempo, yo mismo elaboré un código en R para visualizar un árbol navideño en dos dimensiones (ver esta entrada), el cual a su vez era basado en el código que apareció en el blog Wiekvoet. Sin embargo, esta vez el reto era crear un modelo tridimensional del árbol visualizado en perspectiva con una animación mostrando el árbol en rotación.

Feliz Navidad en R

¡Feliz navidad 2013!

Por cierto, el árbol de navidad de arriba fue generado mediante el siguiente código en R:

parte <- list(x0=0,y0=0,x1=0,y1=1,
    rama1=NULL,rama2=NULL,extension=NULL,
    lwd=1,nivel=0,col="darkgreen")

par(mfrow=c(1,1),mar=c(5, 4, 4, 2) + 0.1)
segplot <- function(arbol) {
  if (is.null(arbol)) return()
  segments(arbol$\$$x0,arbol$\$$y0,arbol$\$$x1,arbol$\$$y1,
      col=arbol$\$$col,
      lwd=arbol$\$$lwd)
  segplot(arbol$\$$rama1)
  segplot(arbol$\$$rama2)
  segplot(arbol$\$$extension)
}

crear_adornos <- function(arbol) {
  if (is.null(arbol)) return()
  padorno <- 0.002*(arbol$\$$x1)^2*abs(arbol$\$$y1)^2.5
  adorno <- sample(c(T,F),size=1,prob=c(padorno,1-padorno))
  cadorno <- sample(c("darkred","darkgoldenrod4"),size=1,prob=c(0.6,0.4))
  if (adorno)
    adornos <<- rbind(adornos,data.frame(x=arbol$\$$x1,y=arbol$\$$y1,color=cadorno))
  crear_adornos(arbol$\$$rama1)
  crear_adornos(arbol$\$$rama2)
  crear_adornos(arbol$\$$extension)
}

crear_luces1 <- function(arbol) {
  if (is.null(arbol)) return()
  padorno <- 0.003*(arbol$\$$x1)^2*abs(arbol$\$$y1)^2
  adorno <- sample(c(T,F),size=1,prob=c(padorno,1-padorno))
  if (adorno)
luces1 <<- rbind(luces1,data.frame(x=arbol$\$$x1,y=arbol$\$$y1))
  crear_luces1(arbol$\$$rama1)
  crear_luces1(arbol$\$$rama2)
  crear_luces1(arbol$\$$extension)
}

crear_luces2 <- function(arbol) {
  if (is.null(arbol)) return()
  padorno <- 0.003*(arbol$\$$x1)^2*abs(arbol$\$$y1)^2
  adorno <- sample(c(T,F),size=1,prob=c(padorno,1-padorno))
  if (adorno)
luces2 <<- rbind(luces2,data.frame(x=arbol$\$$x1,y=arbol$\$$y1))
  crear_luces2(arbol$\$$rama1)
  crear_luces2(arbol$\$$rama2)
  crear_luces2(arbol$\$$extension)
}

crece <- function(arbol) {
  if (is.null(arbol) ) return(NULL)

  arbol$\$$lwd=arbol$\$$lwd*1.2

  if (arbol$\$$lwd>2.5) arbol$\$$col <- "brown"
  if (is.null(arbol$\$$extension)) {
    arbol$\$$extension <- list(
        x0=arbol$\$$x1,
        y0=arbol$\$$y1,
        x1=rnorm(1,1,.03)*(2*arbol$\$$x1-arbol$\$$x0),
        y1=(rnorm(1,.98,.02)+.02*(arbol$\$$x1==arbol$\$$x0))*(2*arbol$\$$y1-arbol$\$$y0),
        rama1=NULL,
        rama2=NULL,
        extension=NULL,
        lwd=1,
        nivel=arbol$\$$nivel-0.25,
        col=arbol$\$$col
    )
    largo=sqrt((arbol$\$$x1-arbol$\$$x0)^2 + (arbol$\$$y1-arbol$\$$y0)^2)
    angle <- asin((arbol$\$$x1-arbol$\$$x0)/largo)
    rama <- list(
        x0=(arbol$\$$x1+arbol$\$$x0)/2,
        y0=(arbol$\$$y1+arbol$\$$y0)/2,
        rama1=NULL,
        rama2=NULL,
        extension=NULL,
        lwd=1,
        nivel=arbol$\$$nivel-0.25,
        col=arbol$\$$col
    )
    shift <- rnorm(2,.5,.1)
    rama$\$$x0 <- shift[1]*arbol$\$$x1+(1-shift[1])*arbol$\$$x0
    rama$\$$y0 <- shift[1]*arbol$\$$y1+(1-shift[1])*arbol$\$$y0
    largo=largo*rnorm(1,.5,.05)
    co <- runif(1,.35,.45)
    rama$\$$x1 <- rama$\$$x0+sin(angle+co)*largo
    rama$\$$y1 <- rama$\$$y0+cos(angle+co)*largo
    arbol$\$$rama1 <- rama
    rama$\$$x0 <- shift[2]*arbol$\$$x1+(1-shift[2])*arbol$\$$x0
    rama$\$$y0 <- shift[2]*arbol$\$$y1+(1-shift[2])*arbol$\$$y0
    co <- runif(1,.35,.45)
    rama$\$$x1 <- rama$\$$x0+sin(angle-co)*largo
    rama$\$$y1 <- rama$\$$y0+cos(angle-co)*largo
    arbol$\$$rama2 <- rama 
  } else {
    arbol$\$$rama1 <- crece(arbol$\$$rama1)
    arbol$\$$rama2 <- crece(arbol$\$$rama2)
    arbol$\$$extension <- crece(arbol$\$$extension)
  }
  arbol$\$$nivel <- arbol$\$$nivel+1
  if (arbol$\$$nivel>6)  arbol$\$$col <- "brown"

  arbol
}
arbol <- parte
for (i in 1:9) arbol <- crece(arbol)
png("arbol%02d.png")
par(mar=c(0,0,0,0))
plot(x=c(-3,3),y=c(0,9),type="n",axes=FALSE,xlab="",ylab="")
pd<-par("usr")
rect(pd[1],pd[3],pd[2],pd[4],col="black")
adornos <- data.frame(x=numeric(0),y=numeric(0),color=character(0))
crear_adornos(arbol)
luces1 <- data.frame(x=numeric(0),y=numeric(0))
crear_luces1(arbol)
luces2 <- data.frame(x=numeric(0),y=numeric(0))
crear_luces2(arbol)
#dibuja el arbol sin las luces
segplot(arbol)
with(adornos,{points(x=x,y=y,pch=19,cex=1.5,col=as.character(color))})
#dibuja el arbol con las luces1
plot(x=c(-3,3),y=c(0,9),type="n",axes=FALSE,xlab="",ylab="")
pd<-par("usr")
rect(pd[1],pd[3],pd[2],pd[4],col="black")
segplot(arbol)
with(adornos,{points(x=x,y=y,pch=19,cex=1.5,col=as.character(color))})
with(luces1,{points(x=x,y=y,pch="+",cex=0.8,col="white")})
#dibuja el arbol con las luces2
plot(x=c(-3,3),y=c(0,9),type="n",axes=FALSE,xlab="",ylab="")
pd<-par("usr")
rect(pd[1],pd[3],pd[2],pd[4],col="black")
segplot(arbol)
with(adornos,{points(x=x,y=y,pch=19,cex=1.5,col=as.character(color))})
with(luces2,{points(x=x,y=y,pch="+",cex=0.8,col="yellow")})
#dibuja el arbol con todas las luces
plot(x=c(-3,3),y=c(0,9),type="n",axes=FALSE,xlab="",ylab="")
pd<-par("usr")
rect(pd[1],pd[3],pd[2],pd[4],col="black")
segplot(arbol)
with(adornos,{points(x=x,y=y,pch=19,cex=1.5,col=as.character(color))})
with(luces1,{points(x=x,y=y,pch="+",cex=0.8,col="white")})
with(luces2,{points(x=x,y=y,pch="+",cex=0.8,col="yellow")})
#fin
graphics.off()

El código no es enteramente mio. La rutina para crear el arbol fue tomada de http://www.r-bloggers.com/merry-christmas-2/ . El código para crear las lucecitas y los adornos si es mio.

Si te gustó o te pareció útil este contenido, compártelo en las redes sociales y dale tu voto positivo en el botón "me gusta" de G+, para que otros puedan encontrar el contenido también.