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()
Blog (castellano) 
Blog (English) 
Académico UNA
Sitios UNA
Lenguaje R