├── data ├── attractor_set_text.rds ├── attractor_parameter_set.rds └── attractor_parameter_set_discrete.rds ├── R ├── figures │ └── 00_examples │ │ ├── readme.png │ │ ├── 01_splines_a.png │ │ ├── 01_splines_b.png │ │ ├── 01_splines_c.png │ │ ├── 02_ridge_a.png │ │ ├── 02_ridge_b.png │ │ ├── 02_ridge_c.png │ │ ├── 03_sequence_a.png │ │ ├── 03_sequence_b.png │ │ ├── 03_sequence_c.png │ │ ├── 00_attractors_a.png │ │ └── 00_attractors_b.png ├── splines_glyphs.rmd ├── gis_ridge.rmd ├── sequence_collatz.rmd └── attractors_collection.rmd ├── LICENSE.md └── README.md /data/attractor_set_text.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/data/attractor_set_text.rds -------------------------------------------------------------------------------- /R/figures/00_examples/readme.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/readme.png -------------------------------------------------------------------------------- /data/attractor_parameter_set.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/data/attractor_parameter_set.rds -------------------------------------------------------------------------------- /R/figures/00_examples/01_splines_a.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/01_splines_a.png -------------------------------------------------------------------------------- /R/figures/00_examples/01_splines_b.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/01_splines_b.png -------------------------------------------------------------------------------- /R/figures/00_examples/01_splines_c.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/01_splines_c.png -------------------------------------------------------------------------------- /R/figures/00_examples/02_ridge_a.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/02_ridge_a.png -------------------------------------------------------------------------------- /R/figures/00_examples/02_ridge_b.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/02_ridge_b.png -------------------------------------------------------------------------------- /R/figures/00_examples/02_ridge_c.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/02_ridge_c.png -------------------------------------------------------------------------------- /R/figures/00_examples/03_sequence_a.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/03_sequence_a.png -------------------------------------------------------------------------------- /R/figures/00_examples/03_sequence_b.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/03_sequence_b.png -------------------------------------------------------------------------------- /R/figures/00_examples/03_sequence_c.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/03_sequence_c.png -------------------------------------------------------------------------------- /R/figures/00_examples/00_attractors_a.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/00_attractors_a.png -------------------------------------------------------------------------------- /R/figures/00_examples/00_attractors_b.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/R/figures/00_examples/00_attractors_b.png -------------------------------------------------------------------------------- /data/attractor_parameter_set_discrete.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/picasa/generative_examples/HEAD/data/attractor_parameter_set_discrete.rds -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2021, Pierre Casadebaig 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | * Neither the name of the copyright holder nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Exploration of generative art with \#rstats 2 | 3 | ![README](R/figures/00_examples/readme.png?raw=true "README") 4 | 5 | This repository illustrates the use of my toolbox package [*generate*](https://github.com/picasa/generate), with the examples presented below. Additional examples are presented on my art [website](https://art.casadebaig.net), more to explain the logic underlying the algorithms rather than step by step code. 6 | 7 | The code in this repository is released under a [BSD](https://github.com/picasa/generative_examples/blob/master/LICENSE.md) licence. 8 | 9 | ------------------------------------------------------------------------ 10 | 11 | ### Aesthetic point sets generated by discrete dynamical systems. 12 | 13 | [![attractors](R/figures/00_examples/00_attractors_a.png?raw=true "character-like")](https://github.com/picasa/generative/blob/master/R/attractors_glyphs.rmd#L117) [![attractors](R/figures/00_examples/00_attractors_b.png?raw=true "point set")](https://github.com/picasa/generative/blob/master/R/attractors_collection.rmd#L108) 14 | 15 | 16 | ------------------------------------------------------------------------ 17 | 18 | ### Asemic characters and words generated by splines controlled by sampling control-points. 19 | 20 | [![splines](R/figures/00_examples/01_splines_a.png?raw=true "script")](https://github.com/picasa/generative/blob/master/R/splines_glyphs.rmd#L71) [![splines](R/figures/00_examples/01_splines_b.png?raw=true "short cursive")](https://github.com/picasa/generative/blob/master/R/splines_glyphs.rmd#L131) [![splines](R/figures/00_examples/01_splines_c.png?raw=true "complex cursive")](https://github.com/picasa/generative/blob/master/R/splines_glyphs.rmd#L184) 21 | 22 | 23 | ------------------------------------------------------------------------ 24 | 25 | ### Distinct and shifted lines visualized from digital elevation model datasets. 26 | 27 | [![ridge](R/figures/00_examples/02_ridge_a.png?raw=true "broad scale")](https://github.com/picasa/generative/blob/master/R/gis_ridge.rmd#L23) [![ridge](R/figures/00_examples/02_ridge_b.png?raw=true "mid-scale")](https://github.com/picasa/generative/blob/master/R/gis_ridge.rmd#L66) [![ridge](R/figures/00_examples/02_ridge_c.png?raw=true "high-resolution terrain")](https://github.com/picasa/generative/blob/master/R/gis_ridge.rmd#L105) 28 | 29 | ------------------------------------------------------------------------ 30 | 31 | ### Curves parameterized from integer sequences and positioned according to basic botanical rules. 32 | 33 | [![sequence](R/figures/00_examples/03_sequence_a.png?raw=true "node")](https://github.com/picasa/generative/blob/master/R/sequence_collatz.rmd#L25) [![sequence](R/figures/00_examples/03_sequence_b.png?raw=true "population")](https://github.com/picasa/generative/blob/master/R/sequence_collatz.rmd#L56) [![sequence](R/figures/00_examples/03_sequence_c.png?raw=true "stem")](https://github.com/picasa/generative/blob/master/R/sequence_collatz.rmd#L116) 34 | 35 | ------------------------------------------------------------------------ 36 | 37 | -------------------------------------------------------------------------------- /R/splines_glyphs.rmd: -------------------------------------------------------------------------------- 1 | # Generative text system based on splines curves 2 | 3 | ```{r setup} 4 | library(tidyverse) 5 | library(furrr) 6 | library(cowplot) 7 | 8 | knitr::opts_chunk$set(echo=FALSE, warning=FALSE, message=FALSE) 9 | 10 | # functions 11 | # remotes::install_github("picasa/generate") 12 | library(generate) 13 | 14 | # parameters 15 | plan(multisession) 16 | options(future.rng.onMisuse = "ignore") 17 | 18 | # define coordinates systems for plots 19 | coord_square <- coord_fixed( 20 | ratio = 1, expand = TRUE, 21 | xlim = c(-1, 1), ylim = c(-1, 1)) 22 | 23 | coord_ellipse <- coord_fixed( 24 | ratio = 1, expand = TRUE, 25 | xlim = c(-0.7, 0.7), ylim = c(-0.9, 0.9)) 26 | ``` 27 | 28 | ```{r functions} 29 | 30 | sample_letters <- function(n = 3) { 31 | sample(letters, n, replace = TRUE) %>% paste0(collapse = "") 32 | } 33 | 34 | ``` 35 | 36 | 37 | ## Outline 38 | 39 | Glyphs are generated from splines defined by few control point sampled from a 2D space (square, ellipse). Glyphs are then mapped to characters to generate paragraphs with sensible text-like aesthetics. Tested alterations from this base system : 40 | 41 | * draw glyphs from simple layouts independently from each other to emulate a script-like writing (plot_script). 42 | * concatenate few layout to generate individual glyphs (plot_script_merge). 43 | * concatenate glyphs to form word to emulate a cursive-like writing (plot_cursive). 44 | * increase the size and number of control points to generate more detailed and complex shapes (plot_cursive_complex) 45 | 46 | 47 | ```{r plot_glyphs, eval=FALSE} 48 | # generate glyph type by using splines 49 | # https://inconvergent.net/2017/spline-script/ 50 | 51 | set.seed(1) 52 | n_points = 6 53 | 54 | data_glyphs <- tibble(pattern=1:100) %>% 55 | mutate( 56 | layout = map(pattern, ~ layout_ellipse(n = n_points) |> mutate(group = 1, glyph = 1)), 57 | plot = map(layout, ~ render_spline(., n = 20, coord = coord_ellipse)) 58 | ) 59 | 60 | plot_glyphs <- plot_grid(plotlist = data_glyphs$plot, ncol=10, scale=0.8) + 61 | theme(plot.margin = unit(c(1,1,1,1), "cm")) 62 | 63 | ggsave( 64 | plot_glyphs, 65 | file="./R/figures/splines/set_glyphs.png", 66 | dpi=300, width=210, height=210, scale=1, units="mm") 67 | 68 | ``` 69 | 70 | 71 | ```{r plot_script, eval=FALSE} 72 | # map glyphs to letters and generate text as glyphs sequences 73 | # alterate individual glyphs with random variations 74 | 75 | p_seed = 5 76 | set.seed(p_seed) 77 | 78 | n_points = 6 # number of control points per character 79 | n_col = 60 # number of characters per line (default 70) 80 | p_jitter = 1/5 81 | 82 | # define a character map 83 | data_map <- tibble( 84 | pattern=1:29, 85 | character = c(letters[1:26], ".", ",", "?") 86 | ) 87 | 88 | # add glyph variability using random noise on layout coordinates (10 reps) 89 | data_glyphs <- data_map %>% 90 | mutate( 91 | layout = map(pattern, ~ layout_ellipse(n = n_points) |> mutate(group = 1, glyph = 1)) 92 | ) %>% 93 | crossing(variation=1) %>% 94 | mutate( 95 | layout_rng = map( 96 | layout, 97 | ~ unnest(.x, cols = c(x,y)) %>% 98 | mutate(across(x:y, jitter, amount = p_jitter))), 99 | plot = map(layout_rng, render_spline, width=0.3, coord=coord_ellipse), 100 | plot_ld = map(layout_rng, render_spline, width=0.5, coord=coord_ellipse) 101 | ) 102 | 103 | # generate a nonsense text 104 | p_seed_2 = 10 105 | set.seed(p_seed_2) 106 | 107 | seq_text <- stringi::stri_rand_lipsum(n_paragraphs = 2) 108 | seq_prop <- str_length(seq_text)/sum(str_length(seq_text)) 109 | 110 | # render each paragraph using a random variation for each character 111 | data_script <- tibble(text = seq_text) %>% 112 | mutate(plot = map( 113 | text, 114 | ~ render_paragraph(., data = data_glyphs, ncol = n_col, scale = 1.8))) 115 | 116 | # export text 117 | plot <- plot_grid( 118 | plotlist = data_script$plot, 119 | ncol = 1, rel_heights=c(seq_prop)) + 120 | theme(plot.margin = unit(c(2,2,2,2), "cm")) 121 | 122 | file <- glue::glue("text_0_script_", sprintf("%02d", p_seed), sprintf("%02d", p_seed_2)) 123 | 124 | ggsave( 125 | plot, 126 | file=glue::glue("R/figures/splines/{file}.png"), 127 | dpi=300, width=210, height=210, scale=1, units="mm", bg="white") 128 | 129 | ``` 130 | -------------------------------------------------------------------------------- /R/gis_ridge.rmd: -------------------------------------------------------------------------------- 1 | # use open-data digital elevation model (ESRI ASCII Raster) 2 | 3 | ```{r setup} 4 | library(tidyverse) 5 | library(stars) 6 | 7 | knitr::opts_chunk$set(echo=FALSE, warning=FALSE, message=FALSE) 8 | 9 | # functions 10 | # remotes::install_github("picasa/generate") 11 | library(generate) 12 | ``` 13 | 14 | ## Outline 15 | 16 | The main idea is to convert 3D point sets to 2D lines. Digital Elevation Model (DEM) represents elevation as function of latitude and longitude. These illustrations are made of multiple lines of elevation as a function of longitude, for discrete latitude values. Overplotting is avoided (hidden lines) by checking for a minimal distance between two lines. These three examples explore the use of : 17 | 18 | * a coarse and easy source for elevation data ([elevatr](https://github.com/jhollist/elevatr) package), for a broad view (~ 450 km) 19 | * a precise DEM at a the scale of a specific valley (Ossau, FR, ~ 20 km) using IGN 5m RGE ALTI DEM ([link](https://geoservices.ign.fr/documentation/diffusion/telechargement-donnees-libres.html#rge-alti-5-m)) 20 | * a focus on a narrow zone (Loudenvielle, FR, ~ 3 km), with a fine initial sampling resolution for the elevation (30 cm, as reported [here](https://www.geoportail.gouv.fr/carte?c=2.4206324117987448,48.81510668542717&z=10&l0=GEOGRAPHICALGRIDSYSTEMS.MAPS.SCAN-EXPRESS.STANDARD::GEOPORTAIL:OGC:WMTS(1)&l1=ELEVATIONGRIDCOVERAGE.HIGHRES.QUALITY::GEOPORTAIL:OGC:WMTS(1)&permalink=yes)). 21 | 22 | 23 | ```{r plot_pyrenees, eval=FALSE} 24 | 25 | # Large scale ridge plot with open-access data 26 | # define location and bounding box 27 | coord = c(lat = 42.6896, lon = 0.4768) 28 | z_scale = 2 # ratio of elevation:cell unit 29 | 30 | # convert DEM to a dataframe and subset based on bounding box 31 | point <- data.frame(lon = coord["lon"], lat = coord["lat"]) |> 32 | st_as_sf(coords = c("lon", "lat")) |> st_set_crs(4326) |> st_transform(crs = 2154) 33 | 34 | # use AWS terrain tile (30m) 35 | dem <- elevatr::get_elev_raster(point, z = 7) 36 | 37 | box <- buffer_rectangle(point, size = 200e3) 38 | 39 | dem_subset <- dem |> st_as_stars() |> 40 | st_crop(box) |> as_tibble() |> 41 | select(x,y, z = 3) |> 42 | mutate(x = x, y = y, z = z * z_scale) 43 | 44 | data_ridge <- dem_subset |> 45 | render_ridge(n_ridges = 200, z_shift = 1000, z_threshold = 100) |> 46 | filter_ridge_length(length_n = 5) 47 | 48 | # plot 49 | plot_ridge <- data_ridge |> 50 | ggplot(aes(xn, zn, group = y_rank)) + 51 | geom_line(alpha = 1, linewidth = 0.2) + 52 | coord_fixed() + theme_void() 53 | 54 | plot_ridge 55 | 56 | file <- "ridge_pyrenee_00" 57 | 58 | # ggsave( 59 | # plot_ridge, file = glue::glue("R/figures/gis/{file}.png"), 60 | # dpi = 300, width = 420, height = 297, 61 | # scale = 1, units = "mm", bg = "white") 62 | 63 | ``` 64 | 65 | 66 | ```{r plot_ossau, eval=FALSE} 67 | 68 | # Valley scale, French DEM source (5m, 30m source) 69 | # define location and bounding box 70 | coord = c(lat = 42.9136, lon = -0.4015) # Cezy 71 | 72 | # use RGE ALTI 5m DEM 73 | dem <- coord |> read_dem(buffer = 12000, source = "rge_alti") 74 | 75 | # convert DEM to a dataframe and subset based on bounding box 76 | point <- data.frame(lon = coord["lon"], lat = coord["lat"]) |> 77 | st_as_sf(coords = c("lon", "lat")) |> st_set_crs(4326) |> st_transform(crs = 2154) 78 | 79 | box <- buffer_rectangle(point, size = 22E3, y_shift = 1E3, orientation="v") 80 | 81 | # rotate the DEM matrix to draw ridgelines from north to south 82 | dem_subset <- dem |> st_crop(box) |> 83 | as_tibble() |> mutate(x = -x, y = -y) 84 | 85 | data_ridge <- dem_subset |> 86 | render_ridge(n_ridges = 300, n_drop = 10, z_shift = 10, z_threshold = 8) |> 87 | filter_ridge_length(length_n = 15) 88 | 89 | # plot 90 | plot_ridge <- data_ridge |> 91 | ggplot(aes(xn, zn, group = y_rank)) + 92 | geom_line(alpha = 1, linewidth = 0.2) + 93 | coord_fixed() + theme_void() 94 | 95 | file <- "ridge_ossau_01" 96 | 97 | ggsave( 98 | plot_ridge, file = glue::glue("R/figures/gis/{file}.png"), 99 | dpi=300, width=format$a3[2], height=format$a3[2]/ratio$wide, 100 | scale=1, units="mm", bg="white") 101 | 102 | ``` 103 | 104 | 105 | ```{r plot_loudenvielle, eval=FALSE} 106 | 107 | # Ridge line rendering with true HR DEM data (5m, 30cm source) 108 | 109 | coord = c(lat = 42.7446, lon = 0.4106) # Loudenvielle 110 | z_scale = 1 # ratio of elevation:cell unit 111 | 112 | # convert DEM to a dataframe and subset based on bounding box 113 | point <- data.frame(lon = coord["lon"], lat = coord["lat"]) |> 114 | st_as_sf(coords = c("lon", "lat")) |> st_set_crs(4326) |> st_transform(crs = 2154) 115 | 116 | # RGE ALTI (5m) 117 | dem <- coord |> read_dem(buffer = 5000, source = "rge_alti") 118 | 119 | box <- buffer_rectangle(point, size = 3E3, orientation="v") 120 | 121 | # rotate the DEM matrix to draw ridgelines from north to south 122 | dem_subset <- dem |> st_as_stars() |> 123 | st_crop(box) |> as_tibble() |> 124 | select(x0=x, y0=y, z0 = 3) |> 125 | mutate(x = -x0, y = -y0, z = z0 * z_scale) |> 126 | select(x,y,z) 127 | 128 | data_ridge <- dem_subset |> 129 | render_ridge(n_ridges = 300, z_shift = 5, z_threshold = 7) 130 | 131 | # plot 132 | plot_ridge <- data_ridge |> 133 | ggplot(aes(xn, zn, group = y_rank)) + 134 | geom_line(alpha = 1, size = 0.2) + 135 | coord_fixed() + theme_void() 136 | 137 | file <- "ridge_loudenvielle_00" 138 | 139 | ggsave( 140 | plot_ridge, file = glue::glue("R/figures/gis/{file}.png"), 141 | dpi=300, width=format$a4[1], height=format$a4[2], 142 | scale=1, units="mm", bg="white") 143 | 144 | ``` 145 | 146 | -------------------------------------------------------------------------------- /R/sequence_collatz.rmd: -------------------------------------------------------------------------------- 1 | # Explore the use of sequences to generate plant-like visualizations 2 | 3 | ```{r setup} 4 | library(tidyverse) 5 | library(ggforce) 6 | 7 | knitr::opts_chunk$set(echo=FALSE, warning=FALSE, message=FALSE) 8 | options(dplyr.summarise.inform = FALSE) 9 | 10 | # functions 11 | # remotes::install_github("picasa/generate") 12 | library(generate) 13 | 14 | ``` 15 | 16 | ## Outline 17 | 18 | A sequence of integers is generated from a set of rules (here, the Collatz [sequence](https://en.wikipedia.org/wiki/Collatz_conjecture)). Then, a curve is defined by mapping sequence elements to segment length, with a fixed angle between segments. Multiple curves are computed to constitute a node, and multiple nodes to constitute a stem. The only random elements are initial value for the sequence, and the angle between curve segments. These examples explore the : 19 | 20 | * generation of a node defined as multiple curves and vertical shifting of their starting point by a fixed amount (plot_node_dense) 21 | * generation of a few nodes with same attributes and simple geometric deformation. 22 | * generation of a population of nodes with attributes (scale, shifting) and position as a function of a 2D grid. 23 | * generation of multiple node with attributes (number of leaves, scale, angle, position) varying as a function of position on a stem-like structure (plot_stem). 24 | 25 | ```{r plot_dense, eval=FALSE} 26 | # plot a single node with dense polygons 27 | 28 | p_seed = 5 29 | 30 | plot <- gen_node( 31 | n = 200, amin = -40, amax = 40, lmax = 3000, 32 | shift = c(0, 4), width = c(0, 10), method = "spline", seed = p_seed) |> 33 | render_node( 34 | method = "polygon", margin = 10, xlim = c(-100, 100), ylim = c(180,460)) 35 | 36 | file <- sprintf("collatz_dense_%02d", p_seed) 37 | 38 | ggsave( 39 | plot, file = glue::glue("R/figures/sequence/{file}.png"), 40 | width = 210, height = 295, 41 | dpi=300, scale=1, units="mm", bg = "white") 42 | 43 | ``` 44 | 45 | ```{r} 46 | #| label: field_grass 47 | #| eval: false 48 | # plot a population of n nodes (2D distribution) with attributes varying with depth and node density 49 | 50 | p_seed = 1 51 | p_node = 50 # number of nodes (individuals) 52 | p_spacing = 100 # spacing scaling parameter for grid points 53 | p_persp = 0.5 # adjust y axis for perspective 54 | p_leaf = 15 # number of organ for each individual 55 | p_imax = 50 56 | p_lmax = 300 57 | p_angle = 10 58 | p_shift = c(1, 40) 59 | p_width = c(0, 20) 60 | p_scale = c(0.6, 0.1) 61 | p_shape = "wave" 62 | p_render = "polygon_lm" 63 | 64 | # generate n nodes 65 | set.seed(p_seed) 66 | 67 | # draw a random layout for nodes 68 | data_layout <- layout_rectangle(n = p_node) |> 69 | transmute(x0 = x * p_spacing, y0 = y * p_spacing) |> arrange(y0) 70 | 71 | # count neighbor number in a given radius 72 | matrix_distance <- data_layout |> 73 | sf::st_as_sf(coords = c("x0", "y0")) |> sf::st_distance() 74 | 75 | # set population parameters : shift = f(density), scale = f(distance) 76 | data_population <- data_layout |> 77 | mutate( 78 | node = seq_len(p_node), 79 | n = apply(matrix_distance, 1, function(x) {sum(x < 50) - 1}), 80 | shift = scales::rescale(n, to = p_shift), 81 | scale = scales::rescale(y0, to = p_scale)) |> 82 | mutate(y0 = y0 * scales::rescale(y0, to=c(1, p_persp))) 83 | 84 | # data_population |> ggplot(aes(x0, y0, color = shift)) + geom_point() + coord_fixed() 85 | 86 | # create nodes as a function of population parameters 87 | data_node <- data_population |> 88 | mutate( 89 | data = future_pmap( 90 | list(shift, scale), 91 | ~ gen_node( 92 | n = p_leaf, imax = p_imax, lmax = p_lmax, amin = -p_angle, amax = p_angle, 93 | shift = c(0, ..1), scale = ..2, width = p_width, shape = p_shape, 94 | method = p_render), .options = furrr_options(seed=TRUE)) 95 | ) 96 | 97 | # set node geometry in 2D space 98 | data_plot <- data_node |> 99 | mutate( 100 | data_t = pmap(list(data, x0, y0), ~ tr_rt(..1, x0 = ..2, y0 = ..3, a = 0, index = "id")) 101 | ) |> 102 | select(node, data_t) |> unnest(data_t) 103 | 104 | plot <- data_plot |> 105 | left_join(data_plot |> distinct(node, id) |> mutate(g = 1:n())) |> 106 | ggplot() + 107 | geom_shape( 108 | aes(x,y, group = -g), 109 | color="black", fill="white", size = 0.3) + 110 | # coord_fixed() + 111 | coord_fixed(xlim =c(-100, 100) , ylim = c(50, 200)) + 112 | #coord_fixed(xlim =c(0, 100) , ylim = c(0, 140)) + 113 | theme_void() + theme(plot.margin = unit(rep(1,4), "cm")) 114 | 115 | ``` 116 | 117 | 118 | ```{r plot_stem, eval=FALSE} 119 | 120 | #| label: plot_stem 121 | #| eval: false 122 | 123 | p_seed = 1 124 | set.seed(p_seed) 125 | 126 | p_stem = 73 # starting point for the stem sequence 127 | p_stem_angle = 10 # angle between successive stem segments 128 | p_stem_width = c(0,15) # width for stem element 129 | p_node = 35 # node number in the branch 130 | p_node_angle = c(140, 10) # mean and sd of angle between nodes and stem 131 | p_node_width = c(0,20) # width for node elements 132 | p_scale = 0.5 # stem scale 133 | 134 | # set node parameters along the stem 135 | data_topology <- tibble( 136 | node = seq_len(p_node), 137 | leaf = seq(15, 10, len = p_node), 138 | angle = seq(10, 5, len = p_node), 139 | lmax = seq(700, 400, len = p_node), 140 | scale = seq(1.2, 0.3, len = p_node) 141 | ) 142 | 143 | # generate nodes as a function of parameter list 144 | data_node <- data_topology |> 145 | mutate( 146 | data = future_pmap( 147 | list(leaf, angle, lmax, scale), 148 | ~ gen_node( 149 | n = ..1, amin = -..2, amax = ..2, lmax = ..3, scale = ..4, 150 | width = p_node_width), 151 | .options = furrr_options(seed = TRUE) 152 | )) 153 | 154 | # generate stem geometry and node transformation parameters 155 | data_stem <- gen_leaf(p_stem, a = p_stem_angle) |> slice(1:p_node) |> 156 | mutate(across(x:yend, ~ . * p_scale)) |> 157 | mutate( 158 | n = rev(n), 159 | a = seq_alt(n = p_node, m = p_node_angle[1], sd = p_node_angle[2]), 160 | a = (a + angle) * pi/180) 161 | 162 | # merge stem and node data 163 | data_plot <- data_node |> 164 | left_join(data_stem |> select(node=n, x0=x, y0=y, a)) |> 165 | mutate(data_t = pmap(list(data, x0, y0, a), ~ tr_rt(..1, ..2, ..3, ..4))) 166 | 167 | # plot 168 | plot <- ggplot() + 169 | geom_shape( 170 | data = data_stem |> transform_path(width = p_stem_width), 171 | aes(x, y), alpha=0.2, size=1, 172 | radius = unit(2.5, 'pt'), expand = unit(2.5, 'pt'), 173 | fill="white", color="black") + 174 | geom_path(data = data_stem, aes(x=x,y=y), color="black", size = 0.5) + 175 | geom_shape( 176 | data = data_plot |> unnest(data_t), 177 | aes(x,y, group = interaction(node, leaf)), 178 | color="black", fill="white", size = 0.5) + 179 | coord_fixed() + theme_void() 180 | 181 | # export 182 | file <- sprintf("collatz_stem_%02d", p_seed) 183 | 184 | ggsave( 185 | plot, file = glue::glue("R/figures/sequence/{file}.png"), 186 | width = 295, height = 210, 187 | dpi=400, scale=1, units="mm", bg = "white") 188 | 189 | ``` 190 | 191 | 192 | 193 | 194 | -------------------------------------------------------------------------------- /R/attractors_collection.rmd: -------------------------------------------------------------------------------- 1 | # Hunting for attractors 2 | 3 | This work is a direct reuse of results from Sprott (1993)^1, Bourke [link](http://paulbourke.net/fractals/sprott/) and the R implementation of quadratic map functions from Lindberg [link](https://blog.k2h.se/post/hunting-for-attractors/). 4 | This code sample parameter space, filter aesthetic functions based on different criterias (Lyapunov exponent, summary of point density distribution, correlation) and display them in a grid. 5 | 6 | 1. Sprott, J. C. (1993). Automatic generation of strange attractors. Computers & Graphics, 17(3), 325-332. 7 | 8 | ```{r setup} 9 | library(tidyverse) 10 | library(furrr) 11 | 12 | # functions 13 | # remotes::install_github("picasa/generate") 14 | library(generate) 15 | 16 | # options 17 | plan(multisession) 18 | options(dplyr.summarise.inform=FALSE) 19 | update_geom_defaults("point", list(size = 0.1, stroke = 0, shape = 16)) 20 | 21 | ``` 22 | 23 | 24 | ```{r sample, eval=FALSE} 25 | 26 | set.seed(1) 27 | 28 | n_total <- 5e5 29 | 30 | # generate a set of unique 12 letters sequences from a set of 25 letters (25^12 set) 31 | # get parameters corresponding to sampled sequence 32 | table_set <- tibble(pattern = 1:n_total) %>% 33 | mutate(name = map(pattern, ~ sample_sequence(set = LETTERS[1:25], length = 12))) %>% 34 | distinct(name, .keep_all = TRUE) %>% 35 | mutate(p = map(name, ~ get_parameters(string = .))) 36 | 37 | # filter for functions that do not converge into a single point (25/1e4 @ 1000) 38 | table_set <- table_set %>% 39 | mutate(L = future_map_dbl(p, ~ L(quadratic_map, ., 0, 0, iterations = 1000))) %>% 40 | filter(L > 0) %>% unnest(name) 41 | 42 | # compute xy data and point density as an aesthetic metric. (28 / 1000 @ 5000) 43 | # filter diverging functions 44 | table_set <- table_set %>% 45 | mutate(xy = future_map(p, ~ iterate(quadratic_map, ., 0, 0, iterations = 5000))) %>% 46 | filter(map_lgl(xy, ~ with(., all(abs(x) + abs(y) < 1e7)))) %>% 47 | mutate(density = map(xy, ~ density_metric(., gridsize = 50))) %>% 48 | mutate(r = map_dbl(xy, ~ with(., cor(x,y)))) %>% 49 | select(-xy) %>% unnest(density) 50 | 51 | # export 52 | saveRDS(table_set, file="data/attractor_parameter_set_discrete.rds", compress="gzip") 53 | 54 | ``` 55 | 56 | ```{r collection_scatter, eval=FALSE} 57 | 58 | # plot 5 cm square plot in A2 format (40 x 60) n = 8*12 = 96, quality=90 59 | # plot 5 cm square plot in A1 format (60 x 80) n = 12*16 = 192 60 | 61 | # load results from previously intensive sampling 62 | table_set <- read_rds("data/attractor_parameter_set_discrete.rds") 63 | 64 | # filter functions (aesthetic:sampled ~ 0.1 %) 65 | table_collection <- table_set %>% 66 | filter(between(L, 0.1, 0.4)) %>% 67 | filter(d > 0.30) %>% 68 | filter(cv < 1.1) %>% 69 | filter(abs(r) < 0.8) 70 | 71 | # compute quadratic map at high resolution for a random subset of functions 72 | # post-process xy data (filter early iterations, rescaling) 73 | # filter rare functions that diverge/converge for large iterations 74 | p_seed = 3 75 | set.seed(p_seed) 76 | 77 | data_collection <- table_collection %>% 78 | slice_sample(n = 100) %>% 79 | mutate(xy = future_map(p, ~ iterate(quadratic_map, ., 0, 0, iterations = 5e5))) %>% 80 | filter(map_lgl(xy, ~ with(., all(abs(x) + abs(y) < 1e7)))) %>% 81 | filter(map_lgl(xy, ~ density_metric(.) %>% pull(cv) < 2)) %>% 82 | mutate(xy = map(xy, ~ normalize_xy(.))) %>% 83 | slice_sample(n = 96) 84 | 85 | # compute plots for selected functions 86 | data_collection <- data_collection %>% 87 | mutate(plot = map(xy, ~ render_plot(., size = 0.1))) %>% 88 | arrange(name) 89 | 90 | # build plot collection 91 | plot_collection <- plot_grid( 92 | plotlist = data_collection$plot, ncol = 8, scale = 0.7, 93 | labels = str_to_title(data_collection$name), 94 | label_x = 0.2, label_y = 0.15, label_size = 7, 95 | label_fontface = "italic", 96 | label_fontfamily = "NewCenturySchoolbook") + 97 | theme(plot.margin = unit(c(1,1,1,1), "cm")) 98 | 99 | file <- sprintf("set_collection_%02d", p_seed) 100 | 101 | ggsave( 102 | plot_collection, 103 | file = glue::glue("R/figures/attractors/{file}.png"), 104 | dpi=300, width = 420, height = 594, scale=1, units="mm") 105 | 106 | ``` 107 | 108 | ```{r plot_scatter, eval=FALSE} 109 | # Render point sets generated by quadratic maps with scatterplots 110 | 111 | set.seed(2) 112 | 113 | n_plot = 10 # number of parameter combination to sample 114 | n_iter = 1E6 # number of iterations for the quadratic map 115 | 116 | # load results from previously intensive sampling step 117 | table_set <- read_rds("data/attractor_parameter_set_discrete.rds") 118 | 119 | # filter functions (aesthetic:sampled ~ 0.1 %) 120 | table_collection <- table_set %>% 121 | filter(between(L, 0.1, 0.4)) %>% 122 | filter(d > 0.30) %>% 123 | filter(cv < 1.1) %>% 124 | filter(abs(r) < 0.8) 125 | 126 | # compute quadratic map at high resolution for a random subset of functions 127 | # post-process xy data (filter early iterations, rescaling) 128 | # filter rare functions that diverge/converge for large iterations 129 | data_collection <- table_collection %>% 130 | slice_sample(n = n_plot) %>% 131 | mutate(xy = future_map(p, ~ simulate_quadratic(., iterations = n_iter))) %>% 132 | filter(map_lgl(xy, ~ with(., all(abs(x) + abs(y) < 1e7)))) %>% 133 | filter(map_lgl(xy, ~ density_metric(.) %>% pull(cv) < 2)) %>% 134 | mutate(xy = map(xy, ~ normalize_xy(.))) 135 | 136 | # compute plots for selected functions 137 | data_plot <- data_collection %>% 138 | mutate( 139 | plot = map(xy, ~ render_plot(., size = 0.1, alpha = 1/3)), 140 | file = glue::glue("./R/figures/attractors/collection/scatter_{name}.png") 141 | ) 142 | 143 | # export plots 144 | data_plot %>% 145 | mutate( 146 | s = walk2(file, plot, ~ ggsave( 147 | filename = .x, dpi = 300, scale=1, bg = "white", 148 | plot = .y + geom_point(alpha= 1/3), 149 | width = 210, height = 210, units="mm" 150 | )) 151 | ) 152 | 153 | ``` 154 | 155 | 156 | ```{r plot_graph_rng, eval=FALSE} 157 | # Render point sets generated by quadratic maps with relative neighbourhood graphs. 158 | 159 | set.seed(1) 160 | 161 | n_plot = 5 # number of parameter combination to sample 162 | n_iter = 1E5 # number of iterations for the quadratic map 163 | n_sample = 2500 # number of points to sample before building the RN graph. 164 | 165 | # list pre-selected patterns to simulate 166 | value_pattern = c( 167 | "GWMEASBXSDLY", "XMGMBDILSCFO", "HGUHKHDJQUFN", "VVKLLANMEDGG", 168 | "BUOSBOVJJLFJ") 169 | 170 | # load results from previously intensive sampling step 171 | table_set <- read_rds("data/attractor_parameter_set_discrete.rds") 172 | 173 | # filter functions (aesthetic:sampled ~ 0.1 %) 174 | table_collection <- table_set %>% 175 | filter(between(L, 0.1, 0.4)) %>% 176 | filter(d > 0.30) %>% 177 | filter(cv < 1.1) %>% 178 | filter(abs(r) < 0.8) 179 | 180 | # compute quadratic map at medium resolution for a random subset of functions 181 | data_collection <- table_collection %>% 182 | slice_sample(n = n_plot) %>% 183 | bind_rows(tibble(name = value_pattern)) %>% 184 | mutate( 185 | p = map(name, ~ get_parameters(.)), 186 | xy = future_map(p, ~ simulate_quadratic(., iterations = n_iter)), 187 | layout = map(xy, ~ slice_sample(., n = n_sample))) 188 | 189 | # render plots and export 190 | data_plot <- data_collection %>% 191 | mutate( 192 | plot = future_map(layout, ~ render_graph( 193 | ., graph = "rng", k = NA, aes = "line", width = 0.3, coord = coord_fixed())), 194 | file = glue::glue("./R/figures/attractors/collection/graph_rn_{name}.png") 195 | ) 196 | 197 | data_plot %>% 198 | mutate( 199 | s = walk2(file, plot, ~ ggsave( 200 | filename = .x, plot = .y , dpi = 300, scale = 1, bg = "white", 201 | width = 210, height = 210, units="mm" 202 | )) 203 | ) 204 | 205 | ``` 206 | 207 | 208 | --------------------------------------------------------------------------------