paezha/truchet
Package for creating Truchet tiles and random mosaics

Package index
Search the paezha/truchet package
Vignettes
Functions
19
Source code
11
Man pages
10
Home
/
GitHub
/
paezha/truchet
/

In paezha/truchet: Package for creating Truchet tiles and random mosaics

Non-random allocation of tiles

library(ggplot2)
library(igraph)
library(imager)
library(dplyr)
library(lwgeom)
library(MexBrewer)
library(purrr)
library(sf)
library(truchet)

ggplot() + geom_sf(data = mosaic %>% st_buffer(dist = c(0.15)) %>% st_union(), color = "dodgerblue4", fill = "dodgerblue1", size = 1) + geom_sf(data = mosaic %>% st_buffer(dist = c(0.05)), size = 0.5)

Create data frame for the mosaic:

xlim <- c(0, 10)
ylim <- c(0, 10)

# Create a data frame with the spots for tiles
container <- expand.grid(x = seq(xlim[1], xlim[2], 1),
                         y = seq(ylim[1], ylim[2], 1)) %>%
  mutate(tiles = case_when(x <= 2 | x >= 8 ~ "dl", 
                           x > 2 & x <8 ~ "dr"))

st_truchet_ss(df = container) %>%
  ggplot() +
  geom_sf()

Create data frame for the mosaic:

xlim <- c(0, 10)
ylim <- c(0, 10)

# Create a data frame with the spots for tiles
container <- expand.grid(x = seq(xlim[1], xlim[2], 1),
                         y = seq(ylim[1], ylim[2], 1)) %>%
  mutate(tiles = sample(c("dl", "dr"), n(), replace = TRUE))

Create mosaic using the designed container:

mosaic <- st_truchet_ss(df = container)

Plot mosaic:

ggplot() +
  geom_sf(data = mosaic,
          size = 2)

Plot with some embellishments:

ggplot() +
  geom_sf(data = mosaic %>% 
            st_buffer(dist = c(0.20)) %>%
            st_union(), 
          color = "white", 
          fill = "dodgerblue1", 
          size = 0.5) + 
  geom_sf(data = mosaic %>% 
            st_buffer(dist = c(0.15),
                      singleSide = TRUE),
          aes(fill = x + y),
          color = NA) +
  scale_fill_gradientn(colors = mex.brewer("Revolucion")) +
  #scale_fill_distiller(palette = "RdYlBu")  +
  theme_void() +
  theme(legend.position = "none",
        panel.background = element_rect(color = NA,
                                        fill = "dodgerblue4"))

Plot with some embellishments:

ggplot() +
  geom_sf(data = mosaic %>% 
            st_buffer(dist = c(0.20)) %>%
            st_union(), 
          color = "white", 
          fill = "dodgerblue1", 
          size = 0.5) + 
  geom_sf(data = mosaic,
          aes(color = sqrt(x^2 + y^2),
              size = sqrt(x^2 + y^2))) +
  scale_color_gradientn(colors = mex.brewer("Alacena")) +
  scale_size(range = c(0.5, 1.5)) +
  theme_void() +
  theme(legend.position = "none",
        panel.background = element_rect(color = NA,
                                        fill = "dodgerblue4"))

Create a polygon to contain the mosaic:

container <- matrix(c(0, 0,
                      0, 10,
                      10, 10,
                      10, 0,
                      0, 0),
                    ncol = 2,
                    byrow = TRUE)

# Convert coordinates to polygons and then to simple features
container <- data.frame(geometry = sf::st_polygon(list(container)) %>%
                          sf::st_sfc()) %>%
  sf::st_as_sf()

Split container

container <- container%>%
  st_split(mosaic %>% st_union())

Extract geometries:

container <- container %>% 
  st_collection_extract(c("POLYGON"))

Plot container:

ggplot() +
  geom_sf(data = container %>% 
            mutate(id = sample(1:n(), 
                               n())),
          aes(fill = id),
          color = "white",
          size = 0.5) +
  geom_sf(data = container %>% 
            st_buffer(dist = c(-0.15)) %>%
            mutate(id = sample(1:n(), 
                               n())),
          aes(fill = id),
          color = "white",
          size = 0.5) +
  scale_fill_gradientn(colors = mex.brewer("Revolucion")) +
  theme_void() +
  theme(legend.position = "none")

ggsave("single-scale-polygons-revolucion.png")

Something interesting happens with positive buffers:

ggplot() +
  # geom_sf(data = container %>% 
  #           mutate(id = sample(1:n(), 
  #                              n())),
  #         aes(fill = id),
  #         color = "white",
  #         size = 0.5) +
  geom_sf(data = container %>% 
            # Experiment with different buffer sizes
            st_buffer(dist = c(0.5)) %>%
            mutate(id = sample(1:n(), 
                               n())),
          aes(fill = id),
          color = "white",
          size = 1) +
  scale_fill_gradientn(colors = mex.brewer("Revolucion")) +
  theme_void() +
  theme(legend.position = "none")

ggsave("single-scale-polygons-revolucion-positive-buffers-2.png")

Something interesting happens with positive buffers:

ggplot() +
  geom_sf(data = container %>% 
            # Experiment with different buffer sizes
            st_buffer(dist = c(0.5)) %>%
            st_intersection(container) %>%
            mutate(id = sample(1:n(), 
                               n())),
          aes(fill = id),
          color = "black",
          size = 1) +
  geom_sf(data = container %>% 
            # Experiment with different buffer sizes
            st_buffer(dist = c(0.3)) %>%
            st_buffer(dist = -0.2) %>%
            mutate(id = sample(1:n(), 
                               n())),
          fill = NA,
          color = "black",
          size = 1) +
  scale_fill_gradientn(colors = mex.brewer("Revolucion")) +
  theme_void() +
  theme(legend.position = "none")

ggsave("single-scale-polygons-revolucion-positive-buffers-3.png")

Using images

library(imager)

Read the image using imager::load.image():

marilyn <- load.image("marilyn.jpg")

Image info:

marilyn

plot(marilyn)

Resize image:

marilyn_rs <- imresize(marilyn, scale = 1/8, interpolation = 6)

Convert to data frame:

marilyn_df <- marilyn_rs %>%
  #grayscale() %>% 
  as.data.frame() %>%
  mutate(y = -(y - max(y)))

ggplot() +
  geom_point(data = marilyn_df,
             aes(x, y, color = value)) +
  coord_equal()

Create data frame for the mosaic:

xlim <- c(min(marilyn_df$x)/8 - 2, max(marilyn_df$x)/8 + 2)
ylim <- c(min(marilyn_df$y)/8 - 2, max(marilyn_df$y)/8 + 2)

# Create a data frame with the spots for tiles
mosaic <- expand.grid(x = seq(xlim[1], xlim[2], 1),
                      y = seq(ylim[1], ylim[2], 1)) %>%
  mutate(tiles = sample(c("dl", "dr"), n(), replace = TRUE))

Create mosaic using the designed container:

mosaic <- st_truchet_ss(df = mosaic)

Plot mosaic:

ggplot() +
  geom_sf(data = mosaic,
          size = 1)

Now this needs to be scaled to the size of the image. First get the union of the geometries:

mosaic_union <- st_union(mosaic)

Then scale and recenter:

mosaic_union <- mosaic_union * 8

Create a polygon to contain the mosaic:

container <- matrix(c(min(marilyn_df$x), min(marilyn_df$y),
                      min(marilyn_df$x), max(marilyn_df$y),
                      max(marilyn_df$x), max(marilyn_df$y),
                      max(marilyn_df$x), min(marilyn_df$y),
                      min(marilyn_df$x), min(marilyn_df$y)),
                    ncol = 2,
                    byrow = TRUE)

# Convert coordinates to polygons and then to simple features
container <- data.frame(geometry = sf::st_polygon(list(container)) %>%
                          sf::st_sfc()) %>%
  sf::st_as_sf()

Split container

mosaic <- container %>%
  st_split(mosaic_union)

Extract geometries:

mosaic <- mosaic %>% 
  st_collection_extract(c("POLYGON"))

Create buffers:

mosaic_1 <- mosaic %>%
  st_buffer(dist = -1)

mosaic_2 <- mosaic %>%
  st_buffer(dist = -2)

mosaic_3 <- mosaic %>%
  st_buffer(dist = -3)

Plot mosaic:

ggplot() +
  geom_point(data = marilyn_df,
             aes(x, y, color = value),
             size = 1.35,
             shape = 15) +
  geom_sf(data = mosaic,
          color = "white",
          fill = NA,
          size = 0.2) +
  geom_sf(data = mosaic_1,
          color = "white",
          fill = NA,
          size = 0.2) +
  geom_sf(data = mosaic_2,
          color = "white",
          fill = NA,
          size = 0.2) +
  geom_sf(data = mosaic_3,
          color = "white",
          fill = NA,
          size = 0.2) +
  coord_sf(expand = FALSE) +
  scale_color_gradientn(colors = rev(mex.brewer("Aurora"))) +
  #scale_color_gradient(low = "black", high = "white") +
  theme_void() + 
  theme(legend.position = "none")

ggsave("marilyn-truchet.png")

Changing the width of the lines

Load package:

library(imager)
library(purrr)

Read the image using imager::load.image():

marilyn <- load.image("marilyn.jpg")

Image info:

marilyn

plot(marilyn)

Resize image:

marilyn_rs <- imresize(marilyn, scale = 1/4, interpolation = 6)

Convert to data frame:

marilyn_df <- marilyn_rs %>%
  #grayscale() %>% 
  as.data.frame() %>%
  mutate(y = -(y - max(y)))

ggplot() +
  geom_point(data = marilyn_df,
             aes(x, y, color = value)) +
  coord_equal()

Create data frame for the mosaic:

s <- 8

xlim <- c(min(marilyn_df$x)/s - 2, max(marilyn_df$x)/s + 2)
ylim <- c(min(marilyn_df$y)/s - 2, max(marilyn_df$y)/s + 2)

# Create a data frame with the spots for tiles
mosaic <- expand.grid(x = seq(xlim[1], xlim[2], 1),
                      y = seq(ylim[1], ylim[2], 1)) %>%
  mutate(tiles = sample(c("dl", "dr"), n(), replace = TRUE))

Create mosaic using the designed container:

mosaic <- st_truchet_ss(df = mosaic)

Plot mosaic:

ggplot() +
  geom_sf(data = mosaic,
          size = 1)

Now this needs to be scaled to the size of the image. First get the union of the geometries:

mosaic_union <- st_union(mosaic)

Then scale and recenter:

mosaic_union <- mosaic_union * s

Create a polygon to contain the mosaic:

container <- matrix(c(min(marilyn_df$x), min(marilyn_df$y),
                      min(marilyn_df$x), max(marilyn_df$y),
                      max(marilyn_df$x), max(marilyn_df$y),
                      max(marilyn_df$x), min(marilyn_df$y),
                      min(marilyn_df$x), min(marilyn_df$y)),
                    ncol = 2,
                    byrow = TRUE)

# Convert coordinates to polygons and then to simple features
container <- data.frame(geometry = sf::st_polygon(list(container)) %>%
                          sf::st_sfc()) %>%
  sf::st_as_sf()

Split container

mosaic <- container %>%
  st_split(mosaic_union)

Extract geometries:

mosaic <- mosaic %>% 
  st_collection_extract(c("POLYGON"))

Create buffers:

mosaic_1 <- mosaic %>%
  st_buffer(dist = -0.45)
# mosaic_2 <- mosaic %>%
#   st_buffer(dist = -1)
# mosaic_3 <- mosaic %>%
#   st_buffer(dist = -1.5)

mosaic_1 <- mosaic_1[!st_is_empty(mosaic_1), , drop = FALSE]

# mosaic_2 <- mosaic_2[!st_is_empty(mosaic_2), , drop = FALSE]
# 
# mosaic_3 <- mosaic_3[!st_is_empty(mosaic_3), , drop = FALSE]

Cast to lines (if the buffers are too big a warning is issued and it looks like lines are not retrieved):

mosaic_lines <- mosaic %>%
  st_cast(to = "LINESTRING")

mosaic_lines_1 <- mosaic_1 %>%
  st_cast(to = "LINESTRING")

# mosaic_lines_2 <- mosaic_2 %>%
#   st_cast(to = "LINESTRING")
# 
# mosaic_lines_3 <- mosaic_3 %>%
#   st_cast(to = "LINESTRING")

Plot mosaic:

ggplot() +
  # geom_point(data = marilyn_df,
  #            aes(x, 
  #                y, 
  #                color = value)) + 
  geom_sf(data = mosaic_lines,
          color = "red") +
  geom_sf(data = mosaic_lines_1,
          color = "blue")# +
# geom_sf(data = mosaic_lines_2,
#         color = "green") +
# geom_sf(data = mosaic_lines_3,
#         color = "black")

Put together

mosaic_lines <- rbind(mosaic_lines %>%
                        mutate(lines = "0"),
                      mosaic_lines_1 %>%
                        mutate(lines = "1"))#,
# mosaic_lines_2 %>%
#   mutate(lines = "2"),
# mosaic_lines_3 %>%
#   mutate(lines = "3"))

Plot mosaic:

ggplot() +
  # geom_point(data = marilyn_df,
  #            aes(x, 
  #                y, 
  #                color = value)) + 
  geom_sf(data = mosaic_lines,
          color = "red")

Create a blade:

blade <- data.frame(x_start = c(min(marilyn_df$x):max(marilyn_df$x), 
                                rep(min(marilyn_df$y), 
                                    length(min(marilyn_df$y):max(marilyn_df$y)))),
                    x_end = c(min(marilyn_df$x):max(marilyn_df$x), 
                              rep(max(marilyn_df$x), 
                                  length(min(marilyn_df$y):max(marilyn_df$y)))),
                    y_start = c(rep(min(marilyn_df$y), 
                                    length(min(marilyn_df$x):max(marilyn_df$x))),
                                min(marilyn_df$y):max(marilyn_df$y)),
                    y_end = c(rep(max(marilyn_df$y),
                                  length(min(marilyn_df$x):max(marilyn_df$x))),
                              min(marilyn_df$y):max(marilyn_df$y)))

# Shift the blade a small amount to avoid perfect overlap with underlying grid
blade <- blade %>%
  mutate(across(everything(), 
                ~ .x + 0.28))

blade <- pmap(blade, function(x_start, x_end, y_start, y_end){
  st_linestring(
    matrix(
      c(
        x_start,
        y_start,
        x_end,
        y_end),
      ncol = 2,byrow = TRUE)
  )
}) %>%
  st_as_sfc()

Use the blade to split the lines:

mosaic_lines <- mosaic_lines %>%
  st_split(blade)

Extract the geometries:

mosaic_lines <- mosaic_lines %>%
  st_collection_extract(type = "LINESTRING") %>%
  mutate(id = 1:n())

Convert the data frame with the image to simple features. This way we can use functions from the {sf} package to find the nearest feature to borrow the original colors in the image:

marilyn_sf <- marilyn_df %>%
  st_as_sf(coords = c("x", "y"))

Find the nearest feature and borrow color:

value <- marilyn_sf[mosaic_lines %>% 
                      st_nearest_feature(marilyn_sf),] %>%
  pull(value)

We can now add the hexadecimal colors to the data frame with the mosaic:

mosaic_lines$value <- value

Plot mosaic:

ggplot() +
  # geom_point(data = marilyn_df,
  #            aes(x,
  #                y,
  #                color = value)) +
  geom_sf(data = mosaic_lines,
          aes(size = value,
              color = value)) +
  scale_color_distiller(direction = 1) +
  scale_size(range = c(0.05, 0.75)) + 
  coord_sf(expand = FALSE)

ggsave("junk.png")

An alernative

The above does not work super well because there is still too much white space. It works well here because the density of lines is higher (see https://twitter.com/dickie_roper/status/1495166762014412802/photo/1).

So one way to get greater density of lines is to overlap several mosaics.

Load package:

library(imager)
library(purrr)

Read the image using imager::load.image():

marilyn <- load.image("marilyn.jpg")

Image info:

marilyn

This is the image:

plot(marilyn)

Resize image:

marilyn_rs <- imresize(marilyn, scale = 1/4, interpolation = 6)

Convert to data frame:

marilyn_df <- marilyn_rs %>%
  #grayscale() %>% 
  as.data.frame() %>%
  mutate(y = -(y - max(y)))

ggplot() +
  geom_point(data = marilyn_df,
             aes(x, y, color = value)) +
  coord_equal()

Create data frame for the mosaic:

# This will use a smaller subset of points to create the mosaic, which will then be rescaled
s <- 15

xlim <- c(min(marilyn_df$x)/s - 4, max(marilyn_df$x)/s + 4)
ylim <- c(min(marilyn_df$y)/s - 4, max(marilyn_df$y)/s + 4)

# Create a data frame with the spots for tiles
m_1 <- expand.grid(x = seq(xlim[1], xlim[2], 1),
                   y = seq(ylim[1], ylim[2], 1)) %>%
  mutate(tiles = sample(c("dl", "dr"), n(), replace = TRUE),
         scale_p = 1)

Create mosaic using the designed container:

m_1 <- st_truchet_ms(df = m_1)

Plot mosaic:

ggplot() +
  geom_sf(data = m_1 %>% st_truchet_dissolve(),
          aes(fill = color),
          color = "white")

m_2 <- m_1 %>% st_truchet_dissolve()  %>% st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_2 <- m_2[!st_is_empty(m_2), , drop = FALSE]

m_3 <- m_2 %>% st_truchet_dissolve()  %>% st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_3 <- m_3[!st_is_empty(m_3), , drop = FALSE]

m_1_lines <- m_1 %>% 
  st_truchet_dissolve() %>% 
  st_cast(to = "MULTILINESTRING")
m_2_lines <- m_2 %>% 
  st_cast(to = "MULTILINESTRING")
m_3_lines <- m_3 %>% 
  st_cast(to = "MULTILINESTRING")

Plot:

ggplot() +
  geom_sf(data = m_1_lines,
          color = "red") +
  geom_sf(data = m_2_lines,
          color = "blue") +
  geom_sf(data = m_3_lines,
          color = "black")

Now this needs to be scaled to the size of the image. First get the union of the geometries:

m_1_union <- st_union(m_1)
m_2_union <- st_union(m_2)

Then scale and recenter:

m_1_union <- (m_1_lines * s) %>%
  st_sf()
m_2_union <- (m_2_lines * s) %>% 
  st_sf()
m_3_union <- (m_3_lines * s) %>% 
  st_sf()

Plot mosaic:

ggplot() +
  geom_sf(data = m_1_union,
          color = "red") +
  geom_sf(data = m_2_union,
          color = "blue") +
  geom_sf(data = m_3_union,
          color = "yellow")

Put it all together:

mosaic <- rbind(m_1_union,
                m_2_union,
                m_3_union)

Plot mosaic:

ggplot() +
  geom_sf(data = mosaic,
          aes(color = color))

Create a blade:

bbox <- st_bbox(mosaic) %>% 
  round()

blade <- data.frame(x_start = c(bbox$xmin:bbox$xmax, 
                                rep(bbox$ymin, 
                                    length(bbox$ymin:bbox$ymax))),
                    x_end = c(bbox$xmin:bbox$xmax, 
                              rep(bbox$xmax, 
                                  length(bbox$ymin:bbox$ymax))),
                    y_start = c(rep(bbox$ymin, 
                                    length(bbox$xmin:bbox$xmax)),
                                bbox$ymin:bbox$ymax),
                    y_end = c(rep(bbox$ymax,
                                  length(bbox$xmin:bbox$xmax)),
                              bbox$ymin:bbox$ymax))

# Shift the blade a small amount to avoid perfect overlap with underlying grid
blade <- blade %>%
  mutate(across(everything(), 
                ~ .x + 0.28))

blade <- pmap(blade, function(x_start, x_end, y_start, y_end){
  st_linestring(
    matrix(
      c(
        x_start,
        y_start,
        x_end,
        y_end),
      ncol = 2,byrow = TRUE)
  )
}) %>%
  st_as_sfc()

Use the blade to split the lines:

mosaic_lines <- mosaic %>%
  st_split(blade)

Extract the geometries:

mosaic_lines <- mosaic_lines %>%
  st_collection_extract(type = "LINESTRING") %>%
  st_cast(to = "LINESTRING") %>%
  mutate(id = 1:n())

Convert the data frame with the image to simple features. This way we can use functions from the {sf} package to find the nearest feature to borrow the original colors in the image:

marilyn_sf <- marilyn_df %>%
  st_as_sf(coords = c("x", "y"))

Find the nearest feature and borrow color:

value <- marilyn_sf[mosaic_lines %>% 
                      st_nearest_feature(marilyn_sf),] %>%
  pull(value)

We can now add the greyscale value to the data frame with the mosaic:

mosaic_lines$value <- value

Plot mosaic:

ggplot() +
  geom_sf(data = mosaic_lines %>%
            st_crop(marilyn_sf),
          aes(color = value,
              size = exp(-3 * value))) +
  scale_color_gradientn(colors = rev(mex.brewer("Frida"))) +
  scale_size(range = c(0.01, 0.80)) + 
  coord_sf(expand = FALSE) + 
  theme_void() + 
  theme(legend.position = "none",
        plot.margin = margin(0.1, 0.1, 0.1, 0.1, "in"),
        panel.background = element_rect(color = NA,
                                        fill = mex.brewer("Frida")[1]),
        plot.background = element_rect(color = NA,
                                       fill = mex.brewer("Frida")[1]))

ggsave("truchet-marilyn.png",
       height = 7.5,
       width = 5,
       units = "in")

So I think I figured this out. First, we don't need a super dense set of lines. But we need to split those lines very finely so that they can pick up variations in the grayscale values with higher resolution. Secondly, it helps if the resolution of the underlying image is not too low, otherwise the lines tend to blur the detail.

Next, let's do a Dali.

Read the image using imager::load.image():

dali <- load.image("dali.jpg")

Image info:

dali

This is the image:

plot(dali)

Resize image:

dali_rs <- imresize(dali, scale = 3/8, interpolation = 6)

Convert to data frame:

df <- dali_rs %>%
  #grayscale() %>% 
  as.data.frame() %>%
  mutate(y = -(y - max(y)))

Create data frame for the mosaic:

# This will use a smaller subset of points to create the mosaic, which will then be rescaled
s <- 10

xlim <- c(min(df$x)/s - 4, max(df$x)/s + 4)
ylim <- c(min(df$y)/s - 4, max(df$y)/s + 4)

# Create a data frame with the spots for tiles
m_1 <- expand.grid(x = seq(xlim[1], xlim[2], 1),
                   y = seq(ylim[1], ylim[2], 1)) %>%
  mutate(tiles = sample(c("dl", "dr"), n(), replace = TRUE),
         scale_p = 1)

Create mosaic using the designed container:

m_1 <- st_truchet_ms(df = m_1) %>% 
  st_truchet_dissolve()

Dissolve and buffer:

m_2 <- m_1 %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_2 <- m_2[!st_is_empty(m_2), , drop = FALSE]

m_3 <- m_2 %>% 
  st_truchet_dissolve() %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_3 <- m_3[!st_is_empty(m_3), , drop = FALSE]

m_1_lines <- m_1 %>% 
  st_cast(to = "MULTILINESTRING")
m_2_lines <- m_2 %>% 
  st_cast(to = "MULTILINESTRING")
m_3_lines <- m_3 %>% 
  st_cast(to = "MULTILINESTRING")

Now this needs to be scaled to the size of the image. First get the union of the geometries:

m_1_union <- st_union(m_1)
m_2_union <- st_union(m_2)

Then scale and recenter:

m_1_union <- (m_1_lines * s) %>%
  st_sf()
m_2_union <- (m_2_lines * s) %>% 
  st_sf()
m_3_union <- (m_3_lines * s) %>% 
  st_sf()

Put it all together:

mosaic <- rbind(m_1_union,
                m_2_union,
                m_3_union)

Create a blade:

bbox <- st_bbox(mosaic) %>% 
  round()

blade <- data.frame(x_start = c(bbox$xmin:bbox$xmax, 
                                rep(bbox$ymin, 
                                    length(bbox$ymin:bbox$ymax))),
                    x_end = c(bbox$xmin:bbox$xmax, 
                              rep(bbox$xmax, 
                                  length(bbox$ymin:bbox$ymax))),
                    y_start = c(rep(bbox$ymin, 
                                    length(bbox$xmin:bbox$xmax)),
                                bbox$ymin:bbox$ymax),
                    y_end = c(rep(bbox$ymax,
                                  length(bbox$xmin:bbox$xmax)),
                              bbox$ymin:bbox$ymax))

# Shift the blade a small amount to avoid perfect overlap with underlying grid
blade <- blade %>%
  mutate(across(everything(), 
                ~ .x + 0.28))

blade <- pmap(blade, function(x_start, x_end, y_start, y_end){
  st_linestring(
    matrix(
      c(
        x_start,
        y_start,
        x_end,
        y_end),
      ncol = 2,byrow = TRUE)
  )
}) %>%
  st_as_sfc()

Use the blade to split the lines:

mosaic_lines <- mosaic %>%
  st_split(blade)

Extract the geometries:

mosaic_lines <- mosaic_lines %>%
  st_collection_extract(type = "LINESTRING") %>%
  st_cast(to = "LINESTRING") %>%
  mutate(id = 1:n())

Convert the data frame with the image to simple features. This way we can use functions from the {sf} package to find the nearest feature to borrow the original colors in the image:

df_sf <- df %>%
  st_as_sf(coords = c("x", "y"))

Find the nearest feature and borrow color:

value <- df_sf[mosaic_lines %>% 
                 st_nearest_feature(df_sf),] %>%
  pull(value)

We can now add the greyscale value to the data frame with the mosaic:

mosaic_lines$value <- value

Plot mosaic:

ggplot() +
  geom_sf(data = mosaic_lines %>%
            st_crop(df_sf),
          aes(size = exp(-2 * value)),
          color = "black") +
  scale_color_gradientn(colors = rev(mex.brewer("Revolucion"))) +
  scale_size(range = c(0.01, 0.80)) + 
  coord_sf(expand = FALSE) + 
  theme_void() + 
  theme(legend.position = "none",
        plot.margin = margin(0.1, 0.1, 0.1, 0.1, "in"),
        panel.background = element_rect(color = NA,
                                        fill = mex.brewer("Revolucion")[5]),
        plot.background = element_rect(color = NA,
                                       fill = mex.brewer("Revolucion")[5]))

ggsave("truchet-dali.png",
       height = 6.5,
       width = 5,
       units = "in")

And now a Julieta Ovalle.

Read the image using imager::load.image():

julieta <- load.image("julieta.jpg")

Image info:

julieta

This is the image:

plot(julieta)

Resize image:

julieta_rs <- imresize(julieta, scale = 1/8, interpolation = 6)

Convert to data frame:

df <- julieta_rs %>%
  grayscale() %>% 
  as.data.frame() %>%
  mutate(y = -(y - max(y)))

This time, though, we also convert image to a data frame but retrieve the colors:

color_df <- julieta_rs %>%
  as.data.frame(wide="c") %>% 
  # Reverse the y axis
  mutate(y = -(y - max(y)),
         hex_color = rgb(c.1,
                         c.2,
                         c.3))

Create data frame for the mosaic:

# This will use a smaller subset of points to create the mosaic, which will then be rescaled
s <- 10

xlim <- c(min(df$x)/s - 4, max(df$x)/s + 4)
ylim <- c(min(df$y)/s - 4, max(df$y)/s + 4)

# Create a data frame with the spots for tiles
m_1 <- expand.grid(x = seq(xlim[1], xlim[2], 1),
                   y = seq(ylim[1], ylim[2], 1)) %>%
  mutate(tiles = sample(c("dl", "dr"), n(), replace = TRUE),
         scale_p = 1)

Create mosaic using the designed container:

m_1 <- st_truchet_ms(df = m_1) %>% 
  st_truchet_dissolve()

Dissolve and buffer:

m_2 <- m_1 %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_2 <- m_2[!st_is_empty(m_2), , drop = FALSE]

m_3 <- m_2 %>% 
  st_truchet_dissolve() %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_3 <- m_3[!st_is_empty(m_3), , drop = FALSE]

m_1_lines <- m_1 %>% 
  st_cast(to = "MULTILINESTRING")
m_2_lines <- m_2 %>% 
  st_cast(to = "MULTILINESTRING")
m_3_lines <- m_3 %>% 
  st_cast(to = "MULTILINESTRING")

Now this needs to be scaled to the size of the image. First get the union of the geometries:

m_1_union <- st_union(m_1)
m_2_union <- st_union(m_2)

Then scale and recenter:

m_1_union <- (m_1_lines * s) %>%
  st_sf()
m_2_union <- (m_2_lines * s) %>% 
  st_sf()
m_3_union <- (m_3_lines * s) %>% 
  st_sf()

Put it all together:

mosaic <- rbind(m_1_union,
                m_2_union,
                m_3_union)

Create a blade:

bbox <- st_bbox(mosaic) %>% 
  round()

blade <- data.frame(x_start = c(bbox$xmin:bbox$xmax, 
                                rep(bbox$ymin, 
                                    length(bbox$ymin:bbox$ymax))),
                    x_end = c(bbox$xmin:bbox$xmax, 
                              rep(bbox$xmax, 
                                  length(bbox$ymin:bbox$ymax))),
                    y_start = c(rep(bbox$ymin, 
                                    length(bbox$xmin:bbox$xmax)),
                                bbox$ymin:bbox$ymax),
                    y_end = c(rep(bbox$ymax,
                                  length(bbox$xmin:bbox$xmax)),
                              bbox$ymin:bbox$ymax))

# Shift the blade a small amount to avoid perfect overlap with underlying grid
blade <- blade %>%
  mutate(across(everything(), 
                ~ .x + 0.28))

blade <- pmap(blade, function(x_start, x_end, y_start, y_end){
  st_linestring(
    matrix(
      c(
        x_start,
        y_start,
        x_end,
        y_end),
      ncol = 2,byrow = TRUE)
  )
}) %>%
  st_as_sfc()

Use the blade to split the lines:

mosaic_lines <- mosaic %>%
  st_split(blade)

Extract the geometries:

mosaic_lines <- mosaic_lines %>%
  st_collection_extract(type = "LINESTRING") %>%
  st_cast(to = "LINESTRING") %>%
  mutate(id = 1:n())

Convert the data frames with the image to simple features. This way we can use functions from the {sf} package to find the nearest feature to borrow the original colors in the image:

df_sf <- df %>%
  st_as_sf(coords = c("x", "y"))

color_df_sf <- color_df %>%
  st_as_sf(coords = c("x", "y"))

Find the nearest feature and borrow tones of gray and hexadecimal colors:

value <- df_sf[mosaic_lines %>% 
                 st_nearest_feature(df_sf),] %>%
  pull(value)

hex_color <- color_df_sf[mosaic_lines %>% 
                           st_nearest_feature(color_df_sf),] %>%
  pull(hex_color)

We can now add the greyscale values and hexadecimal colors to the data frame with the mosaic:

mosaic_lines$value <- value
mosaic_lines$hex_color <- hex_color

Plot mosaic:

ggplot() +
  geom_sf(data = mosaic_lines %>%
            st_crop(df_sf),
          aes(color = hex_color,
              size = exp(-2 * value))) +
  scale_color_identity() +
  scale_size(range = c(0.01, 0.80)) + 
  coord_sf(expand = FALSE) + 
  theme_void() + 
  theme(legend.position = "none",
        plot.margin = margin(0.1, 0.1, 0.1, 0.1, "in"),
        panel.background = element_rect(color = NA,
                                        fill = mex.brewer("Revolucion")[5]),
        plot.background = element_rect(color = NA,
                                       fill = mex.brewer("Revolucion")[5]))

ggsave("truchet-ovalle.png",
       height = 6.5,
       width = 5,
       units = "in")

Plot mosaic:

ggplot() +
  geom_sf(data = mosaic_lines %>%
            st_crop(df_sf),
          aes(color = hex_color,
              size = exp(-2 * value))) +
  scale_color_identity() +
  scale_size(range = c(0.01, 0.80)) + 
  coord_sf(expand = FALSE) + 
  theme_void() + 
  theme(legend.position = "none",
        plot.margin = margin(0.1, 0.1, 0.1, 0.1, "in"),
        panel.background = element_rect(color = NA,
                                        fill = "white"),
        plot.background = element_rect(color = NA,
                                       fill = "white"))

ggsave("truchet-ovalle-w.png",
       height = 6.5,
       width = 5,
       units = "in")

A more complex example with mutliple containers

Read the image using imager::load.image():

clouds <- load.image("clouds.jpg")

Image info:

clouds

clouds_rs <- imresize(clouds, scale = 1/10, interpolation = 6)

clouds.g <- grayscale(clouds_rs)

Convert to data frame:

df <- clouds_rs %>%
  grayscale() %>% 
  as.data.frame() %>%
  mutate(y = -(y - max(y)))

This time, though, we also convert image to a data frame but retrieve the colors:

color_df <- clouds_rs %>%
  as.data.frame(wide="c") %>% 
  # Reverse the y axis
  mutate(y = -(y - max(y)),
         hex_color = rgb(c.1,
                         c.2,
                         c.3))

Bind grayscale and hexadecimal colors in the same data frame:

df <- cbind(df,
            color_df %>%
              select(hex_color))

Convert the data frame to simple features:

df_sf <- df %>%
  st_as_sf(coords = c("x", "y")) %>%
  cbind(df %>% select(x, y))

Identify paths for blades to split image:

im <- clouds.g

##The following function makes a data.frame of links between pixel (x,y) and pixel (x+dx,y+dy)
##I'm sure there's a better way of doing things
make.df <- function(dx,dy){
  (abs(im-imshift(im,dx,dy))) %>%
    as.data.frame() %>%
    mutate(x.to = x-dx, y.to = y-dy, id.from = paste(x,y,sep=","), id.to = paste(x.to,y.to,sep=",")) %>%
    dplyr::select(id.from, id.to, value) %>%
    dplyr::rename(weight=value)}

# Path 1
## Get all neighbours, convert data.frame to graph
G <- cross2(-1:1,-1:1,function(a,b) abs(a) +abs(b) == 0) %>%
  map_df(lift(function(dx,dy) mutate(make.df(dx,dy),dx=dx,dy=dy))) %>%
  mutate(weight = 1/(weight + 0.01)^7)#exp(-0.05 * weight))

G <- G %>%
  graph_from_data_frame()

#Extract shortest paths
path_1 <- shortest_paths(G,"1,140","258,150") %$% V(G)[vpath[[1]]]%>%
  names %>% stringr::str_split(",") %>%
  map_df(~ data.frame(x=as.integer(.[[1]]),y=as.integer(.[[2]])))

# Path 2
## Get all neighbours, convert data.frame to graph
G <- cross2(-1:1,-1:1,function(a,b) abs(a) +abs(b) == 0) %>%
  map_df(lift(function(dx,dy) mutate(make.df(dx,dy),dx=dx,dy=dy))) %>%
  mutate(weight = 1/(weight + 0.01)^1)#exp(-0.05 * weight))

G <- G %>%
  graph_from_data_frame()

#Extract shortest paths
path_2 <- shortest_paths(G,"1,150","258,150") %$% V(G)[vpath[[1]]]%>%
  names %>% stringr::str_split(",") %>%
  map_df(~ data.frame(x=as.integer(.[[1]]),y=as.integer(.[[2]])))

# Path 3
## Get all neighbours, convert data.frame to graph
G <- cross2(-1:1,-1:1,function(a,b) abs(a) +abs(b) == 0) %>%
  map_df(lift(function(dx,dy) mutate(make.df(dx,dy),dx=dx,dy=dy))) %>%
  mutate(weight = 1/(weight + 0.01)^2)#exp(-0.05 * weight))

G <- G %>%
  graph_from_data_frame()

#Extract shortest paths
path_3 <- shortest_paths(G,"1,205","258,200") %$% V(G)[vpath[[1]]]%>%
  names %>% stringr::str_split(",") %>%
  map_df(~ data.frame(x=as.integer(.[[1]]),y=as.integer(.[[2]])))

Check the paths:

plot(im)
lines(path_1$x,path_1$y,col="green",lty=2,lwd=2)
lines(path_2$x,path_2$y,col="red",lty=2,lwd=2)
lines(path_3$x,path_3$y,col="blue",lty=2,lwd=2)

Reverse the y axis of the paths and shift the y coordinates:

path_1 <- path_1 %>%
  mutate(y = -(y - max(y)) + 107)

path_2 <- path_2 %>%
  mutate(y = -(y - max(y)) + 68)

path_3 <- path_3 %>%
  mutate(y = -(y - max(y)) + 30)

Convert paths to simple features:

path_1 <- data.frame(path = "1", 
                     st_linestring(x = as.matrix(path_1)) %>%
                       st_geometry()) %>%
  st_sf()

path_2 <- data.frame(path = "2", 
                     st_linestring(x = as.matrix(path_2)) %>%
                       st_geometry()) %>%
  st_sf()

path_3 <- data.frame(path = "3", 
                     st_linestring(x = as.matrix(path_3)) %>%
                       st_geometry()) %>%
  st_sf()


# Put together
paths <- rbind(path_1 ,
               path_2,
               path_3) %>%
  # Simplify paths
  st_simplify(dTolerance = 2)

Create container:

container <- matrix(c(min(df$x) + 1, min(df$y) + 2,
                      min(df$x) + 1, max(df$y) - 2,
                      max(df$x) - 2, max(df$y) - 2,
                      max(df$x) - 2, min(df$y) + 2,
                      min(df$x) + 1, min(df$y) + 2),
                    ncol = 2,
                    byrow = TRUE)

# Convert coordinates to polygons and then to simple features
container <- data.frame(geometry = sf::st_polygon(list(container)) %>%
                          sf::st_sfc()) %>%
  sf::st_as_sf()

Plot container and paths

ggplot() + 
  # geom_sf(data = df_sf,
  #         aes(color = value)) +
  geom_sf(data  = paths,
          aes(color = path)) + 
  geom_sf(data = container,
          color = "purple",
          fill = NA)

Use the paths to split the container:

container <- container %>%
  st_split(paths) %>%
  st_collection_extract() %>%
  mutate(id = 1:n())

Plot:

ggplot() +
  geom_sf(data = container,
          aes(fill = factor(id)))

Spatial join the data frame with the image. Create buffers of the parts of the cointainer to have some overlap between the mosaics to avoid blanks in the final mosaic:

df_sf <- df_sf %>%
  st_join(container)

df_1_sf <- df_sf %>%
  select(-id) %>%
  st_join(container %>%
            filter(id == "1") %>%
            st_buffer(dist = 10))

df_2_sf <- df_sf %>%
  select(-id) %>%
  st_join(container %>%
            filter(id == "2") %>%
            st_buffer(dist = 10))

df_3_sf <- df_sf %>%
  select(-id) %>%
  st_join(container %>%
            filter(id == "3") %>%
            st_buffer(dist = 10))

df_4_sf <- df_sf %>%
  select(-id) %>%
  st_join(container %>%
            filter(id == "4") %>%
            st_buffer(dist = 10))

ggplot() + 
  geom_sf(data = df_1_sf %>% 
            filter(x %% 5 == 0, 
                   y %% 5 == 0),
          aes(color = id,
              shape = factor(id)))  + 
  geom_sf(data = df_2_sf %>% 
            filter(x %% 5 == 0, 
                   y %% 5 == 0),
          aes(color = id,
              shape = factor(id))) + 
  geom_sf(data = df_3_sf %>% 
            filter(x %% 5 == 0, 
                   y %% 5 == 0),
          aes(color = id,
              shape = factor(id))) + 
  geom_sf(data = df_4_sf %>% 
            filter(x %% 5 == 0, 
                   y %% 5 == 0),
          aes(color = id,
              shape = factor(id)))

Create data frames for the mosaic:

# This will use a smaller subset of points to create the mosaic, which will then be rescaled
s <- 15

# Create a data frame with the spots for tiles
m_4 <- df_4_sf %>%
  filter(id == 4, 
         x %% s == 0, 
         y %% s == 0) %>%
  mutate(x = x/s,
         y = y/s,
         tiles = sample(c("-", "|", "tn"), n(), replace = TRUE),
         scale_p = 1)

m_3 <- df_3_sf %>%
  filter(id == 3, 
         x %% s == 0, 
         y %% s == 0) %>%
  mutate(x = x/s,
         y = y/s,
         tiles = sample(c("fse", "fsw", "+"), n(), replace = TRUE),
         scale_p = 1)

m_2 <- df_2_sf %>%
  filter(id == 2, 
         x %% s == 0, 
         y %% s == 0) %>%
  mutate(x = x/s,
         y = y/s,
         tiles = sample(c("dl", "dr"), n(), replace = TRUE),
         scale_p = 1)

m_1 <- df_1_sf %>%
  filter(id == 1, 
         x %% s == 0, 
         y %% s == 0) %>%
  mutate(x = x/s,
         y = y/s,
         tiles = sample(c("fne", "fnw", "+"), n(), replace = TRUE),
         scale_p = 1)

Create mosaic using the designed container:

# Part 4
m_4 <- st_truchet_ms(df = m_4 %>% 
                       st_drop_geometry()) %>%
  st_truchet_dissolve()

# Part 3
m_3 <- st_truchet_ms(df = m_3 %>% 
                       st_drop_geometry()) %>%
  st_truchet_dissolve()

# Part 2
m_2 <- st_truchet_ms(df = m_2 %>% 
                       st_drop_geometry()) %>%
  st_truchet_dissolve()

# Part 1
m_1 <- st_truchet_ms(df = m_1 %>% 
                       st_drop_geometry()) %>%
  st_truchet_dissolve()

Plot:

ggplot() + 
  geom_sf(data = m_4) + 
  geom_sf(data = m_3) + 
  geom_sf(data = m_2) + 
  geom_sf(data = m_1)

Dissolve and buffer:

# Container 4
m_4b1 <- m_4 %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_4b1 <- m_4b1[!st_is_empty(m_4b1), , drop = FALSE]

m_4b2 <- m_4b1 %>% 
  st_truchet_dissolve() %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_4b2 <- m_4b2[!st_is_empty(m_4b2), , drop = FALSE]

# Container 3
m_3b1 <- m_3 %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_3b1 <- m_3b1[!st_is_empty(m_3b1), , drop = FALSE]

m_3b2 <- m_3b1 %>% 
  st_truchet_dissolve() %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_3b2 <- m_3b2[!st_is_empty(m_3b2), , drop = FALSE]

# Container 2
m_2b1 <- m_2 %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_2b1 <- m_2b1[!st_is_empty(m_2b1), , drop = FALSE]

m_2b2 <- m_2b1 %>% 
  st_truchet_dissolve() %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_2b2 <- m_2b2[!st_is_empty(m_2b2), , drop = FALSE]

# Container 1
m_1b1 <- m_1 %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_1b1 <- m_1b1[!st_is_empty(m_1b1), , drop = FALSE]

m_1b2 <- m_1b1 %>% 
  st_truchet_dissolve() %>% 
  st_buffer(dist = -0.1) %>%
  mutate(color = color + 2)

m_1b2 <- m_1b2[!st_is_empty(m_1b2), , drop = FALSE]

m_4_lines <- rbind(m_4 %>% 
                     st_cast(to = "MULTILINESTRING"),
                   m_4b1 %>%
                     st_cast(to = "MULTILINESTRING"),
                   m_4b2 %>% 
                     st_cast(to = "MULTILINESTRING"))

m_3_lines <- rbind(m_3 %>% 
                     st_cast(to = "MULTILINESTRING"),
                   m_3b1 %>%
                     st_cast(to = "MULTILINESTRING"),
                   m_3b2 %>% 
                     st_cast(to = "MULTILINESTRING"))

m_2_lines <- rbind(m_2 %>% 
                     st_cast(to = "MULTILINESTRING"),
                   m_2b1 %>%
                     st_cast(to = "MULTILINESTRING"),
                   m_2b2 %>% 
                     st_cast(to = "MULTILINESTRING"))

m_1_lines <- rbind(m_1 %>% 
                     st_cast(to = "MULTILINESTRING"),
                   m_1b1 %>%
                     st_cast(to = "MULTILINESTRING"),
                   m_1b2 %>% 
                     st_cast(to = "MULTILINESTRING"))

Then scale and recenter:

m_4_union <- (m_4_lines * s) %>%
  st_sf()

m_3_union <- (m_3_lines * s) %>% 
  st_sf()

m_2_union <- (m_2_lines * s) %>% 
  st_sf()

m_1_union <- (m_1_lines * s) %>% 
  st_sf()

ggplot() + 
  geom_sf(data = m_4_union,
          color = "blue") + 
  geom_sf(data = m_3_union,
          color = "green") + 
  geom_sf(data = m_2_union,
          color = "red") + 
  geom_sf(data = m_1_union,
          color = "orange")

Put it all together:

# mosaic <- rbind(m_1_union,
#                 m_2_union,
#                 m_3_union,
#                 m_4_union)

Create a grid for the blade:

bbox <- st_bbox(mosaic) %>% 
  round()

blade <- data.frame(x_start = c(bbox$xmin:bbox$xmax, 
                                rep(bbox$ymin, 
                                    length(bbox$ymin:bbox$ymax))),
                    x_end = c(bbox$xmin:bbox$xmax, 
                              rep(bbox$xmax, 
                                  length(bbox$ymin:bbox$ymax))),
                    y_start = c(rep(bbox$ymin, 
                                    length(bbox$xmin:bbox$xmax)),
                                bbox$ymin:bbox$ymax),
                    y_end = c(rep(bbox$ymax,
                                  length(bbox$xmin:bbox$xmax)),
                              bbox$ymin:bbox$ymax))

# Shift the blade a small amount to avoid perfect overlap with underlying grid
blade <- blade %>%
  mutate(across(everything(), 
                ~ .x + 0.28))

blade <- pmap(blade, function(x_start, x_end, y_start, y_end){
  st_linestring(
    matrix(
      c(
        x_start,
        y_start,
        x_end,
        y_end),
      ncol = 2,byrow = TRUE)
  )
}) %>%
  st_as_sfc()

Use the blade and the paths to split the lines:

# Part 1
mosaic_lines_1 <- m_1_union %>%
  st_split(blade) %>%
  st_collection_extract(type = "LINESTRING") %>%
  st_cast(to = "LINESTRING") %>%
  st_split(paths) %>%
  st_collection_extract(type = "LINESTRING") %>%
  st_cast(to = "LINESTRING") %>%
  mutate(id = "1")

# Part 2
mosaic_lines_2 <- m_2_union %>%
  st_split(blade) %>%
  st_collection_extract(type = "LINESTRING") %>%
  st_cast(to = "LINESTRING") %>%
  st_split(paths) %>%
  st_collection_extract(type = "LINESTRING") %>%
  st_cast(to = "LINESTRING") %>%
  mutate(id = "2")

# Part 3
mosaic_lines_3 <- m_3_union %>%
  st_split(blade) %>%
  st_collection_extract(type = "LINESTRING") %>%
  st_cast(to = "LINESTRING") %>%
  st_split(paths) %>%
  st_collection_extract(type = "LINESTRING") %>%
  st_cast(to = "LINESTRING") %>%
  mutate(id = "3")

# Part 4
mosaic_lines_4 <- m_4_union %>%
  st_split(blade) %>%
  st_collection_extract(type = "LINESTRING") %>%
  st_cast(to = "LINESTRING") %>%
  st_split(paths) %>%
  st_collection_extract(type = "LINESTRING") %>%
  st_cast(to = "LINESTRING") %>%
  mutate(id = "4")

Extract the geometries and select the line segments that are within each of the container polygons:

# mosaic_lines_1 <- mosaic_lines_1[container %>% filter(id == "1"),]
# 
#mosaic_lines_2 <- mosaic_lines_2[container %>% filter(id == "2"),]

#mosaic_lines_3 <- mosaic_lines_3[container %>% filter(id == "3"),]
# 
# mosaic_lines_4 <- mosaic_lines_4[container %>% filter(id == "4"),]

Put together:

# mosaic_lines <- rbind(mosaic_lines_1[container %>% filter(id == "1"),],
#                       mosaic_lines_2[container %>% filter(id == "2"),],
#                       mosaic_lines_3[container %>% filter(id == "3"),],
#                       mosaic_lines_4[container %>% filter(id == "4"),])
mosaic_lines <- rbind(mosaic_lines_1,
                      mosaic_lines_2[container %>% filter(id == "2"),],
                      mosaic_lines_3[container %>% filter(id == "3"),],
                      mosaic_lines_4)

Find the nearest feature and borrow tones of gray and hexadecimal colors:

colors_df <- df_sf[mosaic_lines %>% 
                     st_nearest_feature(df_sf),]

We can now add the greyscale values and hexadecimal colors to the data frame with the mosaic:

mosaic_lines$value <- colors_df$value
mosaic_lines$hex_color <- colors_df$hex_color

Create parts of mosaic:

sky_1 <- container %>% 
  filter(id == 4) %>% 
  st_buffer(dist = 3) %>% 
  st_crop(container)

sky_2 <- container %>% 
  filter(id == 1) %>% 
  st_buffer(dist = 9) %>% 
  st_crop(container)

cloud <- container %>% 
  filter(id == 2) %>% 
  st_buffer(dist = 9) %>% 
  st_crop(container)

Plot mosaic (monotone):

ggplot() +
  geom_sf(data = cloud,
          color = NA,
          fill = "white") +
  geom_sf(data = mosaic_lines %>%
            filter(id == 2 | id == 3) %>%
            st_crop(df_sf),
          aes(size = exp(-5 * value),
              color = value)) +
  scale_size(range = c(0.01, 1.3)) + 
  ggnewscale::new_scale("size") +
  geom_sf(data = sky_2,
          color = "black",
          fill = "deepskyblue4") +
  geom_sf(data = mosaic_lines[sky_2,] %>%
            filter(id == "1") %>%
            st_crop(df_sf),
          aes(size = exp(1 * value)),
          color = "white") +
  scale_size(range = c(0.01, 0.3)) +
  geom_sf(data = sky_1, 
          color = "black",
          fill = "goldenrod2") +
  geom_sf(data = mosaic_lines[sky_1,] %>%
            filter(id == "4") %>%
            st_crop(df_sf),
          aes(size = exp(1 * value)),
          color = "white") +
  coord_sf(expand = FALSE) + 
  theme_void() + 
  theme(legend.position = "none",
        plot.margin = margin(0.1, 0.1, 0.1, 0.1, "in"))

ggsave("truchet-clouds-monotone.png",
       height = 7,
       width = 7,
       units = "in")


paezha/truchet documentation built on April 27, 2022, 9:53 a.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close