Arte con R
R es realmente muy flexible a la hora de generar figuras de toda índole.
Por ejemplo, podemos dibujar un tablero de ajedrez
n <- 9
x <- seq(0, 560, by=70)
y <- seq(0, 560, by=70)
z <- t(matrix(c(rep(c(0,1), n^2/2),0), nrow=n))
image(x[-n], y[-n], z[-n,-n], col=c("black", "white"),
asp=1, axes=FALSE, xlab="", ylab="") 
o una obra de arte1
x <- c(0, 70, 140, 208, 268, 324, 370, 404, 430,
450, 468, 482, 496, 506, 516, 523, 528, 533,
536, 542, 549, 558, 568, 581, 595, 613, 633,
659, 688, 722, 764, 810)
y <- seq(from=0, to=840, by=70)
m <- length(y)
n <- length(x)
z <- t(matrix(rep(c(0,1), m*n/2), nrow=m))
image(x[-n], y[-m], z[-n,-m], col=c("black", "white"),
axes=FALSE, xlab="", ylab="")
En la misma línea, podemos crear algunos gráficos engañosos conocidos:
- ¿Son paralelas las líneas horizontales?
library(grid)
library(plyr)
grid.newpage()
n=10
m=4
coord <- expand.grid(x = seq(0, 1, 1/n),
y = seq(0, 1, 1/m))
grid.rect(coord$x, coord$y, 1/n/2, 1/m/2,
gp = gpar(fill = "black", col = NA))
grid.rect(coord$x + 1/n/4, coord$y + 1/m/2, 1/n/2, 1/m/2,
gp = gpar(fill = "black", col = NA))
linea <- expand.grid(x = 0:1, y = seq(0, 1, 1/(2*m)) - 1/(2*m)/2)
grid.polyline(linea$x, linea$y, id = gl(nrow(linea)/2, 2),
gp = gpar(col = "grey50", lwd = 1))
grid.newpage()
nx <- 6; ny <- 6
an <- c(1, -1, 1, 1, -1, 1, -1, -1, 1, -1, 1, 1)
rs <- expand.grid(x = seq(0, 1, 1/nx/2), y = seq(0, 1, 1/ny/2))
grid.rect(rs$x, rs$y, 1/nx/2, 1/ny/2, gp = gpar(col = NA, fill = c("black", "white")))
rs <- expand.grid(x = seq(1/nx/2, 1, 1/nx/2) - 1/nx/4, y = seq(1/ny/2, 1, 1/ny/2) - 1/ny/4)
rs$an <- c(an, -an)
l_ply(1:nrow(rs), function(i) {
pushViewport(viewport(rs$x[i], rs$y[i], 1/30, 1/30, angle = rs$an[i]*45))
grid.rect(c(1,3,1,3)/4, c(3,3,1,1)/4, 1/2, 1/2, gp = gpar(col = NA, fill = gray(c(0,1,1,0))))
popViewport()
})
- ¿Hay puntitos en los cruces de las líneas blancas?
grid.newpage()
n <- 6; lwd <- 10
grid.rect(0.5, 0.5, 1, 1,
gp = gpar(fill = "black"))
coord <- expand.grid(x = 0:1,
y = seq(0, 1, 1/n/2) - 1/n/2/2)
grid.polyline(coord$x, coord$y, id = gl(nrow(coord)/2, 2),
gp = gpar(col = "white", lwd = lwd))
grid.polyline(coord$y, coord$x, id = gl(nrow(coord)/2, 2),
gp = gpar(col = "white", lwd = lwd))
grid.newpage()
n <- 6; lwd <- 10; r <- 1/100
grid.rect(0.5, 0.5, 1, 1,
gp = gpar(fill = "black"))
cx <- expand.grid(x = 0:1, y = seq(0, 1, 1/n/2) - 1/n/2/2)
grid.polyline(cx$x, cx$y, id = gl(nrow(cx)/2, 2),
gp = gpar(col = "grey80", lwd = lwd))
cy <- expand.grid(y = 0:1, x = seq(0, 1, 1/n/2) - 1/n/2/2)
grid.polyline(cy$x, cy$y, id = gl(nrow(cy)/2, 2),
gp = gpar(col = "grey80", lwd = lwd))
c <- expand.grid(x = seq(0, 1, 1/n/2) - 1/n/2/2,
y = seq(0, 1, 1/n/2) - 1/n/2/2)
grid.circle(c$x, c$y, r= r, gp = gpar(col = NA, fill = "white"))
- ¿Se mueve la imagen?
nt <- 41; nr <- 15; br <- 0.8
col1 <- c("black", "white")
col2 <- c("aquamarine4", "gold2")
f <- function(x0, y0) {
r <- embed(br^(0:nr), 2)
t <- embed(seq(0, 2*pi, length=nt), 2)
i <- as.matrix(expand.grid(1:nrow(r), 1:nrow(t)))
ci <- 1 + (i[,2]%%2 + i[,1]%%2) %% 2
p <- t(apply(i, 1, function(x) c(r[x[1], ], t[x[2], ])))
x <- c(p[,1]*cos(p[,3]), p[,1]*cos(p[,4]), p[,2]*cos(p[,4]), p[,2]*cos(p[,3]))
y <- c(p[,1]*sin(p[,3]), p[,1]*sin(p[,4]), p[,2]*sin(p[,4]), p[,2]*sin(p[,3]))
grid.polygon(x0+x/2, y0+y/2, id = rep.int(1:nrow(p), 4),
gp = gpar(fill = col1[ci], col=NA), default.units="native")
p <- expand.grid(1:nrow(r), sign((abs(x0-y0)==1)-0.5)*seq(0, 2*pi, length=41)[-1])
p <- cbind(p[,2], rowMeans(r)[p[,1]], (r[,2]-r[,1])[p[,1]]/2)
t <- seq(0, 2*pi, length=20)[-1]
x <- c(apply(p, 1, function(a) a[2]*cos(a[1])+a[3]*(cos(a[1])*cos(t)-0.5*sin(a[1])*sin(t))))
y <- c(apply(p, 1, function(a) a[2]*sin(a[1])+a[3]*(sin(a[1])*cos(t)+0.5*cos(a[1])*sin(t))))
col <- if(abs(x0-y0)==1) {col2} else {rev(col2)}
grid.polygon(x0+x/2, y0+y/2, id = rep(1:nrow(p), each=length(t)),
gp = gpar(fill = col[ci], col=NA), default.units="native")
}
grid.newpage()
pushViewport(viewport(xscale = c(0, 3), yscale = c(0, 3)))
for (x0 in 0.5+0:2) for (y0 in 0.5+0:2) f(x0, y0)
for (x0 in 1:2) for (y0 in 1:2) f(x0, y0)
grid.newpage()
pushViewport(viewport(layout = grid.layout(2, 2)))
for (ix in 1:2) {
for (iy in 1:2) {
pushViewport(viewport(layout.pos.col = ix,
layout.pos.row = iy, clip = TRUE))
co <- colorRampPalette(colors()[c(554,454,453,452,450,503,552,553)],
interpolate = "spline")
col <- co(100)
N <- 1000
for (ri in 1:10) {
r <- (0.7^(-1:20))[ri]
ofs <- if (ri%%2)
0
else pi/2
a <- embed(seq(0 + ofs, 2 * pi + ofs, length = N + 1), 2)
x <- r * c(rep(0, N), cos(a[, 1]), cos(a[, 2]))/2 + 0.5
y <- r * c(rep(0, N), sin(a[, 1]), sin(a[, 2]))/2 + 0.5
id = rep(1:N, 3)
grid.polygon(x, y, id, gp = gpar(col = col, fill = col))
}
popViewport()
}
}
Podemos crear fractales; por ejemplo la curva de koch
library(ggplot2)
max_iter=25
cl=rainbow(200)
step=seq(-2,0.7,by=0.005)
points=array(0,dim=c(length(step)^2,3))
t=0
for(a in step)
{
for(b in step+0.6)
{
x=0;y=0;n=0;dist=0
while(n<max_iter & dist<4)
{
n=n+1
newx=a+x^2-y^2
newy=b+2*x*y
dist=newx^2+newy^2
x=newx;y=newy
}
if(dist<4)
{
color=24 # black
}
else
{
color=n*floor(length(cl)/max_iter)
}
t=t+1
points[t,]=c(a,b,color)
}
}
df=as.data.frame(points)
ggplot(data=df, aes(V1, V2, color=cl[V3]))+
geom_point() + theme(legend.position = 'none',
axis.text.x=element_blank(),
axis.text.y=element_blank(),
panel.background=element_blank(),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
axis.ticks=element_blank()
)
Moving Squares de Bridget Riley (1961)↩︎