Created
January 11, 2018 21:51
-
-
Save edzer/f461a3a95570c4ab7edf3125c2f19d20 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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) |
Author
edzer
commented
Jan 12, 2018
•
This is btw all based on @nuest ' s work: https://gist.github.com/nuest/e2fd7cdb5ec8284ba2168323e3e248b1
png("sf-hexagon.png", bg = "transparent")
opar = par(mar = rep(0,4))
st_cast(hexagon, "LINESTRING")[[1]] |>
st_cast("POLYGON") |>
plot(col = "white", asp = 0.7)
st_graticule(st_bbox(hexagon), lon = seq(-32,80,8)) %>%
st_geometry %>%
st_intersection(corners) %>%
plot(asp = .7, col = "gray42", add = TRUE)
plot(hexagon, col = "white", add = TRUE)
plot(hexagon, col = "grey", rule = "evenodd", add = TRUE, bg = "white")
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)
dev.off()
I've modified this to create a transparent background.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment