Commit 9a07010c authored by Nicolas Lambert's avatar Nicolas Lambert
Browse files

arrows when dist is small

parent 661d2306
Pipeline #1891 passed with stage
in 36 seconds
# Links
getlinks <- function(x, df, xid, dfid, dfvar){
dots <- sf::st_centroid(x = sf::st_geometry(x),of_largest_polygon = max(sf::st_is(sf::st_as_sf(x), "MULTIPOLYGON")))
x2 <- data.frame(id = x[[xid]],
......@@ -43,7 +42,7 @@ getcircles <- function(x, xid, df, dfid, dfvar, k){
if (is.null(k)){
m <- max(df[,dfvar])
bb <- st_bbox(x)
k <- max(bb$xmax - bb$xmin, bb$ymax - bb$ymin)/ (m * 50)
k <- max(bb$xmax - bb$xmin, bb$ymax - bb$ymin)/ (m * 700)
}
dots <- sf::st_centroid(x = sf::st_geometry(x),of_largest_polygon = max(sf::st_is(sf::st_as_sf(x), "MULTIPOLYGON")))
......@@ -73,6 +72,7 @@ getdots <- function(x, xid, k = NULL){
# Link to Flows
linktoflows <- function(link, size, k, dfvar, type, decreasing){
crs <- st_crs(link)
link$shift <- 0
link$ij <- paste0(link$i,"_",link$j)
......@@ -121,14 +121,25 @@ linktoflows <- function(link, size, k, dfvar, type, decreasing){
r$y2 <- r$y2 - (r[["height"]]/2 + delta2) * link$shift
r$p1x <- r$x1
r$p1y <- r$y1 - r[["height"]]/2
r$p2x <- r$x2 - r[["height"]]/2
# --- patch
newdist <- r$x2 - r$x1
if (newdist < r[["height"]]/2){
r$p2x <- r$x2 - newdist/2
}else {
r$p2x <- r$x2 - r[["height"]]/2
}
# ---
r$p2y <- r$y2 - r[["height"]]/2
r$p3x <- r$x2
r$p3y <- r$y2
r$p4x <- r$x2 - r[["height"]]/2
r$p4x <- r$p2x
r$p4y <- r$y2 + r[["height"]]/2
r$p5x <- r$x1
r$p5y <- r$y1 + r[["height"]]/2
st_geometry(link) <- st_as_sfc(paste0("POLYGON((",r$p1x," ",r$p1y,", ",r$p2x," ",r$p2y,", ",r$p3x," ",r$p3y,", ",r$p4x," ",r$p4y,", ",r$p5x," ",r$p5y,", ",r$p1x," ",r$p1y,"))"))
}
......
......@@ -14,7 +14,6 @@
#' migr <- migr[migr$fij >= threshold,]
#' intra <- migr[migr$i == migr$j,c("i","fij")]
#' colnames(intra) <- c("id","nb")
#' intra <- intra[,c(id,test,nb)]
#'
#' plot(st_geometry(subregions), col = "#CCCCCC", border = "white", lwd = 0.5)
#' flows <- plotflows(
......
......@@ -25,7 +25,6 @@ threshold <- 1500
migr <- migr[migr$fij >= threshold,]
intra <- migr[migr$i == migr$j,c("i","fij")]
colnames(intra) <- c("id","nb")
intra <- intra[,c(id,test,nb)]
plot(st_geometry(subregions), col = "#CCCCCC", border = "white", lwd = 0.5)
flows <- plotflows(
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment