Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
require("sf")
require("dplyr")
require("hexbin")
# Linux libertine font "sf", converted to path with Inkscape,
# added points between existing points 2 times, then turned all segments into straight lines.
# Saved as SVG with absolute coordinates (Preferences > SVG Output > Path Data).
# Loaded coords from SVG source code, remove letters from start and end, and replace " " with ","
coords_f <- c(218.1169,163.46992,215.56952,177.96334,213.51976,189.84421,211.82546,200.33884,210.34442,210.67351,208.24728,226.35176,205.51032,243.54066,201.92029,259.27223,197.26391,270.57846,195.45112,272.90665,193.28288,274.70167,190.97247,275.85687,188.73314,276.26564,187.03291,276.03164,185.79476,275.38887,184.84097,274.42619,183.99382,273.23248,182.45947,271.13533,180.24976,269.10927,177.54243,267.58084,174.51519,266.97658,171.25987,267.58973,169.08867,269.18036,167.87718,271.37526,167.501,273.8012,168.44294,277.0032,171.48203,279.79643,176.93817,281.77214,185.13126,282.52154,191.01986,281.80176,196.83737,279.60686,202.29944,275.88354,207.12169,270.57846,210.87463,263.5702,214.6809,252.47427,218.87815,235.97553,223.80408,212.7588,226.10561,201.56217,228.42491,190.15226,230.70867,178.52909,232.90357,166.69265,233.04575,165.88697,233.18793,165.08128,233.33011,164.2756,233.47229,163.46992,237.87985,163.46992,242.28741,163.46992,246.69498,163.46992,251.10254,163.46992,252.53915,163.32774,254.06462,162.9012,255.34127,162.1903,256.03143,161.19504,256.17953,160.57004,256.50536,159.18083,256.8312,157.75608,256.9793,157.02445,256.90525,156.63642,256.67124,156.33725,256.25951,156.14471,255.65229,156.07658,250.43904,156.07658,245.22579,156.07658,240.01255,156.07658,234.7993,156.07658,235.32062,153.37517,235.84194,150.67376,236.36327,147.97235,236.88459,145.27094,238.01314,140.01919,239.37273,135.10511,240.91005,130.58202,242.57177,126.50325,246.57649,119.17508,251.00776,114.51278,255.15466,112.05426,258.3063,111.33744,261.1647,111.5744,263.25888,112.38009,264.67772,113.89667,265.51006,116.26633,266.31574,119.50683,267.83233,122.56962,270.41526,124.85041,274.41998,125.74496,277.94485,124.97778,280.15455,123.16203,281.29791,121.02638,281.62374,119.29949,280.11012,113.8789,275.77068,109.34692,268.90756,106.23675,259.82288,105.08154,254.79625,105.67099,248.33004,107.66447,241.40176,111.39964,234.98887,117.21419,230.32953,124.27281,226.29222,133.44635,222.85918,144.2194,220.01263,156.07658,216.88468,156.21876,213.75673,156.36094,210.62878,156.50312,207.50083,156.6453,205.20522,157.01556,203.63829,157.75904,202.67562,158.75133,202.1928,159.86804,201.99434,160.5582,201.74257,161.55049,201.52633,162.50724,201.43451,163.09077,201.53226,163.30997,201.78996,163.42253,202.15429,163.464,202.57194,163.46992,206.45818,163.46992,210.34442,163.46992,214.23066,163.46992)
# close the ring
coords_f <- c(coords_f, coords_f[1:2])
coords_s <- c(148.44601,239.29898,149.15691,239.29898,149.8678,239.29898,150.5787,239.29898,151.2896,239.29898,163.7777,237.48027,173.13785,232.42697,179.0146,224.74335,181.05251,215.03368,179.98024,208.33939,176.31319,201.43184,169.37602,194.02666,158.49337,185.83949,154.90926,183.04033,152.56922,180.2234,151.29553,177.22874,150.91046,173.89641,151.63024,168.99418,153.82514,164.67844,157.54846,161.60677,162.85354,160.43675,166.10589,160.73592,168.6829,161.69267,170.47791,163.39586,171.38431,165.93436,172.29366,169.39406,174.10941,172.5694,176.7427,174.89167,180.10465,175.79214,183.41032,175.21157,185.50747,173.70684,186.60936,171.63339,186.92926,169.34667,185.20533,164.09788,180.53118,159.20453,173.65325,155.59081,165.31798,154.18086,154.21317,156.25727,145.86309,161.69268,140.60541,169.29632,138.77781,177.87744,139.622,183.66533,142.40339,189.63094,147.49519,195.73873,155.27063,201.95316,161.31622,206.93833,164.82035,211.55028,166.4406,215.62905,166.83456,219.0147,165.51644,225.60531,161.97676,229.93883,156.83757,232.31737,150.72089,233.04308,147.4478,232.82981,145.01001,232.04783,143.38976,230.48385,142.56926,227.92462,141.73692,224.51527,140.03373,221.26588,137.37083,218.83402,133.65935,217.87727,130.24408,218.62075,128.09065,220.4128,126.96803,222.59585,126.64516,224.51231,128.2121,229.6752,132.64039,234.25161,139.52129,237.65503)
coords_s <- c(coords_s, coords_s[1:2])
# create sf objects from letters
rot = function(a) matrix(c(cos(a), sin(a), -sin(a), cos(a)), 2, 2)
matrix_s <- matrix(coords_s, ncol = 2, byrow = TRUE)
matrix_s <- apply(apply(matrix_s, 1, rev), 1, rev)
letter_s <- st_polygon(list(matrix_s))
matrix_f <- matrix(coords_f, ncol = 2, byrow = TRUE)
matrix_f <- apply(apply(matrix_f, 1, rev), 1, rev)
letter_f <- st_polygon(list(matrix_f))
letter_sf <- st_sfc(st_union(letter_s, letter_f))
letter_sf <- ((letter_sf - st_centroid(letter_sf)) * rot(pi/2)) * 1.5
letters_bbox <- st_bbox(st_union(letter_s, letter_f))
coords_hex <- hexcoords(dx = letters_bbox[["xmax"]] - letters_bbox[["xmin"]],
dy = letters_bbox[["ymax"]] - letters_bbox[["ymin"]])
corners <- tibble(x = coords_hex$x, y = coords_hex$y)
corners <- rbind(corners, corners[1,])
hexagon <- st_polygon(list(as.matrix(corners), as.matrix(corners) * 0.94))
laea = st_crs("+proj=laea +lat_0=30 +lon_0=30") # Lambert equal area
letter_sf = letter_sf * 1e4
st_crs(letter_sf) = laea
corners = st_sfc(st_polygon(list(as.matrix(corners))) * 1e4, crs = laea)
hexagon = st_sfc(hexagon * 1e4, crs = laea)
png("sf-hexagon.png")
opar = par(mar = rep(0,4))
st_graticule(st_bbox(hexagon), lon = seq(-32,80,8)) %>%
st_geometry %>%
st_intersection(corners) %>%
plot(asp = .7, col = "gray42")
plot(hexagon, col = "grey", rule = "evenodd", add = TRUE)
plot(st_buffer(letter_sf, dist = 10 * 1e4), col = sf.colors()[1], add = TRUE)
plot(letter_sf, add = TRUE, col = sf.colors()[2], border = "gray", lwd = 3)
@edzer

This comment has been minimized.

Copy link
Owner Author

edzer commented Jan 11, 2018

sf-hexagon

@edzer

This comment has been minimized.

Copy link
Owner Author

edzer commented Jan 12, 2018

require("sf")
require("dplyr")
require("hexbin")
require("animation")

# Linux libertine font "sf", converted to path with Inkscape,
# added points between existing points 2 times, then turned all segments into straight lines.
# Saved as SVG with absolute coordinates (Preferences > SVG Output > Path Data).
# Loaded coords from SVG source code, remove letters from start and end, and replace " " with ","
coords_f <- c(218.1169,163.46992,215.56952,177.96334,213.51976,189.84421,211.82546,200.33884,210.34442,210.67351,208.24728,226.35176,205.51032,243.54066,201.92029,259.27223,197.26391,270.57846,195.45112,272.90665,193.28288,274.70167,190.97247,275.85687,188.73314,276.26564,187.03291,276.03164,185.79476,275.38887,184.84097,274.42619,183.99382,273.23248,182.45947,271.13533,180.24976,269.10927,177.54243,267.58084,174.51519,266.97658,171.25987,267.58973,169.08867,269.18036,167.87718,271.37526,167.501,273.8012,168.44294,277.0032,171.48203,279.79643,176.93817,281.77214,185.13126,282.52154,191.01986,281.80176,196.83737,279.60686,202.29944,275.88354,207.12169,270.57846,210.87463,263.5702,214.6809,252.47427,218.87815,235.97553,223.80408,212.7588,226.10561,201.56217,228.42491,190.15226,230.70867,178.52909,232.90357,166.69265,233.04575,165.88697,233.18793,165.08128,233.33011,164.2756,233.47229,163.46992,237.87985,163.46992,242.28741,163.46992,246.69498,163.46992,251.10254,163.46992,252.53915,163.32774,254.06462,162.9012,255.34127,162.1903,256.03143,161.19504,256.17953,160.57004,256.50536,159.18083,256.8312,157.75608,256.9793,157.02445,256.90525,156.63642,256.67124,156.33725,256.25951,156.14471,255.65229,156.07658,250.43904,156.07658,245.22579,156.07658,240.01255,156.07658,234.7993,156.07658,235.32062,153.37517,235.84194,150.67376,236.36327,147.97235,236.88459,145.27094,238.01314,140.01919,239.37273,135.10511,240.91005,130.58202,242.57177,126.50325,246.57649,119.17508,251.00776,114.51278,255.15466,112.05426,258.3063,111.33744,261.1647,111.5744,263.25888,112.38009,264.67772,113.89667,265.51006,116.26633,266.31574,119.50683,267.83233,122.56962,270.41526,124.85041,274.41998,125.74496,277.94485,124.97778,280.15455,123.16203,281.29791,121.02638,281.62374,119.29949,280.11012,113.8789,275.77068,109.34692,268.90756,106.23675,259.82288,105.08154,254.79625,105.67099,248.33004,107.66447,241.40176,111.39964,234.98887,117.21419,230.32953,124.27281,226.29222,133.44635,222.85918,144.2194,220.01263,156.07658,216.88468,156.21876,213.75673,156.36094,210.62878,156.50312,207.50083,156.6453,205.20522,157.01556,203.63829,157.75904,202.67562,158.75133,202.1928,159.86804,201.99434,160.5582,201.74257,161.55049,201.52633,162.50724,201.43451,163.09077,201.53226,163.30997,201.78996,163.42253,202.15429,163.464,202.57194,163.46992,206.45818,163.46992,210.34442,163.46992,214.23066,163.46992)
# close the ring              
coords_f <- c(coords_f, coords_f[1:2])

coords_s <- c(148.44601,239.29898,149.15691,239.29898,149.8678,239.29898,150.5787,239.29898,151.2896,239.29898,163.7777,237.48027,173.13785,232.42697,179.0146,224.74335,181.05251,215.03368,179.98024,208.33939,176.31319,201.43184,169.37602,194.02666,158.49337,185.83949,154.90926,183.04033,152.56922,180.2234,151.29553,177.22874,150.91046,173.89641,151.63024,168.99418,153.82514,164.67844,157.54846,161.60677,162.85354,160.43675,166.10589,160.73592,168.6829,161.69267,170.47791,163.39586,171.38431,165.93436,172.29366,169.39406,174.10941,172.5694,176.7427,174.89167,180.10465,175.79214,183.41032,175.21157,185.50747,173.70684,186.60936,171.63339,186.92926,169.34667,185.20533,164.09788,180.53118,159.20453,173.65325,155.59081,165.31798,154.18086,154.21317,156.25727,145.86309,161.69268,140.60541,169.29632,138.77781,177.87744,139.622,183.66533,142.40339,189.63094,147.49519,195.73873,155.27063,201.95316,161.31622,206.93833,164.82035,211.55028,166.4406,215.62905,166.83456,219.0147,165.51644,225.60531,161.97676,229.93883,156.83757,232.31737,150.72089,233.04308,147.4478,232.82981,145.01001,232.04783,143.38976,230.48385,142.56926,227.92462,141.73692,224.51527,140.03373,221.26588,137.37083,218.83402,133.65935,217.87727,130.24408,218.62075,128.09065,220.4128,126.96803,222.59585,126.64516,224.51231,128.2121,229.6752,132.64039,234.25161,139.52129,237.65503)
coords_s <- c(coords_s, coords_s[1:2])

# create sf objects from letters
rot = function(a) matrix(c(cos(a), sin(a), -sin(a), cos(a)), 2, 2)

matrix_s <- matrix(coords_s, ncol = 2, byrow = TRUE)
matrix_s <- apply(apply(matrix_s, 1, rev), 1, rev)
letter_s <- st_polygon(list(matrix_s))

matrix_f <- matrix(coords_f, ncol = 2, byrow = TRUE)
matrix_f <- apply(apply(matrix_f, 1, rev), 1, rev)
letter_f <- st_polygon(list(matrix_f))

letter_sf <- st_sfc(st_union(letter_s, letter_f))
letter_sf <- ((letter_sf - st_centroid(letter_sf)) * rot(pi/2)) * 1.5

letters_bbox <- st_bbox(st_union(letter_s, letter_f))
coords_hex <- hexcoords(dx = letters_bbox[["xmax"]] - letters_bbox[["xmin"]],
                        dy = letters_bbox[["ymax"]] - letters_bbox[["ymin"]])
corners <- tibble(x = coords_hex$x, y = coords_hex$y)
corners <- rbind(corners, corners[1,])
hexagon <- st_polygon(list(as.matrix(corners), as.matrix(corners) * 0.94)) 

laea = st_crs("+proj=laea +lat_0=30 +lon_0=30") # Lambert equal area
letter_sf = letter_sf * 1e4
st_crs(letter_sf) = laea
corners = st_sfc(st_polygon(list(as.matrix(corners))) * 1e4, crs = laea)
hexagon = st_sfc(hexagon * 1e4, crs = laea)

#png("sf-hexagon.png")

bb = st_bbox(hexagon)
px = 200
saveGIF(
for (i in 1:32) {
#st_graticule(st_bbox(hexagon), lon = seq(-32,80,8)+.5*i) %>% 
par(mar = rep(0, 4), xaxs = "i", yaxs = "i")
st_intersection(corners,
	st_geometry(st_graticule(hexagon, lon = seq(-32,80,8)+.25*i))) %>% 
	plot(asp = .662, col = "gray42", xlim = bb[c(1,3)], ylim = bb[c(2,4)])
plot(hexagon, col = "grey", rule = "evenodd", add = TRUE)
plot(st_buffer(letter_sf, dist = 10 * 1e4), col = sf.colors()[1], add = TRUE)
plot(letter_sf, add = TRUE, col = sf.colors()[2], border = "gray", lwd = 3)
}
, interval = 0.05, clean = FALSE, ani.height = px, ani.width = px)

animation

@edzer

This comment has been minimized.

Copy link
Owner Author

edzer commented Jan 12, 2018

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.
You signed in with another tab or window. Reload to refresh your session. You signed out in another tab or window. Reload to refresh your session.