## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup--------------------------------------------------------------------
library(blvim)
## we use ggplot2 for graphical representations
library(ggplot2)

## ----regular_grid_example-----------------------------------------------------
locations <- expand.grid(x = 1:5, y = 1:5)
locations$name <- LETTERS[1:25]
ggplot(locations, aes(x, y, label = name)) +
  geom_text() +
  coord_fixed()

## -----------------------------------------------------------------------------
costs <- as.matrix(dist(locations[c("x", "y")]))

## -----------------------------------------------------------------------------
location_prod <- rep(1, nrow(locations))
location_att <- rep(1, nrow(locations))

## ----cache=TRUE---------------------------------------------------------------
models <- grid_blvim(costs,
  location_prod,
  alphas = seq(1.05, 2, length.out = 25),
  betas = 1 / seq(0.5, 4, length.out = 25),
  location_att,
  bipartite = FALSE,
  epsilon = 0.1,
  iter_max = 5000,
  conv_check = 10
)

## -----------------------------------------------------------------------------
destination_names(models) <- locations$name
destination_positions(models) <- as.matrix(locations[c("x", "y")])

## ----regular_grid_model_1_matrix----------------------------------------------
autoplot(models[[1]]) +
  scale_fill_gradient(low = "white", high = "black") +
  coord_fixed()

## ----regular_grid_model_10_position_flows-------------------------------------
autoplot(models[[10]],
  flows = "full", with_positions = TRUE,
  arrow = arrow(length = unit(0.01, "npc"))
) +
  coord_fixed() +
  scale_linewidth_continuous(range = c(0, 1))

## ----regular_grid_variability_flows-------------------------------------------
autoplot(models, with_names = TRUE) +
  theme_light()

## ----regular_grid_variability_position----------------------------------------
autoplot(models, flows = "destination", with_positions = TRUE) +
  scale_size_continuous(range = c(0, 7)) +
  coord_fixed()

## -----------------------------------------------------------------------------
models_df <- sim_df(models)

## -----------------------------------------------------------------------------
knitr::kable(head(models_df))

## ----regular_grid_df_default--------------------------------------------------
autoplot(models_df) +
  scale_fill_viridis_c()

## ----regular_grid_df_converged------------------------------------------------
autoplot(models_df, converged)

## ----regular_grid_df_ND-------------------------------------------------------
autoplot(models_df, diversity(sim, "ND")) +
  scale_fill_viridis_c()

## -----------------------------------------------------------------------------
models_dist <- sim_distance(models, "destination")

## -----------------------------------------------------------------------------
models_hc <- hclust(models_dist, method = "ward.D2")

## ----regular_grid_hc_dendrogram-----------------------------------------------
plot(models_hc, hang = -1, labels = FALSE)

## -----------------------------------------------------------------------------
models_df$cluster <- as.factor(cutree(models_hc, k = 16))

## ----regular_grid_df_clusters-------------------------------------------------
autoplot(models_df, cluster)

## ----regular_grid_cluster_flow_var--------------------------------------------
grid_var_autoplot(models_df, cluster)

## ----regular_grid_cluster_flow_var_position-----------------------------------
grid_var_autoplot(models_df, cluster,
  flows = "destination",
  with_positions = TRUE
) +
  scale_size_continuous(range = c(0, 4)) +
  coord_fixed()

## -----------------------------------------------------------------------------
models_centre <- sim_list(tapply(models, models_df$cluster,
  median,
  flows = "destination"
))
models_centre_df <- sim_df(models_centre)

## ----regular_grid_model_centres_flows-----------------------------------------
grid_autoplot(models_centre_df) +
  scale_fill_gradient(low = "white", high = "black") +
  coord_fixed()

## ----regular_grid_model_centres_flows_positions-------------------------------
grid_autoplot(models_centre_df,
  flows = "full", with_positions = TRUE,
  arrow = arrow(length = unit(0.015, "npc"))
) +
  scale_linewidth_continuous(range = c(0, 0.5)) +
  coord_fixed()

## ----regular_grid_model_centres_dest_positions--------------------------------
grid_autoplot(models_centre_df, flows = "destination", with_positions = TRUE) +
  scale_size_continuous(range = c(0, 6)) +
  coord_fixed()

## -----------------------------------------------------------------------------
data("eurodist")
eurodist_names <- labels(eurodist)
eurodist_names[match("Lyons", eurodist_names)] <- "Lyon"
eurodist_names[match("Marseilles", eurodist_names)] <- "Marseille"
eurodist_mat <- as.matrix(eurodist)
colnames(eurodist_mat) <- eurodist_names
rownames(eurodist_mat) <- eurodist_names
eurodist_coord <- data.frame(
  longitude = c(
    23.7337556, 2.14541, 4.3386684, 1.8110332, -1.5839619,
    6.94851185, 12.56571, 6.12186775, -5.3482947, 10.1185387,
    4.1148457, -9.1655069, 4.83042935, -3.7034351, 5.3805535,
    8.90758575, 11.6032322, 2.3222823, 12.5451136, 18.0710935,
    16.37833545
  ),
  latitude = c(
    37.9726176, 41.31120535, 50.89415265, 50.9338734, 49.6456093,
    50.84446155, 55.67613, 46.20823855, 36.1113418, 53.57845325,
    51.96912755, 38.7076287, 45.7591956, 40.47785335, 43.28032785,
    45.48039615, 48.1235428, 48.8787706, 41.8983351, 59.3251172,
    48.1653537
  ),
  name = eurodist_names
)

## ----european_city_map--------------------------------------------------------
ggplot(eurodist_coord, aes(longitude, latitude, label = name)) +
  geom_point() +
  ggrepel::geom_label_repel() +
  coord_sf(crs = "epsg:4326")

## ----euro_models, cache=TRUE--------------------------------------------------
euro_models <- grid_blvim(eurodist_mat,
  rep(1, 21),
  alphas = seq(1.05, 1.75, length.out = 30),
  betas = 1 / seq(50, 750, length.out = 30),
  rep(1, 21),
  bipartite = FALSE,
  epsilon = 0.05,
  iter_max = 40000,
  conv_check = 50
)

## -----------------------------------------------------------------------------
destination_positions(euro_models) <- as.matrix(eurodist_coord[1:2])
euro_models_df <- sim_df(euro_models)

## ----euro_cities_iterations---------------------------------------------------
autoplot(euro_models_df, iterations) +
  scale_fill_viridis_c()

## ----euro_cities_diversity----------------------------------------------------
autoplot(euro_models_df, diversity) +
  scale_fill_viridis_c()

## ----euro_cities_variability--------------------------------------------------
autoplot(euro_models, with_names = TRUE) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))

## ----euro_cities_dest_var-----------------------------------------------------
autoplot(euro_models, flows = "destination", with_names = TRUE) +
  coord_flip()

## ----euro_cities_dest_var_geo-------------------------------------------------
autoplot(euro_models,
  flows = "destination", with_positions = TRUE,
  with_names = TRUE
) +
  scale_size_continuous(range = c(0, 6)) +
  coord_sf(crs = "epsg:4326")

## -----------------------------------------------------------------------------
euro_models_dist <- sim_distance(euro_models, "destination")
euro_models_hc <- hclust(euro_models_dist, method = "ward.D2")

## ----euro_cities_dendrogram---------------------------------------------------
plot(euro_models_hc, hang = -1, labels = FALSE)

## ----euro_cities_df_cluster---------------------------------------------------
euro_models_df$cluster <- as.factor(cutree(euro_models_hc, k = 16))
autoplot(euro_models_df, cluster) +
  theme(legend.position = "bottom") +
  guides(fill = guide_legend(nrow = 2))

## ----euro_cities_cluster_var_geo----------------------------------------------
grid_var_autoplot(euro_models_df, cluster,
  flows = "destination",
  with_positions = TRUE
) +
  scale_size_continuous(range = c(0, 6)) +
  coord_sf(crs = "epsg:4326")

## ----euro_cities_cluster_var_flow---------------------------------------------
grid_var_autoplot(euro_models_df, cluster)

## -----------------------------------------------------------------------------
euro_models_centre <- sim_list(tapply(euro_models, euro_models_df$cluster,
  median,
  flows = "destination"
))
euro_models_centre_df <- sim_df(euro_models_centre)

## ----euro_cities_cluster_medoid_flow------------------------------------------
grid_autoplot(euro_models_centre_df) +
  scale_fill_gradient(low = "white", high = "black") +
  coord_fixed()

## ----euro_cities_cluster_medoid_inflow_pos------------------------------------
grid_autoplot(euro_models_centre_df,
  flows = "destination",
  with_positions = TRUE
) +
  scale_size_continuous(range = c(0, 6)) +
  coord_sf(crs = "epsg:4326")

## ----euro_cities_cluster_medoid_flow_geo--------------------------------------
grid_autoplot(euro_models_centre_df,
  with_positions = TRUE, arrow = arrow(length = unit(0.015, "npc"))
) +
  scale_linewidth_continuous(range = c(0, 0.75)) +
  coord_sf(crs = "epsg:4326")

## ----euro_cities_cluster_one_medoid-------------------------------------------
autoplot(euro_models_centre[[1]],
  flows = "full", with_positions = TRUE,
  arrow = arrow(length = unit(0.015, "npc"))
) +
  scale_linewidth_continuous(range = c(0, 2)) +
  coord_sf(crs = "epsg:4326")

## ----euro_cities_cluster_five_medoid------------------------------------------
autoplot(euro_models_centre[[5]],
  flows = "full", with_positions = TRUE,
  arrow = arrow(length = unit(0.015, "npc"))
) +
  scale_linewidth_continuous(range = c(0, 2)) +
  coord_sf(crs = "epsg:4326")

## ----euro_cities_cluster_four_content-----------------------------------------
set.seed(0)
euro_models_idx <- sample(which(euro_models_df$cluster == 4), 16)
euro_models_cl4_sample <- euro_models[euro_models_idx]
euro_models_cl4_sample_df <- sim_df(euro_models_cl4_sample)
grid_autoplot(euro_models_cl4_sample_df, with_positions = TRUE) +
  scale_linewidth_continuous(range = c(0, 1)) +
  coord_sf(crs = "epsg:4326")

## ----french_cities------------------------------------------------------------
big_cities <- french_cities[1:20, ]
small_cities <- french_cities[102:121, ]
fr_cities <- rbind(big_cities, small_cities)
fr_cities$type <- c(rep("origin", 20), rep("destination", 20))
ggplot(
  fr_cities,
  aes(x = th_longitude, y = th_latitude, color = type)
) +
  geom_point() +
  coord_sf(crs = "epsg:4326")

## -----------------------------------------------------------------------------
frcosts <- french_cities_distances[1:20, 102:121] / 1000
fr_prod <- french_cities$population[1:20]
fr_attr <- rep(1, 20)
origin_data <- list(
  names = french_cities$name[1:20],
  positions = as.matrix(french_cities[
    1:20,
    c("th_longitude", "th_latitude")
  ])
)
destination_data <- list(
  names = french_cities$name[102:121],
  positions = as.matrix(french_cities[
    102:121,
    c("th_longitude", "th_latitude")
  ])
)

## ----cache=TRUE---------------------------------------------------------------
fr_models <- grid_blvim(frcosts,
  log(fr_prod),
  alphas = seq(1.05, 1.75, length.out = 30),
  betas = 1 / seq(5, 200, length.out = 30),
  fr_attr,
  epsilon = 0.05,
  iter_max = 40000,
  conv_check = 50,
  origin_data = origin_data,
  destination_data = destination_data
)
fr_models_df <- sim_df(fr_models)

## ----french_cities_log_pop_diversity------------------------------------------
autoplot(fr_models_df) +
  labs(title = "Log population") +
  scale_fill_viridis_c()

## ----french_cities_log_pop_flow_vars------------------------------------------
autoplot(fr_models, with_names = TRUE) +
  theme_light() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  labs(title = "Log population")

## ----french_cities_log_pop_dest_vars_geo--------------------------------------
autoplot(fr_models,
  flows = "destination", with_names = TRUE,
  with_positions = TRUE
) +
  coord_sf(crs = "epsg:4326") +
  labs(title = "Log population")

## ----cache=TRUE---------------------------------------------------------------
fr_models_direct <- grid_blvim(frcosts,
  fr_prod,
  alphas = seq(1.05, 1.75, length.out = 30),
  betas = 1 / seq(5, 200, length.out = 30),
  fr_attr,
  epsilon = 0.05,
  iter_max = 40000,
  conv_check = 50,
  origin_data = origin_data,
  destination_data = destination_data
)
fr_models_direct_df <- sim_df(fr_models_direct)

## ----french_cities_direct_pop_diversity---------------------------------------
autoplot(fr_models_direct_df) +
  labs(title = "Population") +
  scale_fill_viridis_c()

## ----french_cities_pop_flow_vars_norm-----------------------------------------
autoplot(fr_models_direct, with_names = TRUE, normalisation = "origin") +
  theme_light() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  labs(title = "Population")

## ----french_cities_log_pop_bar_dest-------------------------------------------
autoplot(fr_models, with_names = TRUE, flow = "destination") +
  labs(title = "Log population") +
  coord_flip()

## ----french_cities_pop_bar_dest-----------------------------------------------
autoplot(fr_models_direct, with_names = TRUE, flow = "destination") +
  labs(title = "Population") +
  coord_flip()

## ----french_cities_pop_geo_var------------------------------------------------
options("ggrepel.max.overlaps" = 20)
autoplot(fr_models_direct,
  flows = "destination", with_names = TRUE,
  with_positions = TRUE
) +
  coord_sf(crs = "epsg:4326") +
  labs(title = "Population")

## ----french_cities_pop_flow_vars----------------------------------------------
autoplot(fr_models_direct, with_names = TRUE, normalisation = "full") +
  theme_light() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  labs(title = "Population global normalisation")

## -----------------------------------------------------------------------------
fr_models_dist <- sim_distance(fr_models, "destination")
fr_models_hc <- hclust(fr_models_dist, method = "ward.D2")

## ----french_cities_log_pop_dendro---------------------------------------------
plot(fr_models_hc, hang = -1, labels = FALSE)

## ----french_cities_log_pop_cluster--------------------------------------------
fr_models_df$cluster <- as.factor(cutree(fr_models_hc, k = 16))
autoplot(fr_models_df, cluster) +
  theme(legend.position = "bottom") +
  guides(fill = guide_legend(nrow = 2)) +
  labs(title = "Log population")

## -----------------------------------------------------------------------------
fr_models_direct_dist <- sim_distance(fr_models_direct, "destination")
fr_models_direct_hc <- hclust(fr_models_direct_dist, method = "ward.D2")

## ----french_cities_pop_dendro-------------------------------------------------
plot(fr_models_direct_hc, hang = -1, labels = FALSE)

## ----french_cities_pop_cluster------------------------------------------------
fr_models_direct_df$cluster <- as.factor(cutree(fr_models_direct_hc, k = 16))
autoplot(fr_models_direct_df, cluster) +
  theme(legend.position = "bottom") +
  guides(fill = guide_legend(nrow = 2)) +
  labs(title = "Population")

## ----french_cities_log_pop_cluster_var_geo------------------------------------
grid_var_autoplot(fr_models_df, cluster,
  flows = "destination",
  with_positions = TRUE
) +
  scale_size_continuous(range = c(0, 6)) +
  coord_sf(crs = "epsg:4326") +
  labs(title = "Log population")

## ----french_cities_pop_cluster_var_geo----------------------------------------
grid_var_autoplot(fr_models_direct_df, cluster,
  flows = "destination",
  with_positions = TRUE
) +
  scale_size_continuous(range = c(0, 6)) +
  coord_sf(crs = "epsg:4326") +
  labs(title = "Population")