# Overlapping lines

## Overlapping lines for interesting image effect

While convex hulls can produce some interesting results (See parts 1, 2, 3, 4 ) they’re expensive to compute relative to just drawing lines.

The same idea using lines is 1000x faster and the results are just as good:

• Sample points from the image (with darker pixels having a higher probability of being sampled)
• Find the distance between successive points and filter out line segments which are too long
• Draw a single poly-line connecting all the remaining points

## Code

``````#-----------------------------------------------------------------------------
# Read a jpg file using image magick and scale it and convert to greyscale
#-----------------------------------------------------------------------------
filename <- 'data/mona.jpg'
magick::image_convert(type='grayscale') %>%
magick::image_scale(geometry="75%") %>%
magick::image_flip()

#-----------------------------------------------------------------------------
# Extract just the numeric matrix representing the image.
#-----------------------------------------------------------------------------
m <- magick::as_EBImage(im)@.Data

#-----------------------------------------------------------------------------
# Set up plot configuration
#-----------------------------------------------------------------------------
par(mar = c(0, 0, 0, 0))

xlim          <- c(0, dim(m)[1])
ylim          <- c(0, dim(m)[2])
width         <- 4
height        <- 6
dpi           <- 200

#-----------------------------------------------------------------------------
# how many objects in each frame?
#-----------------------------------------------------------------------------
nobjects_ <- c(
seq(    2,     20 - 1,     1),
seq(   20,    200 - 1,    10),
seq(  200,   2000 - 1,   100),
seq( 2000,  50000 - 1,  1000),
seq(50000,  90000 - 1,  5000),
seq(90000, 100000    ,   500)
)

#-----------------------------------------------------------------------------
# What alpha level for each frame?  The more objects there are,
# the lower the alpha to ensure the overlap looks good.
#-----------------------------------------------------------------------------
col_ <- nobjects_ %>% purrr::map_dbl(~1 - (log10(.x)/5 - log10(1.9)/5)^0.2) %>%
purrr::map_chr(~gray(0, .x))

#-----------------------------------------------------------------------------
# Sample all the points necessary for the maximum nobjects and include
# a 10x factor since I know I'm going to filter out lots of the generated points
#-----------------------------------------------------------------------------
all_indices <- sample(seq(m), size = 10 * max(nobjects_ + 10), prob = (1-m)^2, replace = TRUE)
all_points  <- arrayInd(all_indices, .dim=dim(m))

#-----------------------------------------------------------------------------
# Now filter the successive points so that it's biased towards shorter
# line segments
#-----------------------------------------------------------------------------
max_dist <- sqrt(nrow(m)^2 + ncol(m)^2)

pts <- as.data.frame(all_points) %>%
as.tbl() %>%
set_names(c('x', 'y')) %>%
mutate(
val  = 1 - m[all_indices]
)

for (i in 1:20) {
pts %<>% mutate(
sdist = dist/max_dist,
keep  = val > 2.5 * sdist
)

pts %<>% filter(
is.na(keep) | keep
)
}

#-----------------------------------------------------------------------------
# Draw each frame
#-----------------------------------------------------------------------------
for (i in seq(nobjects_)) {
nobjects <- nobjects_[i]
col      <- col_[i]

plot_points <- pts[seq(1+nobjects),c('x', 'y')]

#-----------------------------------------------------------------------------
# Plot lines and save
#-----------------------------------------------------------------------------
plot_filename <- sprintf("plot//mona2/plot_%06i.png", nobjects)
withr::with_png(plot_filename, width=width*dpi, height=height*dpi, {
plot(1, type="n", xlab="", ylab="", xlim=xlim, ylim=ylim, asp=1, ann=FALSE,
axes = FALSE, frame.plot = FALSE)

lines(plot_points, col=col)
})
}``````