Cool Art
Matthew Curcio
December 27, 2017
See: https://fronkonstin.com/2017/12/23/tiny-art-in-less-than-280-characters/
library(ggplot2)
n=300
t1 = 1:n
t0 = seq(3, 2*n+1, 2) %% n
t2 = t0 + (t0 == 0)*n
df = data.frame(x = cos((t1-1)*2*pi/n),
y = sin((t1-1)*2*pi/n),
x2 = cos((t2-1)*2*pi/n),
y2 = sin((t2-1)*2*pi/n))
ggplot(df, aes(x, y, xend=x2, yend=y2)) +
geom_segment(alpha=.1) + theme_void()
library(ggplot2)
library(magrittr)
opt = theme(legend.position ="none",
panel.background = element_rect(fill = "white"),
panel.grid = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
axis.text = element_blank()
)
for (n in 1:25){
t = seq(from = 0, to = n*pi, length.out = 500*n)
data.frame(x = t^(1/2)*cos(t), y = t^(1/2)*sin(t)) %>% rbind(-.) -> df
p = ggplot(df, aes(x, y)) + geom_polygon() +
scale_x_continuous(expand = c(0,0), limits = c(-9, 9)) +
scale_y_continuous(expand = c(0,0), limits = c(-9, 9)) + opt
ggsave(filename = paste0("Fermat",sprintf("%03d", n),".jpg"),
plot = p, width = 3, height = 3)
}library(ggplot2)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniont = seq(from=0, to=100*pi, length.out=500*100)
data.frame(x = t^(1/2)*cos(t), y = t^(1/2)*sin(t)) %>%
rbind(-.) %>%
ggplot(aes(x, y)) + geom_polygon() + theme_void()
library(dplyr)
library(ggplot2)
library(pracma)##
## Attaching package: 'pracma'## The following objects are masked from 'package:magrittr':
##
## and, mod, orseq(-5*pi, 6*pi, by = 0.1) %>% expand.grid(x = ., y = .) %>%
ggplot(aes(x = x, y = y, fill = erf(sec(x)-sec(y)))) + geom_tile() +
scale_fill_gradientn(colours = c("#000000","#eeeeee")) +
theme_void() + theme(legend.position = "none")
library(dplyr)
library(ggplot2)
seq(from = -10, to = 10, by = 0.1) %>%
expand.grid(x = ., y = .) %>%
ggplot(aes(x = (x+pi*sin(y)), y = (y+pi*sin(x)))) +
geom_point(alpha = 0.1, shape = 10, size = 1, color = "red") +
theme_void()
library(TurtleGraphics)## Loading required package: gridturtle_init()
turtle_col("blue")
turtle_do({
for (i in 1:150) {
turtle_forward(dist = 1+0.5*i)
turtle_right(angle = 89.5)
}
})
turtle_hide()
t = seq(1, 100, by = 0.001)
plot(exp(-0.0001*t)*sin(t*3.019+2.677) + exp(-0.01*t)*sin(t*2.959+2.719),
exp(-0.0009*t)*sin(t*2.964+0.229) + exp(-0.01*t)*sin(t*2.984+1.284),
type = "l", axes = FALSE, xlab = "x", ylab = "y")
library(circlize)## ========================================
## circlize version 0.4.3
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: http://jokergoo.github.io/circlize_book/book/
##
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
## in R. Bioinformatics 2014.
## ========================================chordDiagram(matrix(1, 20, 20), symmetric = TRUE,
col = "blue", transparency = 0.85, annotationTrack = NULL)
par(mar = c(1, 1, 1, 1), bg = "violetred4")
circlize::chordDiagram(matrix(1, 10, 10),
col = "white",
symmetric = FALSE,
transparency = 0.85,
annotationTrack = NULL)
https://fronkonstin.com/2014/10/13/beautiful-curves-the-harmonograph/
f1 = jitter(sample(c(2,3),1))
f2 = jitter(sample(c(2,3),1))
f3 = jitter(sample(c(2,3),1))
f4 = jitter(sample(c(2,3),1))
d1 = runif(1,0,1e-03)
d2 = runif(1,0,1e-03)
d3 = runif(1,0,1e-03)
d4 = runif(1,0,1e-03)
p1 = runif(1,0,pi)
p2 = runif(1,0,pi)
p3 = runif(1,0,pi)
p4=runif(1,0,pi)
xt = function(t) exp(-d1*t)*sin(t*f1+p1)+exp(-d2*t)*sin(t*f2+p2)
yt = function(t) exp(-d3*t)*sin(t*f3+p3)+exp(-d4*t)*sin(t*f4+p4)
t=seq(1, 100, by = 0.001)
dat = data.frame(t = t, x = xt(t), y = yt(t))
with(dat, plot(x, y,
type = "l",
xlim = c(-2, 2),
ylim = c(-2, 2),
xlab = "",
ylab = "",
xaxt ='n',
yaxt ='n'))
#reset plot to defaults
.pardefault <- par()
# generate data
theta = 1:100
x = sin(theta)
y = cos(theta)
#create color scheme
color_list=c("#08519c", "#3182bd", "#6baed6", "#bdd7e7")
# set up graphic parameters & open plot
op = par(bg = 'black', mar = rep(0.5, 4))
plot.new()
plot.window(xlim = c(-1, 1), ylim = c(-1, 1), asp = 1)
# add circles one at a time
lines(x, y, col=color_list[1])
lines(0.8*x, 0.8*y, col = color_list[2])
lines(0.6*x, 0.6*y, col = color_list[3])
lines(0.4*x, 0.4*y, col = color_list[4])
# plot for May's logistic equation of population growth.
# r is growth rate
# x is population size (from 0 to 1)
lg = function(x, r) r*x*(1 - x)
gen = 50 # number of initial generations
r.min = 3.2
r.max = 4.0
p = '.'
cl = 'red' # plotting color
div = 4000 # plot resolution along the x axis
k = 32 # generations to be plotted, increase to 64 to get a high
# resolution plot
# full plot
plot(x = 0, y = 0, type = 'n',
xlim = c(r.min, r.max), ylim = c(0, 1),
xlab = 'growth rate', ylab = 'population')
for(r in seq(r.min, r.max, by = r.max/div)) {
x.init = .01
for(i in seq(0, gen)) {
x.next = lg(x.init, r)
x.init = x.next
}
for(i in seq(0, k)) {
x.next = lg(x.init, r)
x.init = x.next
points(r, x.next, pch = p, col = cl)
}
}
# Complex parameter, connected to coordinate of the Mandelbrot set in a complex plane. Constants here.
a = -0.7
b = -0.4
a1 = 0
Limits = c(-1,1)
MaxIter = 60
cl = colours()
Step = seq(Limits[1], Limits[2], by = 0.01)
PointsMatrix = array(0, dim = c(length(Step)*length(Step), 3))
plot(0, 0, xlim = Limits, ylim = Limits, col = "white")
for(x in Step){
for(y in Step){
n = 0
DIST = 0
x1 = x # Original x and y are saved.
y1 = y
while(n < MaxIter & DIST < 4){
newx = x1^2-y1^2+a
newy = 2*x1*y1+b
DIST = newx^2+newy^2
x1 = newx
y1 = newy
n = n+1
}
if(DIST < 4){
colour = 24
} else {colour = n*10
#points(x,y, pch=".", col=cl[colour])
a1 = a1+1
PointsMatrix[a1,] = c(x, y, colour)}
}
}
plot(PointsMatrix[,1],
PointsMatrix[,2],
xlim = Limits,
ylim = Limits,
col = cl[PointsMatrix[,3]],
pch = ".")
sessionInfo()## R version 3.4.2 (2017-09-28)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Linux Mint 18.2
##
## Matrix products: default
## BLAS: /usr/lib/libblas/libblas.so.3.6.0
## LAPACK: /usr/lib/lapack/liblapack.so.3.6.0
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
## [5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
## [7] LC_PAPER=en_US.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] grid stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] circlize_0.4.3 TurtleGraphics_1.0-7 pracma_2.1.1
## [4] dplyr_0.7.4 magrittr_1.5 ggplot2_2.2.1
##
## loaded via a namespace (and not attached):
## [1] Rcpp_0.12.15 bindr_0.1 knitr_1.18
## [4] munsell_0.4.3 colorspace_1.3-2 R6_2.2.2
## [7] rlang_0.1.6 stringr_1.2.0 plyr_1.8.4
## [10] tools_3.4.2 gtable_0.2.0 htmltools_0.3.6
## [13] assertthat_0.2.0 yaml_2.1.16 lazyeval_0.2.1
## [16] rprojroot_1.3-2 digest_0.6.14 tibble_1.4.2
## [19] bindrcpp_0.2 GlobalOptions_0.0.12 shape_1.4.3
## [22] glue_1.2.0 evaluate_0.10.1 rmarkdown_1.8
## [25] labeling_0.3 stringi_1.1.6 compiler_3.4.2
## [28] pillar_1.1.0 scales_0.5.0 backports_1.1.2
## [31] pkgconfig_2.0.1EOF