Waldeinsamkeit

Programar un logo

El caso es que me dí cuenta de que ese logo se podría formar de manera simple mediante una función matemática en R, y me he puesto a ello.

Vamos a usar solo R base y la función plot, también usaremos una librería para usar tipografía que es extrafont. Lo primero es poner el fondo negro y quitar los bordes de la gráfica con esto: par(bg=gray(0.05),oma=c(0.1,0.1,0.1,0.1),mar=c(0.1,0.1,0.1,0.1)).

Para generar la sierra creamos dos conjuntos de números aleatorios, unos con media mayor que los otros y los mezclamos al tresbolillo

library(extrafont)

## Registering fonts with R

#font_install("fontcm")
#font_import()
#loadfonts()
#fonts()  # para ver las fuentes instaladas

########################################
# Funcion para pintar logo de waldenskeit
########################################

# ponemos el fondo negro
par(bg=gray(0.05),oma=c(0.1,0.1,0.1,0.1),mar=c(0.1,0.1,0.1,0.1))

l_sierra<-function(texto){
    a<-as.integer(rnorm(5,15,4)) # num crestas
    b<-as.integer(rnorm(4,5,4)) # num valles
    b<-c(b,0)
    linea<-c(0, c(rbind(a,b)))
    # creamos la linea inversa para el reflejo
    l_inv<-c(0, c(-rbind(a,b)))
    # pintamos
    plot(linea, type="l",col=gray(0.95),axes=F,lwd=1,ylim=c(-20,20),xlim=c(0,12))
    # pintamos linea horizontal
    abline(h=0,col="grey")
    #pintamos reflejo
    lines(l_inv,col=gray(0.35))
    #Rellenamos el reflejo con poligono
    polygon(l_inv,col=gray(0.95), border=NA)
    #Escribimos un texto abajo
    text(8, -20, texto, col="white", family="Eras Medium ITC",cex = 2)
}

l_sierra("enRdados.net")

Después de probar un rato me fijé que, en realidad, el reflejo de la sierra que estaba haciendo no era correcto, pues en el cartel se pinta de manera opuesta creando una simetría extraña, pero que aporta complejidad no aparente.

Aquí está el resultado final (hecho una mañana de sábado.. pues hay que empezar el día programando), he incluido unos puntos que imitan estrellas…

#funcion que genera una linea quebrada
sierra<-function(n=5){
    a<-as.integer(rnorm(n,12,3))# crestas altas
    a<-c(a,as.integer(rnorm(n,18,2))) #crestas bajas
    a<-abs(sample(a,n))
    
    b<-as.integer(rnorm(n-1,4,2)) # valles
    b<-abs(c(b,0))
    linea<-c(0, c(rbind(a,b))) # mezcla al tresbolillo  
    return(linea)
}

# funcion que pinta el logo estilo Waldenskeit
pinta_logo<-function(n=5,text="enRdados.net"){
  # ponemos el fondo negro
    par(bg=gray(0.05),oma=c(0.1,0.1,0.1,0.1),mar=c(0.1,0.1,0.1,0.1))
    lin<-sierra(n)
    l_inv<- -rev(lin) # damos la vuelta al vector
    
    plot(lin, type="l",col=gray(0.95),axes=F,lwd=1,ylim=c(-20,20),xlim=c(0,n*2+2))
    # añado nebulosas
    xy<-data.frame(x=rnorm(500,n*2-1,2),y=rnorm(500,10,3))
    points(xy,col=gray(0.75),pch=".")
    xy<-data.frame(x=rnorm(400,3,2),y=rnorm(400,-8,2))
    points(xy,col=gray(0.75),pch=".")
    
    #linea horizonte
    abline(h=0,col="grey")
    #segments(1,0,11,0,col=gray(0.95))
    lines(l_inv,col=gray(0.35))
    #lines(l_inv, type= "h", col="blue")
    polygon(l_inv,col=gray(0.90), border=NA)
    polygon(lin,col=gray(0.05), border="white")
    # Texto
    text(2, -19, text,col=gray(0.85), family="Kalinga",cex = 1.2)
}

pinta_logo()

Coordilleras

Ya puestos en el lío, como tenemos una función para hacer una sierra, vamos seguir desarrollando el logotipo con la idea de obtener una serie de cadenas montañosas. Además hemos reciclado las funciones del artículo de generador de islas aleatorias, para aportar caos en las líneas y formar una cadena de montañas algo más realistas.

sierra_r<-function(np=5,al_max=2000,al_min=1400){
    a<-as.integer(rnorm(np*2,al_min,al_min/6))# crestas bajas
    a<-c(a,as.integer(rnorm(np,al_max,al_max/8))) #crestas altas
    a<-abs(sample(a,np))
    
    b<-as.integer(rnorm(np-1,al_min/3,al_min/7)) # valles
    b<-abs(c(b,0))
    linea<-c(0, c(rbind(a,b))) # mezcla al tresbolillo  
    return(linea)
}


coordillera<-function(n=5,ns=5,des_s=200){
  # n= num puntos por sierra/2
  # ns= num sierras
  # des_s= desplazamiento en veritical de las sierras
  sierras<-list()
  for(i in 1:ns){
    sierras[[i]]<-sierra_r(n=n)
    sierras[[i]]<-sierras[[i]]+des_s
    sierras[[i]][1]<-0
    sierras[[i]][length(sierras[[i]])]<-0
    
  }
  return(sierras)
}


pinta_coordillera2<-function(np=6,ns=8,des_s=800,coef=0.8,recursivo=3){
  par(bg=gray(0.05),oma=c(0.1,0.1,0.1,0.1),mar=c(0.1,0.1,0.1,0.1))
  a<-coordillera(n=np,ns=ns,des_s=des_s)
  
  factor<-length(a)
  #coef=0.8
  des<-coef/factor
  max<-max(sapply(a, max))

  covdf<-function(a,max=100){
    b<-data.frame(x=(1:length(a))*max,y=a)
    return(b)
  }
  
  a1<-lapply(a,covdf)  
  #print(dim(a1[[1]][1]))
  
    plot(a1[[1]], type="l",col=NA,axes=F,lwd=1,ylim=c(1,max*1),xlim=c(150,(dim(a1[[1]])[1]-1)*100))
    for(i in 1:factor){
        mont<-a1[[i]]
        mont[,2]<-mont[,2]*(1-des*i)
        mont1<-div_pol_n(mont,recursivo)# añade caos
        mont1<-rbind(mont1,c(mont1[nrow(mont1),1]+100,0))
        polygon(mont1,col=gray(1-des*(i-1)), border=NA)
  #print(mont1)
          }
  text(350,max/1.08 , "Coordilleras   enRdados.net",adj=c(0,0),col=gray(0.85), family="Kalinga",cex = 1.2)
  
}

# pintamos algunos ejemplo
pinta_coordillera2(coef=0.9)

pinta_coordillera2(n=15,ns=3,coef=0.8)

# recursivo aumenta el caos
pinta_coordillera2(n=5,ns=6,coef=0.97,recursivo=0)

pinta_coordillera2(n=5,ns=6,coef=0.97,recursivo=6)