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

edzer commented Jan 11, 2018

sf-hexagon

@edzer

This comment has been minimized.

Copy link
Owner

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

edzer commented Jan 12, 2018

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment