Permalink
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
162 lines (99 sloc) 3.41 KB
---
title: "Reproducible psychedelic art with R: a tribute to spatstat"
author: "Petr Keil"
output:
html_document:
highlight: tango
theme: cerulean
---
LICENSE: This is a public domain work. Feel free to do absolutely whatever you want with the code or the images, there are no restrictions on the use.
----------------------------------------
Loading the `spatstat` library
```{r}
library(spatstat)
```
Defining the 2:3 window
```{r}
W23 <- as.owin(list(xrange=c(0,3), yrange=c(0,2)))
```
# Figure 1
Generate the patterns:
```{r}
set.seed(1612)
# The exponent
Lambda <- 5
# Lay down the longest lines
main.lines <- psp(runif(3),runif(3),runif(3),runif(3), window=W23)
# Sample points proportionally to the distance to the lines
dist.from.line <- distmap(main.lines)
# exponential transformation of the distance
dist.from.line.exp <- Lambda*exp(-Lambda*dist.from.line)
samp.pois <- rpoispp(dist.from.line.exp*15)
# Project to the lines using project2segment(b, a)
Xproj <- project2segment(samp.pois, main.lines)$Xproj
sub.lines <- psp(samp.pois$x, samp.pois$y, Xproj$x, Xproj$y, window=W23)
# Connect with the lines
all.lines <- append.psp(main.lines, sub.lines)
dist.from.all.lines <- distmap(all.lines, dimyx=c(1200, 800))
```
## 1A
```{r}
png(filename = "Figure_1A.png", width=6000, height=4000, res=400)
par(mai=c(0,0,0,0))
dist.from.all.lines.exp <- exp(-Lambda*dist.from.all.lines)
plot(dist.from.all.lines.exp,
legend=FALSE, main="", box=FALSE, ribbon=FALSE)
contour(dist.from.all.lines.exp, add=TRUE, col="white")
contour(dist.from.all.lines, col="black", add=TRUE, lwd=4, levels=0.2)
contour(dist.from.all.lines, col="black", add=TRUE, lwd=2, levels=0.3)
contour(dist.from.all.lines, col="black", add=TRUE, lwd=2)
plot(sub.lines, add=T, lty=2, col="black", lwd=1)
plot(main.lines, add=T, col="black", lwd=4)
dev.off()
```
## 1B
```{r}
png(filename = "Figure_1B.png", width=6000, height=4000, res=400)
par(mai=c(0,0,0,0))
dist.from.all.lines.exp <- exp(-Lambda*dist.from.all.lines)
plot(dist.from.all.lines.exp, col=terrain.colors(100),
legend=FALSE, main="", box=FALSE, ribbon=FALSE)
contour(dist.from.all.lines.exp, add=TRUE, lwd=2)
plot(sub.lines, add=T, lty=2, col="black", lwd=1)
plot(main.lines, add=T, col="black", lwd=4)
dev.off()
```
# Figure 2
Generate the pattern:
```{r}
set.seed(16211)
rc <- rpoispp(function(x,y){50 * exp(-3*(max(y)-y))}, 100, win=W23)
rcdist <- distmap(rc, dimyx=c(1200, 800))
rc2 <- rpoispp(1/rcdist*50)
rcd <- dirichlet(rc2)
```
## 2A
```{r}
png(filename = "Figure_2A.png", width=6000, height=4000, res=400)
par(mai=c(0,0,0,0))
plot(rcdist, legend=FALSE, main="", frame=FALSE, box=FALSE, ribbon=FALSE)
plot(rcd, add=T)
plot(rc, add=T, col="black", pch=19, cex=2.5)
plot(rjitter(rc, 0.01), add=T, col="white", pch=19, cex=0.4)
contour(rcdist, add=T, col="white")
dev.off()
```
## 2B
```{r}
png(filename = "Figure_2B.png", width=6000, height=4000, res=400)
par(mai=c(0,0,0,0))
plot(rcdist, legend=FALSE, main="", frame=FALSE, box=FALSE, ribbon=FALSE,
col=terrain.colors(100))
plot(rcd, add=T, col=terrain.colors(100)[30], lwd=2)
plot(rc, add=T, col=terrain.colors(100)[30], pch=19, cex=3)
plot(rc, add=T, col="white", pch=19, cex=2)
plot(rjitter(rc, 0.01), add=T, col="black", pch=19, cex=0.4)
contour(rcdist, add=T, nlevels=5, lwd=2)
dev.off()
# dd
```