Nothing
#' @title Computes flow indicators per places
#' @description Compute indicators per places (origin and/or destination ) from the margins of the matrix. Ex/ in and out degrees, gross and net flows, asymmetry .... from an initial matrix
#' @param tab is the input flow dataset
#' @param origin the place of origin code
#' @param destination the place of destination code
#' @param fij the flow value between origin and destination places
#' @param format specify the flow dataset format, "M " for square matrix [n*n] or "L" for long [i,j,data]
#' @param x enter the flowplaces indicator type : "allflowplaces", "ini", "outi", "degi","intra", "Oi", "Dj", voli","bali","asyi". See Details.
#' @details
#' This function compute for all pairs or origin-destination places (i,j)
#' a data table that describes the flows from the point of view of Origin / destination places
#' - x = "ini" for the number of incoming links (as in-degree) \cr
#' - x = "outi" for the number of outcoming links (as out-degree)\cr
#' - x = "degi" for the total number of links (as in and out degrees)\cr
#' - x = "intra" for total intra zonal interaction (if main diagonal is not empty\cr
#' - x = "Dj" for the total flows received by (j) place \cr
#' - x = "voli" for the total volume of flow per place \cr
#' - x = "bali" for the net balance of flow per place \cr
#' - x = "asyi" for the asymetry of flow per place \cr
#' - x = "allflowplaces" for computing all the above indicators\cr
#' @import dplyr
#' @importFrom rlang .data
#' @examples
#' library(cartograflow)
#' data(flowdata)
#' bkg <- system.file("shape/MGP_TER.shp",
#' package = "cartograflow",
#' lib.loc = NULL, mustWork = TRUE)
#'
#' ###1:Computes the total flow volume of places : Long format
#' voli <- flowplaces(flows, origin ="i",destination="j",fij="Fij",format = "L", x = "voli")
#' ###2:Computes the total flows received by destination place : Long format
#' tab_bali <- flowplaces(flows, origin ="i",destination="j",fij="Fij",format = "L", x = "bali")
#' @export
flowplaces <- function(tab,origin=NULL,destination=NULL,fij=NULL,format, x) {
if (format == "L") {
tab <- tab %>% select(origin,destination,fij)
names(tab) <- c("i", "j", "Fij")
tab_intra <-tab %>%
mutate(intra = ifelse(.data$i == .data$j, .data$Fij,0)) %>%
filter(.data$intra !=0) %>%
select(.data$i,.data$intra)
tabOi<-tab %>%
group_by(.data$i) %>%
summarise(outi = n(),Oi = sum(.data$Fij))
tabDj<-tab %>%
group_by(.data$j)%>%
summarise(ini = n(),Dj = sum(.data$Fij))
colnames(tabDj)<-c("i","ini","Dj")
as.data.frame(tabOi)
as.data.frame(tabDj)
tabOiDj<-left_join(tabOi,tabDj, by="i")
tabOiDj <- tabOiDj %>%
mutate (voli=.data$Oi+.data$Dj, bali=.data$Oi-.data$Dj, asyi=.data$bali/.data$voli) %>%
mutate (intra=tab_intra$intra)
tabOiDj$i<-as.character(tabOiDj$i)
tabOiDj$ini<-as.numeric(tabOiDj$ini)
tabOiDj$outi<-as.numeric(tabOiDj$outi)
tabOiDj$Oi<-as.numeric(tabOiDj$Oi)
tabOiDj$Dj<-as.numeric(tabOiDj$Dj)
tabOiDj$Vol<-as.numeric(tabOiDj$voli)
tabOiDj$Bal<-as.numeric(tabOiDj$bali)
tabOiDj$Asy<-as.numeric(tabOiDj$asyi)
tabOiDj$intra<-as.numeric(tabOiDj$intra)
if (missing(x)) {
message("You must specify a choice of flow places indicator computation : alltypes, ini, degi, outi, Oi,Dj, intra,...")
}
if (x == "allflowplaces") {
return(tabOiDj)
}
if (x == "intra") {
tabOiDj <- tabOiDj %>% select(.data$i,.data$intra)
return(tabOiDj)
}
if (x == "ini") {
tabOiDj <- tabOiDj %>% select(.data$i,.data$ini)
return(tabOiDj)
}
if (x == "outi") {
tabOiDj <- tabOiDj %>% select(.data$i,.data$outi)
return(tabOiDj)
}
if (x == "degi") {
tabOiDj <- tabOiDj %>% select(.data$i,.data$degi)
return(tabOiDj)
}
if (x == "voli") {
tabOiDj <- tabOiDj %>% select(.data$i,.data$voli)
return(tabOiDj)
}
if (x == "bali") {
tabOiDj <- tabOiDj %>% select(.data$i,.data$bali)
return(tabOiDj)
}
if (x == "asyi") {
tabOiDj <- tabOiDj %>% select(.data$i,.data$asyi)
return(tabOiDj)
}
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.