Last active
November 4, 2021 16:23
-
-
Save h-a-graham/596c3d9f03b39e4441229c67828d75f6 to your computer and use it in GitHub Desktop.
This file contains hidden or 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
# So this is just a test to see the fastests way to go from a dataframe with | |
# two coordinates per row (split into 4 columns - 2 for x and 2 for y) to a | |
# linestring for each set of coordinates. | |
# minimal example. | |
library(sfheaders) | |
library(wk) | |
library(sf) | |
library(tidyverse) | |
library(microbenchmark) | |
#data | |
rand <- function(n) sample(1:100, n, replace=T) | |
d <- tibble(x1=rand(1000),x2=rand(1000),y1=rand(1000),y2=rand(1000)) | |
# original with purrr slow on large data | |
sf_purr_lines <- function(x){ | |
x %>% | |
pmap_dfr(function(...){ | |
tibble(...)%>% | |
mutate(g=st_sfc(st_linestring(matrix(c(.$x1, .$x2, .$y1, .$y2), | |
ncol=2), dim = 'XY')))%>% | |
st_as_sf(sf_column_name='g')}) | |
} | |
# sf_purr_lines(d) %>% | |
# ggplot() + geom_sf() | |
# original but using rowwise() - better but still slow | |
sf_rowwise_lines <- function(x){ | |
x %>% | |
rowwise() %>% | |
mutate(g=st_sfc(st_linestring(matrix(c(x1, x2, y1, y2), ncol=2), dim = 'XY'))) %>% | |
st_as_sf(sf_column_name='g')%>% | |
ungroup() | |
} | |
# sf_rowwise_lines(d) %>% | |
# ggplot() + geom_sf(colour='red') | |
# now with wk | |
wk_lines <- function(x){ | |
df <- x %>% | |
mutate(id=row_number())%>% | |
pivot_longer(c(x1,x2,y1,y2), | |
names_to = c(".value", "loc"), | |
names_pattern = "(.)(.)") | |
tibble(wk_linestring(xy(df$x,df$y),feature_id = df$id)) %>% | |
st_as_sf() | |
} | |
# wk_lines(d)%>% | |
# ggplot() + geom_sf(colour='blue') | |
#wk_filters | |
wk_filters_lines <- function(x){ | |
df <- x %>% | |
mutate(id=row_number())%>% | |
pivot_longer(c(x1,x2,y1,y2), | |
names_to = c(".value", "loc"), | |
names_pattern = "(.)(.)") | |
wk_handle(xy(df$x,df$y), | |
wk_linestring_filter(feature_id = df$id, | |
sfc_writer())) %>% | |
st_as_sf() | |
} | |
# db <- tibble(x1=rand(100),x2=rand(100),y1=rand(100),y2=rand(100)) | |
# wk_filters_lines(d)%>% | |
# ggplot() + geom_sf(colour='pink') | |
# sfheaders solution | |
sfheaders_lines <- function(x){ | |
x %>% | |
mutate(id=row_number())%>% | |
pivot_longer(c(x1,x2,y1,y2), | |
names_to = c(".value", "loc"), | |
names_pattern = "(.)(.)") %>% | |
sf_linestring(., x='x', y='y', linestring_id = "id") | |
} | |
# sfheaders_lines(d) %>% | |
# ggplot() + geom_sf(colour='green') | |
# let's benchmark it... | |
microbenchmark( | |
sf_purr_lines(d), | |
sf_rowwise_lines(d), | |
wk_lines(d), | |
wk_filters_lines(d), | |
sfheaders_lines(d), times=10 | |
) | |
d2 <- tibble(x1=rand(100),x2=rand(100),y1=rand(100),y2=rand(100))%>% | |
sfheaders_lines() | |
p <- ggplot(sfheaders_lines(d)) + | |
# geom_sf(data=d2, | |
# colour='black',alpha=0.7) + | |
geom_sf(aes(colour=id), alpha=0.1) + | |
scale_colour_viridis_c(option='rocket', guide='none') + | |
theme_void() | |
p | |
# ggsave('exports/mako10k.png', p) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment