u-shift / cyclingpotential-hack Goto Github PK

# from code/reproducible-example.R

remotes::install_github("itsleeds/pct")
#> Using github PAT from envvar GITHUB_PAT
#> Skipping install of 'pct' from a github remote, the SHA1 (63ee1f7e) has not changed since last install.
#>   Use `force = TRUE` to force installation

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

u3 = "https://github.com/U-Shift/cyclingpotential-hack/releases/download/1.0/routes_integers_cs_balanced.geojson"
route_segments_balanced = sf::read_sf(u3)
routes_balanced = route_segments_balanced %>% 
  group_by(Origem, Destino) %>% 
  summarise(
    Origem = first(Origem),
    Destino = first(Destino),
    Bike = mean(Bike),
    All = mean(Bike) + mean(Car) + mean(Motorcycle) + mean(Transit) + mean(Walk) + mean(Other),
    Length_balanced_m = sum(distances),
    Hilliness_average = mean(gradient_segment),
    Hilliness_90th_percentile = quantile(gradient_segment, probs = 0.9)
  ) 
#> `summarise()` regrouping output by 'Origem' (override with `.groups` argument)
  # %>% 
  # sf::st_cast("LINESTRING")
# how to make them linestrings (not multilinestrings) without duplicating every segment?
unique(sf::st_geometry_type(routes_balanced))
#> [1] MULTILINESTRING
#> 18 Levels: GEOMETRY POINT LINESTRING POLYGON MULTIPOINT ... TRIANGLE
nrow(routes_balanced)
#> [1] 46
routes_balanced$pcycle_current = routes_balanced$Bike / routes_balanced$All
plot(routes_balanced["pcycle_current"])

m1 = lm(pcycle_current ~ Length_balanced_m, data = routes_balanced)
m2 = lm(pcycle_current ~ Length_balanced_m, data = routes_balanced, weights = All)
m3 = lm(pcycle_current ~ Length_balanced_m + Hilliness_average, data = routes_balanced)

m_pct = pct::model_pcycle_pct_2020(
  pcycle = routes_balanced$pcycle_current,
  distance = routes_balanced$Length_balanced_m,
  # gradient = routes_balanced$Hilliness_average,
  gradient = rep(1, nrow(routes_balanced)),
  weights = routes_balanced$All
  )

m_pct_govtarget_uk = pct::uptake_pct_govtarget_2020(
  distance = routes_balanced$Length_balanced_m,
  gradient = rep(1, nrow(routes_balanced))
)
#> Distance assumed in m, switching to km

plot(routes_balanced$Length_balanced_m, routes_balanced$pcycle_current, cex = routes_balanced$All / mean(routes_balanced$All), ylim = c(0, 0.1))
lines(routes_balanced$Length_balanced_m, m1$fitted.values)
lines(routes_balanced$Length_balanced_m, m2$fitted.values)
points(routes_balanced$Length_balanced_m, m3$fitted.values, col = "red")
points(routes_balanced$Length_balanced_m, m_pct$fitted.values, col = "green")
points(routes_balanced$Length_balanced_m, m_pct_govtarget_uk, col = "grey")

# insert reprex here