diff --git a/.quarto/_freeze/posts/2020-06-15-science-communication/index/execute-results/html.json b/.quarto/_freeze/posts/2020-06-15-science-communication/index/execute-results/html.json
index 9b35080..81536ce 100644
--- a/.quarto/_freeze/posts/2020-06-15-science-communication/index/execute-results/html.json
+++ b/.quarto/_freeze/posts/2020-06-15-science-communication/index/execute-results/html.json
@@ -1,7 +1,7 @@
{
- "hash": "32731220dc2884ca05a893eb4d727aa5",
+ "hash": "16eb9577cf6f5dccfcab36b6972360af",
"result": {
- "markdown": "---\ntitle: \"Science Communication\"\ndescription: |\n Recordings, content and handouts from a 6-hour Science Communication workshop held over two days on 15 and 16 June 2020.\nauthor:\n - name: \"Gracielle Higino\"\n affiliation: Université de Montréal\n - name: \"Katherine Hébert\"\n affiliation: Université de Sherbrooke\nbase_url: https://bios2.github.io/\nimage: image.jpg\ncategories: [Career, Fellow contributed, EN]\ndate: \"2020-06-15\"\ntoc: true\nnumber-sections: true\nnumber-depth: 1\n---\n\n\n\n\nThe objective of this training is to share and discuss the concepts and tools that contribute to effective science communication. The training is split into two sessions, which cover the basic concepts of effective science communication and how social media tools can be used to boost the signal of your research and extend your research network. Each training takes the form of a presentation interspersed with several short activity modules, where participants are invited to use the tools we will be discussing to kickstart their own science communication.\n\nThis training was given on June 1 and 2, 2020. You can view recordings of each session here:\n\n### Day 1\n\n\n\n### Day 2\n\n\n\n## Session 1: The basics of science communication\n\n#### Objectives:\n\n1. Discuss what science communication (or SciComm) can be, and its potential role in boosting the signal of your research\n2. Make an overview of basic concepts and tools that you can use in any medium (blog posts, presentations, conversations, twitter, etc.) to do effective science communication\n\nDuring this session, we:\n\n1. Discuss the potential pitfalls of science communication (notably, diversity and inclusivity problems).\n2. Cover the basic concepts of science communication, including the Golden Circle method, the creation of personas, and storytelling techniques.\n3. Have short activities where participants can try to use some of the techniques we will be covering, such as filling in their own Golden Circle and explaining a blog post as a storyboard.\n\n\n\n
\n\n## Session 2: Social media as a science communication tool\n\n#### Objectives:\n\n1. Rethink the way we write about science by exploring the world of blog posts\n2. Clarify the mechanics of Twitter and how it can be used effectively for science communication\n\nDuring this session, we:\n\n1. Discuss how to create a story structure using titles and the flow of ideas in blog posts, especially when we are used to writing scientific articles\n2. Cover the basics of how Twitter works (retweets, threads, replies, hashtags, photo captions, etc.) and how to find helpful connections\n3. Have short activities where participants will be invited to write their own Twitter biographies and to create a Twitter thread explaining a project of their choice.\n\n\n\n
\n",
+ "markdown": "---\ntitle: \"Science Communication\"\ndescription: |\n Recordings, content and handouts from a 6-hour Science Communication workshop held over two days on 15 and 16 June 2020.\nauthor:\n - name: Gracielle Higino\n - name: Katherine Hébert\nbase_url: https://bios2.github.io/\nimage: image.jpg\ncategories: [Career, Fellow contributed, EN]\ndate: \"2020-06-15\"\ntoc: true\nnumber-sections: true\nnumber-depth: 1\n---\n\n\n\n\nThe objective of this training is to share and discuss the concepts and tools that contribute to effective science communication. The training is split into two sessions, which cover the basic concepts of effective science communication and how social media tools can be used to boost the signal of your research and extend your research network. Each training takes the form of a presentation interspersed with several short activity modules, where participants are invited to use the tools we will be discussing to kickstart their own science communication.\n\nThis training was given on June 1 and 2, 2020. You can view recordings of each session here:\n\n### Day 1\n\n\n\n### Day 2\n\n\n\n## Session 1: The basics of science communication\n\n#### Objectives:\n\n1. Discuss what science communication (or SciComm) can be, and its potential role in boosting the signal of your research\n2. Make an overview of basic concepts and tools that you can use in any medium (blog posts, presentations, conversations, twitter, etc.) to do effective science communication\n\nDuring this session, we:\n\n1. Discuss the potential pitfalls of science communication (notably, diversity and inclusivity problems).\n2. Cover the basic concepts of science communication, including the Golden Circle method, the creation of personas, and storytelling techniques.\n3. Have short activities where participants can try to use some of the techniques we will be covering, such as filling in their own Golden Circle and explaining a blog post as a storyboard.\n\n\n\n
\n\n## Session 2: Social media as a science communication tool\n\n#### Objectives:\n\n1. Rethink the way we write about science by exploring the world of blog posts\n2. Clarify the mechanics of Twitter and how it can be used effectively for science communication\n\nDuring this session, we:\n\n1. Discuss how to create a story structure using titles and the flow of ideas in blog posts, especially when we are used to writing scientific articles\n2. Cover the basics of how Twitter works (retweets, threads, replies, hashtags, photo captions, etc.) and how to find helpful connections\n3. Have short activities where participants will be invited to write their own Twitter biographies and to create a Twitter thread explaining a project of their choice.\n\n\n\n
\n",
"supporting": [],
"filters": [
"rmarkdown/pagebreak.lua"
diff --git a/.quarto/_freeze/posts/2020-09-21-data-visualization/index/execute-results/html.json b/.quarto/_freeze/posts/2020-09-21-data-visualization/index/execute-results/html.json
index bc4be28..c85525d 100644
--- a/.quarto/_freeze/posts/2020-09-21-data-visualization/index/execute-results/html.json
+++ b/.quarto/_freeze/posts/2020-09-21-data-visualization/index/execute-results/html.json
@@ -1,7 +1,7 @@
{
- "hash": "739bf50a2939995dffa89c8a810a1c81",
+ "hash": "7f5d3d74170356e739fc12fb640c4a08",
"result": {
- "markdown": "---\ntitle: \"Data Visualization\"\ndescription: |\n General principles of visualization and graphic design, and techniques of tailored visualization. This training was developed and delivered by Alex Arkilanian and Katherine Hébert on September 21st and 22nd, 2020.\nauthor:\n - name: \"Alex Arkilanian\"\n affiliation: McGill University\n - name: \"Katherine Hébert\"\n affiliation: Université de Sherbrooke\ncategories: [Technical, Fellow contributed, EN]\ndate: \"09-21-2020\"\nimage: image.jpg\ntoc: true\nnumber-sections: true\nnumber-depth: 1\nformat: \n html:\n code-fold: true\n code-summary: \"Show code\"\nexecute: \n cache: true\n warning: false\n message: false\n collapse: true\n---\n\n\nWelcome!\n\nThis training covers the general principles of visualization and graphic design, and techniques of tailored visualization. More specifically, the objectives of the training are:\n\n- Make an overview of basic data visualization principles, including shapes, sizes, colours, and fonts.\n- Discuss how to choose the right visualization for your data, what you want to communicate, and who you want to communicate to.\n- Tools and principles to tailor visualizations, particularly in making interpretable, interactive, and honest visualizations.\n\n## Training material\n\n*Click on \"Show code\" to learn how to do each plot!*\n\n### Interactive examples\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-1_3ffdc9070d841790d6510b3c8ffbac4e'}\n\n:::\n\n\n\n\n#### Streamgraph\n\n\n::: {.cell hash='index_cache/html/streamgraph-plot_93fdd122ca2090828f4a810da98557e8'}\n\n```{.r .cell-code}\n# Script to make a streamgraph of the top 10 most popular dog breeds in \n# New York City from 1999 to 2015\n\n# load libraries\nlibrary(lubridate) # dealing with dates\nlibrary(dplyr) # data manipulation\nlibrary(streamgraph) #devtools::install_github(\"hrbrmstr/streamgraph\")\nlibrary(htmlwidgets) # to save the widget!\n\n# load the dataset\n# more information about this dataset can be found here:\n# https://www.kaggle.com/smithaachar/nyc-dog-licensing-clean\nnyc_dogs <- read.csv(\"data/nyc_dogs.csv\")\n\n# convert birth year to date format (and keep only the year)\nnyc_dogs$AnimalBirthYear <- mdy_hms(nyc_dogs$AnimalBirthMonth) %>% year()\n\n# identify 10 most common dogs\ntopdogs <- nyc_dogs %>% count(BreedName) \ntopdogs <- topdogs[order(topdogs$n, decreasing = TRUE),]\n# keep 10 most common breeds (and remove last year of data which is incomplete)\ndf <- filter(nyc_dogs, BreedName %in% topdogs$BreedName[2:11] & AnimalBirthYear < 2016) %>% \n group_by(AnimalBirthYear) %>% \n count(BreedName) %>% ungroup()\n\n# get some nice colours from viridis (magma)\ncols <- viridis::viridis_pal(option = \"magma\")(length(unique(df$BreedName)))\n\n# make streamgraph!\npp <- streamgraph(df, \n key = BreedName, value = n, date = AnimalBirthYear, \n height=\"600px\", width=\"1000px\") %>%\n sg_legend(show=TRUE, label=\"names: \") %>%\n sg_fill_manual(values = cols) \n# saveWidget(pp, file=paste0(getwd(), \"/figures/dogs_streamgraph.html\"))\n\n# plot\npp\n```\n\n::: {.cell-output-display}\n```{=html}\n\n
\n\n```\n:::\n:::\n\n\n------------------------------------------------------------------------\n\n#### Interactive plot\n\n\n::: {.cell hash='index_cache/html/interactive-plot_ffab3ec1ce4e0abef23fd229dc1c8908'}\n\n```{.r .cell-code}\n# Script to generate plots to demonstrate how combinations of information dimensions\n# can become overwhelming and difficult to interpret.\n\n# set-up & data manipulation ---------------------------------------------------\n\n# load packages\nlibrary(ggplot2) # for plots, built layer by layer\nlibrary(dplyr) # for data manipulation\nlibrary(magrittr) # for piping\nlibrary(plotly) # interactive plots\n\n# set ggplot theme\ntheme_set(theme_classic() +\n theme(axis.title = element_text(size = 11, face = \"bold\"),\n axis.text = element_text(size = 11),\n plot.title = element_text(size = 13, face = \"bold\"),\n legend.title = element_text(size = 11, face = \"bold\"),\n legend.text = element_text(size = 10)))\n\n# import data\n# more info on this dataset: https://github.com/rfordatascience/tidytuesday/blob/master/data/2020/2020-07-28/readme.md\npenguins <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-07-28/penguins.csv') \n\n# get some nice colours from viridis (magma)\nsp_cols <- viridis::viridis_pal(option = \"magma\")(5)[2:4]\n\n\n#### Day 1 ####\n\n# 1. Similarity\n\nggplot(penguins) +\n geom_point(aes(y = bill_length_mm, x = bill_depth_mm, col = species), size = 2.5) +\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", col = \"Species\") + # labels\n scale_color_manual(values = sp_cols) # sets the colour scale we created above \n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_similarity.png\", width = 6, height = 3, units = \"in\")\n\n# 2. Proximity\n\ndf <- penguins %>% group_by(sex, species) %>% \n summarise(mean_mass = mean(body_mass_g, na.rm = TRUE)) %>% na.omit() \nggplot(df) +\n geom_bar(aes(y = mean_mass, x = species, fill = sex), \n position = \"dodge\", stat = \"identity\") +\n labs(x = \"Species\", y = \"Mean body mass (g)\", col = \"Sex\") + # labels\n scale_fill_manual(values = sp_cols) # sets the colour scale we created above\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_proximity.png\", width = 6, height = 3, units = \"in\")\n\n# 3. Enclosure (Ellipses over a fake PCA)\nggplot(data = penguins, \n aes(y = bill_length_mm, x = bill_depth_mm)) +\n geom_point(size = 2.1, col = \"grey30\") +\n stat_ellipse(aes(col = species), lwd = .7) +\n labs(x = \"PCA1\", y = \"PCA2\", col = \"Species\") + # labels\n scale_color_manual(values = sp_cols) + # sets the colour scale we created above\n theme(axis.text = element_blank(), axis.ticks = element_blank())\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_enclosure.png\", width = 6, height = 3, units = \"in\")\n\n# 4. Mismatched combination of principles\ntemp_palette <- rev(c(sp_cols, \"#1f78b4\", \"#33a02c\"))\nggplot(data = penguins, \n aes(y = bill_length_mm, x = bill_depth_mm)) +\n geom_point(aes(col = sex), size = 2.1) +\n stat_ellipse(aes(col = species), lwd = .7) +\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", col = \"?\") + # labels\n scale_color_manual(values = temp_palette) # sets the colour scale we created above\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_mismatchedgestalt.png\", width = 6, height = 3, units = \"in\")\n\n\n\n#### Day 2 ####\n\n# 1. Ineffective combinations: Luminance & shading -----------------------------\n\n# create the plot\nggplot(penguins) +\n geom_point(aes(y = bill_length_mm, x = bill_depth_mm, \n col = species, # hue\n alpha = log(body_mass_g)), # luminance\n size = 2.5) +\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", \n col = \"Species\", alpha = \"Body mass (g)\") +\n scale_color_manual(values = sp_cols)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_incompatible1.png\", width = 6, height = 3, units = \"in\")\n\n# 2. Ineffective combinations: Sizes and shapes --------------------------------\n\nggplot(penguins) +\n geom_point(aes(y = bill_length_mm, x = bill_depth_mm, \n shape = species, # shape\n size = log(body_mass_g)), alpha = .7) + # size\n scale_size(range = c(.1, 5)) + # make sure the sizes are scaled by area and not by radius\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", \n shape = \"Species\", size = \"Body mass (g)\") \n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_incompatible2.png\", width = 6, height = 3, units = \"in\")\n\n# 3. Cognitive overload --------------------------------------------------------\n\n# get some nice colours from viridis (magma)\nsex_cols <- viridis::viridis_pal(option = \"magma\")(8)[c(3,6)]\n\nggplot(na.omit(penguins)) +\n geom_point(aes(y = bill_length_mm, # dimension 1: position along y scale\n x = bill_depth_mm, # dimension 2: position along x scale\n shape = species, # dimension 3: shape\n size = log(body_mass_g), # dimension 4: size\n col = sex), # dimension 5: hue\n alpha = .7) + # size\n scale_size(range = c(.1, 5)) + # make sure the sizes are scaled by area and not by radius\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", \n shape = \"Species\", size = \"Body mass (g)\", col = \"Sex\") +\n scale_color_manual(values = sex_cols)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_5dimensions.png\", width = 7, height = 4, units = \"in\")\n\n\n# 4. Panels -------------------------------------------------------------------\n\nggplot(na.omit(penguins)) +\n geom_point(aes(y = bill_length_mm, # dimension 1: position along y scale\n x = bill_depth_mm, # dimension 2: position along x scale\n col = log(body_mass_g)), # dimension 3: hue\n alpha = .7, size = 2) + \n facet_wrap(~ species) + # dimension 4: species!\n # this will create a separate panel for each species\n # note: this also automatically uses the same axes for all panels! If you want \n # axes to vary between panels, use the argument scales = \"free\"\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", col = \"Body mass (g)\") +\n scale_color_viridis_c(option = \"magma\", end = .9, direction = -1) +\n theme_linedraw() + theme(panel.grid = element_blank()) # making the panels prettier\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_dimensions_facets.png\", width = 7, height = 4, units = \"in\")\n\n\n# 5. Interactive ---------------------------------------------------------------\n\np <- na.omit(penguins) %>%\n ggplot(aes(y = bill_length_mm, \n x = bill_depth_mm, \n col = log(body_mass_g))) +\n geom_point(size = 2, alpha = .7) + \n facet_wrap(~ species) +\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", col = \"Body mass (g)\") +\n scale_color_viridis_c(option = \"magma\", end = .9, direction = -1) +\n theme_linedraw() + theme(panel.grid = element_blank()) # making the panels prettier\np <- ggplotly(p)\n#setwd(\"figures\")\nhtmlwidgets::saveWidget(as_widget(p), \"figures/penguins_interactive.html\")\np\n```\n\n::: {.cell-output-display}\n```{=html}\n\n\n```\n:::\n:::\n\n\n### Example figures\n\n\n::: {.cell hash='index_cache/html/animated.volcano_e85afe995a0e6702984595b25d6489b8'}\n\n```{.r .cell-code}\n# Script to make animated plot of volcano eruptions over time\n\n# Load libraries:\nlibrary(dplyr) # data manipulation\nlibrary(ggplot2) # plotting\nlibrary(gganimate) # animation\nlibrary(gifski) # creating gifs\n\n# set ggplot theme\ntheme_set(theme_classic() +\n theme(axis.title = element_text(size = 11, face = \"bold\"),\n axis.text = element_text(size = 11),\n plot.title = element_text(size = 13, face = \"bold\"),\n legend.title = element_text(size = 11, face = \"bold\"),\n legend.text = element_text(size = 10)))\n\n# function to floor a year to the decade\nfloor_decade = function(value){return(value - value %% 10)}\n\n# read data \neruptions <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-12/eruptions.csv')\n\n# select top 5 most frequently exploding volcanoes\ntemp <- group_by(eruptions, volcano_name) %>% tally() \ntemp <- temp[order(temp$n, decreasing = TRUE),]\n\n# make a time series dataset (number of eruptions per year)\neruptions$start_decade = floor_decade(eruptions$start_year)\n\n# filter dataset to subset we want to visualize\ndf <- eruptions %>% \n filter(between(start_decade, 1900, 2019)) %>%\n filter(volcano_name %in% temp$volcano_name[1:5]) %>%\n group_by(start_decade) %>%\n count(volcano_name) %>% ungroup()\n\n# plot!\np <- ggplot(df, aes(x = start_decade, y = n, fill = volcano_name)) +\n geom_area() +\n geom_vline(aes(xintercept = start_decade)) + # line that follows the current decade\n scale_fill_viridis_d(option = \"magma\", end = .8) +\n labs(x = \"\", y = \"Number of eruptions\", fill = \"Volcano\",\n title = 'Eruptions of the top 5 most frequently erupting volcanos worldwide') +\n # gganimate part: reveals each decade\n transition_reveal(start_decade) \nanimate(p, duration = 5, fps = 20, width = 800, height = 300, renderer = gifski_renderer())\n```\n\n::: {.cell-output-display}\n\n:::\n\n```{.r .cell-code}\n#anim_save(\"figures/volcano_eruptions.gif\")\n```\n:::\n\n::: {.cell hash='index_cache/html/coffee.uncertainty_21b5746a8b00c943a4574608fa050b80'}\n\n```{.r .cell-code}\n# Script to generate plots with various ways of representing uncertainty, based \n# Coffee & Code dataset from https://www.kaggle.com/devready/coffee-and-code/data\n\n# set-up & data manipulation ---------------------------------------------------\n\n# load packages\nlibrary(ggplot2) # for plots, built layer by layer\nlibrary(dplyr) # for data manipulation\nlibrary(magrittr) # for piping\nlibrary(ggridges) # for density ridge plots\nlibrary(patchwork) # great package for \"patching\" plots together!\n\n# set ggplot theme\ntheme_set(theme_classic() +\n theme(axis.title = element_text(size = 11, face = \"bold\"),\n axis.text = element_text(size = 11),\n plot.title = element_text(size = 13, face = \"bold\"),\n legend.title = element_text(size = 11, face = \"bold\"),\n legend.text = element_text(size = 10)))\n\n# import data\ndf <- read.csv(\"data/coffee_code.csv\")\n\n# set labels to be used in all plots\ncoffee_labels <- labs(title = \"Does coffee help programmers code?\",\n x = \"Coffee while coding\", \n y = \"Time spent coding \\n(hours/day)\") \n\n# the variable CodingWithoutCoffee is negative, which is harder to understand\n# (i.e. \"No\" means they drink coffee...). So, let's transform it into a more \n# intuitive variable!\ndf$CodingWithCoffee <- gsub(\"No\", \"Usually\", df$CodingWithoutCoffee)\ndf$CodingWithCoffee <- gsub(\"Yes\", \"Rarely\\n or never\", df$CodingWithCoffee)\n# convert to factor and set levels so they show up in a logical order\ndf$CodingWithCoffee <- factor(df$CodingWithCoffee,\n levels = c(\"Rarely\\n or never\", \n \"Sometimes\", \n \"Usually\"))\n\n# calculate summary statistics for the variable of choice\ndf_summary <- group_by(df, CodingWithCoffee) %>%\n summarise(\n # mean\n mean_codinghours = mean(CodingHours), \n # standard deviation\n sd_codinghours = sd(CodingHours), \n # standard error\n se_codinghours = sd(CodingHours)/sqrt(length(CodingHours)))\n\n\n# 1. Error bars (standard error) -----------------------------------------------\n\nggplot(df_summary) +\n geom_errorbar(aes(x = CodingWithCoffee, \n ymin = mean_codinghours - se_codinghours,\n ymax = mean_codinghours + se_codinghours), \n width = .2) +\n geom_point(aes(x = CodingWithCoffee, y = mean_codinghours), \n size = 3) +\n coffee_labels + ylim(0,10)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/coffee_errorbars.png\", width = 5, height = 3, units = \"in\")\n\n# 2. Boxplot -------------------------------------------------------------------\n\nggplot(df) +\n geom_boxplot(aes(x = CodingWithCoffee, y = CodingHours)) +\n coffee_labels\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/coffee_boxplot.png\", width = 5, height = 3, units = \"in\")\n\n\n# 3. Error bar demonstration ---------------------------------------------------\n\n# get some nice colours from viridis (magma)\nerror_cols <- viridis::viridis_pal(option = \"magma\")(5)[2:4]\n# set labels to be used in the palette\nerror_labels = c(\"standard deviation\",\"95% confidence interval\",\"standard error\")\n\nggplot(df_summary) +\n # show the raw data\n geom_jitter(data = df, aes(x = CodingWithCoffee, \n y = CodingHours),\n alpha = .5, width = .05, col = \"grey\") +\n # standard deviation\n geom_errorbar(aes(x = CodingWithCoffee, \n ymin = mean_codinghours - sd_codinghours,\n ymax = mean_codinghours + sd_codinghours,\n col = \"SD\"), width = .2, lwd = 1) +\n # 95% confidence interval\n geom_errorbar(aes(x = CodingWithCoffee, \n ymin = mean_codinghours - 1.96*se_codinghours,\n ymax = mean_codinghours + 1.96*se_codinghours, \n col = \"CI\"), width = .2, lwd = 1) +\n # standard error\n geom_errorbar(aes(x = CodingWithCoffee, \n ymin = mean_codinghours - se_codinghours,\n ymax = mean_codinghours + se_codinghours, \n col = \"SE\"), width = .2, lwd = 1) +\n geom_point(aes(x = CodingWithCoffee, y = mean_codinghours), \n size = 3) +\n coffee_labels + ylim(c(0,11)) +\n # manual palette/legend set-up!\n scale_colour_manual(name = \"Uncertainty metric\", \n values = c(SD = error_cols[1], \n CI = error_cols[2], \n SE = error_cols[3]),\n labels = error_labels) +\n theme(legend.position = \"top\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/coffee_bars_demo.png\", width = 7, height = 5, units = \"in\")\n\n\n# 4. Jitter plot with violin ---------------------------------------------------\n\nggplot() +\n geom_jitter(data = df, aes(x = CodingWithCoffee, \n y = CodingHours),\n alpha = .5, width = .05, col = \"grey\") +\n geom_violin(data = df, aes(x = CodingWithCoffee, \n y = CodingHours), alpha = 0) +\n geom_linerange(data = df_summary,\n aes(x = CodingWithCoffee, \n ymin = mean_codinghours - se_codinghours,\n ymax = mean_codinghours + se_codinghours)) +\n geom_point(data = df_summary, \n aes(x = CodingWithCoffee, \n y = mean_codinghours), size = 3) +\n coffee_labels\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/coffee_violin_jitter.png\", width = 5, height = 3, units = \"in\")\n\n\n# 5. Density ridge plot --------------------------------------------------------\n\nggplot(df) + \n aes(y = CodingWithCoffee, x = CodingHours, fill = stat(x)) +\n geom_density_ridges_gradient(scale = 1.9, size = .2, rel_min_height = 0.005) +\n # colour palette (gradient according to CodingHours)\n scale_fill_viridis_c(option = \"magma\", direction = -1) +\n # remove legend - it's not necessary here!\n theme(legend.position = \"none\") +\n labs(title = coffee_labels$title, \n x = coffee_labels$y, \n y = \"Coffee \\nwhile coding\") + \n theme(axis.title.y = element_text(angle=0, hjust = 1, vjust = .9, \n margin = margin(t = 0, r = -50, b = 0, l = 0)))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/coffee_density_ridges.png\", width = 5, height = 3, units = \"in\")\n\n# 6. Jitter vs. Rug plot ------------------------------------------------------------------\n\njitterplot <- ggplot(df, aes(x = CoffeeCupsPerDay, y = CodingHours)) +\n geom_jitter(alpha = .2) +\n geom_smooth(fill = error_cols[1], col = \"black\", method = lm, lwd = .7) +\n coffee_labels + ylim(c(0,11)) + labs(x = \"Cups of coffee (per day)\")\n\nrugplot <- ggplot(df, aes(x = CoffeeCupsPerDay, y = CodingHours)) +\n geom_smooth(fill = error_cols[1], col = \"black\", method = lm, lwd = .7) +\n geom_rug(position=\"jitter\", alpha = .7) + ylim(c(0,11)) +\n coffee_labels + labs(x = \"Cups of coffee (per day)\")\n\n# patch the two plots together\njitterplot + rugplot\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\n#ggsave(\"figures/coffee_jitter_vs_rugplot.png\", width = 10, height = 4, units = \"in\")\n```\n:::\n\n::: {.cell hash='index_cache/html/densiplot_9e12ea96cb628e826d38f0919f99fa44'}\n\n```{.r .cell-code}\n# Script to generate 95% confidence intervals of a generated random normal distribution\n# as an example in Day 2: Visualizing uncertainty.\n\n# load library\nlibrary(ggplot2)\nlibrary(magrittr)\nlibrary(dplyr)\n\n# set ggplot theme\ntheme_set(theme_classic() +\n theme(axis.title = element_text(size = 11, face = \"bold\"),\n axis.text = element_text(size = 11),\n plot.title = element_text(size = 13, face = \"bold\"),\n legend.title = element_text(size = 11, face = \"bold\"),\n legend.text = element_text(size = 10)))\n\n# set random seed\nset.seed(22)\n\n# generate population (random normal distribution)\ndf <- data.frame(\"value\" = rnorm(50, mean = 0, sd = 1))\n\n# descriptive stats for each distribution\ndesc_stats = df %>% \n summarise(mean_val = mean(value, na.rm = TRUE),\n se_val = sqrt(var(value)/length(value)))\n\n# build density plot!\np <- ggplot(data = df, aes(x = value, y = ..count..)) +\n geom_density(alpha = .2, lwd = .3) +\n xlim(c(min(df$value-1), max(df$value+1))) \n# extract plotted values\nbase_p <- ggplot_build(p)$data[[1]]\n# shade the 95% confidence interval\np + \n geom_area(data = subset(base_p, \n between(x, \n left = (desc_stats$mean_val - 1.96*desc_stats$se_val),\n right = (desc_stats$mean_val + 1.96*desc_stats$se_val))),\n aes(x = x, y = y), fill = \"cadetblue3\", alpha = .6) +\n # add vertical line to show population mean\n geom_vline(aes(xintercept = 0), lty = 2) +\n annotate(\"text\", x = 0.9, y = 19, label = \"True mean\", fontface = \"italic\") +\n # label axis!\n labs(x = \"Variable of interest\", y = \"\") \n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\n#ggsave(\"figures/confidenceinterval_example.png\", width = 5, height = 3.5, units = \"in\")\n```\n:::\n\n\n### Annotated resource library\n\nThis is an annotated library of data visualization resources we used to build the BIOS² Data Visualization Training, as well as some bonus resources we didn't have the time to include. Feel free to save this page as a reference for your data visualization adventures!\n\n------------------------------------------------------------------------\n\n#### Books & articles\n\n[**Fundamentals of Data Visualization**](https://serialmentor.com/dataviz/) A primer on making informative and compelling figures. This is the website for the book \"Fundamentals of Data Visualization\" by Claus O. Wilke, published by O'Reilly Media, Inc.\n\n[**Data Visualization: A practical introduction**](https://socviz.co/index.html#preface) An accessible primer on how to create effective graphics from data using R (mainly ggplot). This book provides a hands-on introduction to the principles and practice of data visualization, explaining what makes some graphs succeed while others fail, how to make high-quality figures from data using powerful and reproducible methods, and how to think about data visualization in an honest and effective way.\n\n[**Data Science Design (Chapter 6: Visualizing Data)**](https://link.springer.com/content/pdf/10.1007%2F978-3-319-55444-0.pdf) Covers the principles that make standard plot designs work, show how they can be misleading if not properly used, and develop a sense of when graphs might be lying, and how to construct better ones.\n\n[**Graphical Perception: Theory, Experimentation, and Application to the Development of Graphical Methods**](https://www.jstor.org/stable/2288400) Cleveland, William S., and Robert McGill. \"Graphical Perception: Theory, Experimentation, and Application to the Development of Graphical Methods.\" Journal of the American Statistical Association, vol. 79, no. 387, 1984, pp. 531--554. JSTOR, www.jstor.org/stable/2288400. Accessed 9 Oct. 2020.\n\n[**Graphical Perception and Graphical Methods for Analyzing Scientific Data**](10.1126/science.229.4716.828) Cleveland, William S., and Robert McGill. \"Graphical perception and graphical methods for analyzing scientific data.\" Science 229.4716 (1985): 828-833.\n\n[**From Static to Interactive: Transforming Data Visualization to Improve Transparency**](https://doi.org/10.1371/journal.pbio.1002484) Weissgerber TL, Garovic VD, Savic M, Winham SJ, Milic NM (2016) designed an interactive line graph that demonstrates how dynamic alternatives to static graphics for small sample size studies allow for additional exploration of empirical datasets. This [simple, free, web-based tool](http://statistika.mfub.bg.ac.rs/interactive-graph/) demonstrates the overall concept and may promote widespread use of interactive graphics.\n\n[**Data visualization: ambiguity as a fellow traveler**](https://doi.org/10.1038/nmeth.2530) Research that is being done about how to visualize uncertainty in data visualizations. Marx, V. Nat Methods 10, 613--615 (2013). \n\n[**Data visualization standards**](https://xdgov.github.io/data-design-standards/) Collection of guidance and resources to help create better data visualizations with less effort.\n\n------------------------------------------------------------------------\n\n#### Design principles\n\n[**Gestalt Principles for Data Visualization: Similarity, Proximity & Enclosure**](http://emeeks.github.io/gestaltdataviz/section1.html) Short visual guide to the Gestalt Principles.\n\n[**Why scientists need to be better at data visualization**](https://www.knowablemagazine.org/article/mind/2019/science-data-visualization?utm_campaign=2019-11-17) A great overview of principles that could improve how we visualize scientific data and results.\n\n[**A collection of graphic pitfalls**](https://www.data-to-viz.com/caveats.html) A collection of short articles about common issues with data visualizations that can mislead or obscure your message.\n\n------------------------------------------------------------------------\n\n#### Choosing a visualization\n\n[**Data Viz Project**](https://datavizproject.com/) This is a great place to get inspiration and guidance about how to choose an appropriate visualization. There are many visualizations we are not used to seeing in ecology!\n\n[**From data to Viz \\| Find the graphic you need**](https://www.data-to-viz.com/) Interactive tool to choose an appropriate visualization type for your data.\n\n------------------------------------------------------------------------\n\n#### Colour\n\n[**What to consider when choosing colors for data visualization**](https://blog.datawrapper.de/colors/) A short, visual guide on things to keep in mind when using colour, such as when and how to use colour gradients, the colour grey, etc.\n\n[**ColorBrewer: Color Advice for Maps**](https://colorbrewer2.org/) Tool to generate colour palettes for visualizations with colorblind-friendly options. You can also use these palettes in R using the [RColorBrewer](https://cran.r-project.org/web/packages/RColorBrewer/index.html) package, and the `scale_*_brewer()` (for discrete palettes) or `scale_*_distiller()` (for continuous palettes) functions in ggplot2.\n\n[**Color.review**](https://color.review/) Tool to pick or verify colour palettes with high relative contrast between colours, to ensure your information is readable for everyone.\n\n[**Coblis --- Color Blindness Simulator**](https://www.color-blindness.com/coblis-color-blindness-simulator/) Tool to upload an image and view it as they would appear to a colorblind person, with the option to simulate several color-vision deficiencies.\n\n[**500+ Named Colours with rgb and hex values**](http://cloford.com/resources/colours/500col.htm) List of named colours along with their hex values.\n\n[**CartoDB/CartoColor**](https://github.com/CartoDB/cartocolor) CARTOColors are a set of custom color palettes built on top of well-known standards for color use on maps, with next generation enhancements for the web and CARTO basemaps. Choose from a selection of sequential, diverging, or qualitative schemes for your next CARTO powered visualization using their [online module](https://carto.com/carto-colors/).\n\n------------------------------------------------------------------------\n\n#### Tools\n\n##### R\n\n[**The R Graph Gallery**](https://www.r-graph-gallery.com/index.html) A collection of charts made with the R programming language. Hundreds of charts are displayed in several sections, always with their reproducible code available. The gallery makes a focus on the tidyverse and ggplot2.\n\n###### Base R {.unnumbered}\n\n[**Cheatsheet: Margins in base R**](https://www.r-graph-gallery.com/74-margin-and-oma-cheatsheet) Edit your margins in base R to accommodate axis titles, legends, captions, etc.!\n\n[**Customizing tick marks in base R**](https://insileco.github.io/2020/08/29/custom-tick-marks-with-rs-base-graphics-system/) Seems like a simple thing, but it can be so frustrating! This is a great post about customizing tick marks with base plot in R.\n\n[**Animations in R (for time series)**](https://insileco.github.io/2017/07/05/animations-in-r-time-series-of-erythemal-irradiance-in-the-st.-lawrence/) If you want to use animations but don't want to use ggplot2, this demo might help you!\n\n###### ggplot2 {.unnumbered}\n\n[**Cheatsheet: ggplot2**](http://r-statistics.co/ggplot2-cheatsheet.html) Cheatsheet for ggplot2 in R - anything you want to do is probably covered here!\n\n[**Coding Club tutorial: Data Viz Part 1 - Beautiful and informative data visualization**](https://ourcodingclub.github.io/tutorials/datavis/) Great tutorial demonstrating how to customize titles, subtitles, captions, labels, colour palettes, and themes in ggplot2.\n\n[**Coding Club tutorial: Data Viz Part 2 - Customizing your figures**](https://ourcodingclub.github.io/tutorials/data-vis-2/) Great tutorial demonstrating how to customize titles, subtitles, captions, labels, colour palettes, and themes in ggplot2.\n\n[**ggplot flipbook**](https://evamaerey.github.io/ggplot_flipbook/ggplot_flipbook_xaringan.html#1) A flipbook-style demonstration that builds and customizes plots line by line using ggplot in R.\n\n[**gganimate: A Grammar of Animated Graphics**](https://github.com/thomasp85/gganimate) Package to create animated graphics in R (with ggplot2).\n\n##### Python\n\n[**The Python Graph Gallery**](https://python-graph-gallery.com/) This website displays hundreds of charts, always providing the reproducible python code.\n\n[**Python Tutorial: Intro to Matplotlib**](https://github.com/Randonnees-Datatrek/data-trek-2020/blob/master/Tutorials/Python_Tutorial/python_tutorial.ipynb) Introduction to basic functionalities of the Python's library Matplotlib covering basic plots, plot attributes, subplots and plotting the `iris` dataset.\n\n[**The Art of Effective Visualization of Multi-dimensional Data**](https://towardsdatascience.com/the-art-of-effective-visualization-of-multi-dimensional-data-6c7202990c57) Covers both univariate (one-dimension) and multivariate (multi-dimensional) data visualization strategies using the Python machine learning ecosystem.\n\n##### Julia\n\n[**Julia Plots Gallery**](https://goropikari.github.io/PlotsGallery.jl/) Display of various plots with reproducible code in Julia.\n\n[**Plots in Julia**](http://docs.juliaplots.org/latest/#Plots-powerful-convenience-for-visualization-in-Julia) Documentation for the Plots package in Julia, including demonstrations for animated plots, and links to tutorials.\n\n[**Animations in Julia**](http://docs.juliaplots.org/latest/animations/) How to start making animated plots in Julia.\n\n------------------------------------------------------------------------\n\n#### Customization\n\n[**Chart Studio**](https://plotly.com/chart-studio/) Web editor to create interactive plots with plotly. You can download the image as .html, or static images, without coding the figure yourself.\n\n[**PhyloPic**](http://phylopic.org/) Vector images of living organisms. This is great for ecologists who want to add silhouettes of their organisms onto their plots - search anything, and you will likely find it!\n\n[**Add icons on your R plot**](https://insileco.github.io/2017/05/23/add-icons-on-your-r-plot/) Add special icons to your plot as a great way to customize it, and save space with labels!\n\n------------------------------------------------------------------------\n\n#### Inspiration (pretty things!)\n\n[**Information is Beautiful**](https://informationisbeautiful.net/visualizations/) Collection of beautiful original visualizations about a variety of topics!\n\n[**TidyTuesday**](https://github.com/rfordatascience/tidytuesday) A weekly data project aimed at the R ecosystem, where people wrangle and visualize data in loads of creative ways. Browse what people have created ([#TidyTuesday](https://twitter.com/search?q=%23TidyTuesday) on Twitter is great too!), and the visualizations that have inspired each week's theme.\n\n[**Wind currents on Earth**](https://earth.nullschool.net/) Dynamic and interactive map of wind currents on Earth.\n\n[**A Day in the Life of Americans**](https://flowingdata.com/2015/12/15/a-day-in-the-life-of-americans/) Dynamic visualisation of how Americans spend their time in an average day.\n\n[**2019: The Year in Visual Stories and Graphics**](https://www.nytimes.com/interactive/2019/12/30/us/2019-year-in-graphics.html) Collection of the most popular visualizations by the New York Times in 2019.\n",
+ "markdown": "---\ntitle: \"Data Visualization\"\ndescription: |\n General principles of visualization and graphic design, and techniques of tailored visualization. This training was developed and delivered by Alex Arkilanian and Katherine Hébert on September 21st and 22nd, 2020.\nauthor:\n - Alex Arkilanian\n - Katherine Hébert\ncategories: [Technical, Fellow contributed, EN]\ndate: \"09-21-2020\"\nimage: image.jpg\ntoc: true\nnumber-sections: true\nnumber-depth: 1\nformat: \n html:\n code-fold: true\n code-summary: \"Show code\"\nexecute: \n cache: true\n warning: false\n message: false\n collapse: true\n---\n\n\nWelcome!\n\nThis training covers the general principles of visualization and graphic design, and techniques of tailored visualization. More specifically, the objectives of the training are:\n\n- Make an overview of basic data visualization principles, including shapes, sizes, colours, and fonts.\n- Discuss how to choose the right visualization for your data, what you want to communicate, and who you want to communicate to.\n- Tools and principles to tailor visualizations, particularly in making interpretable, interactive, and honest visualizations.\n\n## Training material\n\n*Click on \"Show code\" to learn how to do each plot!*\n\n### Interactive examples\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-1_3ffdc9070d841790d6510b3c8ffbac4e'}\n\n:::\n\n\n\n\n#### Streamgraph\n\n\n::: {.cell hash='index_cache/html/streamgraph-plot_93fdd122ca2090828f4a810da98557e8'}\n\n```{.r .cell-code}\n# Script to make a streamgraph of the top 10 most popular dog breeds in \n# New York City from 1999 to 2015\n\n# load libraries\nlibrary(lubridate) # dealing with dates\nlibrary(dplyr) # data manipulation\nlibrary(streamgraph) #devtools::install_github(\"hrbrmstr/streamgraph\")\nlibrary(htmlwidgets) # to save the widget!\n\n# load the dataset\n# more information about this dataset can be found here:\n# https://www.kaggle.com/smithaachar/nyc-dog-licensing-clean\nnyc_dogs <- read.csv(\"data/nyc_dogs.csv\")\n\n# convert birth year to date format (and keep only the year)\nnyc_dogs$AnimalBirthYear <- mdy_hms(nyc_dogs$AnimalBirthMonth) %>% year()\n\n# identify 10 most common dogs\ntopdogs <- nyc_dogs %>% count(BreedName) \ntopdogs <- topdogs[order(topdogs$n, decreasing = TRUE),]\n# keep 10 most common breeds (and remove last year of data which is incomplete)\ndf <- filter(nyc_dogs, BreedName %in% topdogs$BreedName[2:11] & AnimalBirthYear < 2016) %>% \n group_by(AnimalBirthYear) %>% \n count(BreedName) %>% ungroup()\n\n# get some nice colours from viridis (magma)\ncols <- viridis::viridis_pal(option = \"magma\")(length(unique(df$BreedName)))\n\n# make streamgraph!\npp <- streamgraph(df, \n key = BreedName, value = n, date = AnimalBirthYear, \n height=\"600px\", width=\"1000px\") %>%\n sg_legend(show=TRUE, label=\"names: \") %>%\n sg_fill_manual(values = cols) \n# saveWidget(pp, file=paste0(getwd(), \"/figures/dogs_streamgraph.html\"))\n\n# plot\npp\n```\n\n::: {.cell-output-display}\n```{=html}\n\n
\n\n```\n:::\n:::\n\n\n------------------------------------------------------------------------\n\n#### Interactive plot\n\n\n::: {.cell hash='index_cache/html/interactive-plot_ffab3ec1ce4e0abef23fd229dc1c8908'}\n\n```{.r .cell-code}\n# Script to generate plots to demonstrate how combinations of information dimensions\n# can become overwhelming and difficult to interpret.\n\n# set-up & data manipulation ---------------------------------------------------\n\n# load packages\nlibrary(ggplot2) # for plots, built layer by layer\nlibrary(dplyr) # for data manipulation\nlibrary(magrittr) # for piping\nlibrary(plotly) # interactive plots\n\n# set ggplot theme\ntheme_set(theme_classic() +\n theme(axis.title = element_text(size = 11, face = \"bold\"),\n axis.text = element_text(size = 11),\n plot.title = element_text(size = 13, face = \"bold\"),\n legend.title = element_text(size = 11, face = \"bold\"),\n legend.text = element_text(size = 10)))\n\n# import data\n# more info on this dataset: https://github.com/rfordatascience/tidytuesday/blob/master/data/2020/2020-07-28/readme.md\npenguins <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-07-28/penguins.csv') \n\n# get some nice colours from viridis (magma)\nsp_cols <- viridis::viridis_pal(option = \"magma\")(5)[2:4]\n\n\n#### Day 1 ####\n\n# 1. Similarity\n\nggplot(penguins) +\n geom_point(aes(y = bill_length_mm, x = bill_depth_mm, col = species), size = 2.5) +\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", col = \"Species\") + # labels\n scale_color_manual(values = sp_cols) # sets the colour scale we created above \n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_similarity.png\", width = 6, height = 3, units = \"in\")\n\n# 2. Proximity\n\ndf <- penguins %>% group_by(sex, species) %>% \n summarise(mean_mass = mean(body_mass_g, na.rm = TRUE)) %>% na.omit() \nggplot(df) +\n geom_bar(aes(y = mean_mass, x = species, fill = sex), \n position = \"dodge\", stat = \"identity\") +\n labs(x = \"Species\", y = \"Mean body mass (g)\", col = \"Sex\") + # labels\n scale_fill_manual(values = sp_cols) # sets the colour scale we created above\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_proximity.png\", width = 6, height = 3, units = \"in\")\n\n# 3. Enclosure (Ellipses over a fake PCA)\nggplot(data = penguins, \n aes(y = bill_length_mm, x = bill_depth_mm)) +\n geom_point(size = 2.1, col = \"grey30\") +\n stat_ellipse(aes(col = species), lwd = .7) +\n labs(x = \"PCA1\", y = \"PCA2\", col = \"Species\") + # labels\n scale_color_manual(values = sp_cols) + # sets the colour scale we created above\n theme(axis.text = element_blank(), axis.ticks = element_blank())\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_enclosure.png\", width = 6, height = 3, units = \"in\")\n\n# 4. Mismatched combination of principles\ntemp_palette <- rev(c(sp_cols, \"#1f78b4\", \"#33a02c\"))\nggplot(data = penguins, \n aes(y = bill_length_mm, x = bill_depth_mm)) +\n geom_point(aes(col = sex), size = 2.1) +\n stat_ellipse(aes(col = species), lwd = .7) +\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", col = \"?\") + # labels\n scale_color_manual(values = temp_palette) # sets the colour scale we created above\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_mismatchedgestalt.png\", width = 6, height = 3, units = \"in\")\n\n\n\n#### Day 2 ####\n\n# 1. Ineffective combinations: Luminance & shading -----------------------------\n\n# create the plot\nggplot(penguins) +\n geom_point(aes(y = bill_length_mm, x = bill_depth_mm, \n col = species, # hue\n alpha = log(body_mass_g)), # luminance\n size = 2.5) +\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", \n col = \"Species\", alpha = \"Body mass (g)\") +\n scale_color_manual(values = sp_cols)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_incompatible1.png\", width = 6, height = 3, units = \"in\")\n\n# 2. Ineffective combinations: Sizes and shapes --------------------------------\n\nggplot(penguins) +\n geom_point(aes(y = bill_length_mm, x = bill_depth_mm, \n shape = species, # shape\n size = log(body_mass_g)), alpha = .7) + # size\n scale_size(range = c(.1, 5)) + # make sure the sizes are scaled by area and not by radius\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", \n shape = \"Species\", size = \"Body mass (g)\") \n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_incompatible2.png\", width = 6, height = 3, units = \"in\")\n\n# 3. Cognitive overload --------------------------------------------------------\n\n# get some nice colours from viridis (magma)\nsex_cols <- viridis::viridis_pal(option = \"magma\")(8)[c(3,6)]\n\nggplot(na.omit(penguins)) +\n geom_point(aes(y = bill_length_mm, # dimension 1: position along y scale\n x = bill_depth_mm, # dimension 2: position along x scale\n shape = species, # dimension 3: shape\n size = log(body_mass_g), # dimension 4: size\n col = sex), # dimension 5: hue\n alpha = .7) + # size\n scale_size(range = c(.1, 5)) + # make sure the sizes are scaled by area and not by radius\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", \n shape = \"Species\", size = \"Body mass (g)\", col = \"Sex\") +\n scale_color_manual(values = sex_cols)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_5dimensions.png\", width = 7, height = 4, units = \"in\")\n\n\n# 4. Panels -------------------------------------------------------------------\n\nggplot(na.omit(penguins)) +\n geom_point(aes(y = bill_length_mm, # dimension 1: position along y scale\n x = bill_depth_mm, # dimension 2: position along x scale\n col = log(body_mass_g)), # dimension 3: hue\n alpha = .7, size = 2) + \n facet_wrap(~ species) + # dimension 4: species!\n # this will create a separate panel for each species\n # note: this also automatically uses the same axes for all panels! If you want \n # axes to vary between panels, use the argument scales = \"free\"\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", col = \"Body mass (g)\") +\n scale_color_viridis_c(option = \"magma\", end = .9, direction = -1) +\n theme_linedraw() + theme(panel.grid = element_blank()) # making the panels prettier\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/penguins_dimensions_facets.png\", width = 7, height = 4, units = \"in\")\n\n\n# 5. Interactive ---------------------------------------------------------------\n\np <- na.omit(penguins) %>%\n ggplot(aes(y = bill_length_mm, \n x = bill_depth_mm, \n col = log(body_mass_g))) +\n geom_point(size = 2, alpha = .7) + \n facet_wrap(~ species) +\n labs(x = \"Bill depth (mm)\", y = \"Bill length (mm)\", col = \"Body mass (g)\") +\n scale_color_viridis_c(option = \"magma\", end = .9, direction = -1) +\n theme_linedraw() + theme(panel.grid = element_blank()) # making the panels prettier\np <- ggplotly(p)\n#setwd(\"figures\")\nhtmlwidgets::saveWidget(as_widget(p), \"figures/penguins_interactive.html\")\np\n```\n\n::: {.cell-output-display}\n```{=html}\n\n\n```\n:::\n:::\n\n\n### Example figures\n\n\n::: {.cell hash='index_cache/html/animated.volcano_e85afe995a0e6702984595b25d6489b8'}\n\n```{.r .cell-code}\n# Script to make animated plot of volcano eruptions over time\n\n# Load libraries:\nlibrary(dplyr) # data manipulation\nlibrary(ggplot2) # plotting\nlibrary(gganimate) # animation\nlibrary(gifski) # creating gifs\n\n# set ggplot theme\ntheme_set(theme_classic() +\n theme(axis.title = element_text(size = 11, face = \"bold\"),\n axis.text = element_text(size = 11),\n plot.title = element_text(size = 13, face = \"bold\"),\n legend.title = element_text(size = 11, face = \"bold\"),\n legend.text = element_text(size = 10)))\n\n# function to floor a year to the decade\nfloor_decade = function(value){return(value - value %% 10)}\n\n# read data \neruptions <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-12/eruptions.csv')\n\n# select top 5 most frequently exploding volcanoes\ntemp <- group_by(eruptions, volcano_name) %>% tally() \ntemp <- temp[order(temp$n, decreasing = TRUE),]\n\n# make a time series dataset (number of eruptions per year)\neruptions$start_decade = floor_decade(eruptions$start_year)\n\n# filter dataset to subset we want to visualize\ndf <- eruptions %>% \n filter(between(start_decade, 1900, 2019)) %>%\n filter(volcano_name %in% temp$volcano_name[1:5]) %>%\n group_by(start_decade) %>%\n count(volcano_name) %>% ungroup()\n\n# plot!\np <- ggplot(df, aes(x = start_decade, y = n, fill = volcano_name)) +\n geom_area() +\n geom_vline(aes(xintercept = start_decade)) + # line that follows the current decade\n scale_fill_viridis_d(option = \"magma\", end = .8) +\n labs(x = \"\", y = \"Number of eruptions\", fill = \"Volcano\",\n title = 'Eruptions of the top 5 most frequently erupting volcanos worldwide') +\n # gganimate part: reveals each decade\n transition_reveal(start_decade) \nanimate(p, duration = 5, fps = 20, width = 800, height = 300, renderer = gifski_renderer())\n```\n\n::: {.cell-output-display}\n\n:::\n\n```{.r .cell-code}\n#anim_save(\"figures/volcano_eruptions.gif\")\n```\n:::\n\n::: {.cell hash='index_cache/html/coffee.uncertainty_21b5746a8b00c943a4574608fa050b80'}\n\n```{.r .cell-code}\n# Script to generate plots with various ways of representing uncertainty, based \n# Coffee & Code dataset from https://www.kaggle.com/devready/coffee-and-code/data\n\n# set-up & data manipulation ---------------------------------------------------\n\n# load packages\nlibrary(ggplot2) # for plots, built layer by layer\nlibrary(dplyr) # for data manipulation\nlibrary(magrittr) # for piping\nlibrary(ggridges) # for density ridge plots\nlibrary(patchwork) # great package for \"patching\" plots together!\n\n# set ggplot theme\ntheme_set(theme_classic() +\n theme(axis.title = element_text(size = 11, face = \"bold\"),\n axis.text = element_text(size = 11),\n plot.title = element_text(size = 13, face = \"bold\"),\n legend.title = element_text(size = 11, face = \"bold\"),\n legend.text = element_text(size = 10)))\n\n# import data\ndf <- read.csv(\"data/coffee_code.csv\")\n\n# set labels to be used in all plots\ncoffee_labels <- labs(title = \"Does coffee help programmers code?\",\n x = \"Coffee while coding\", \n y = \"Time spent coding \\n(hours/day)\") \n\n# the variable CodingWithoutCoffee is negative, which is harder to understand\n# (i.e. \"No\" means they drink coffee...). So, let's transform it into a more \n# intuitive variable!\ndf$CodingWithCoffee <- gsub(\"No\", \"Usually\", df$CodingWithoutCoffee)\ndf$CodingWithCoffee <- gsub(\"Yes\", \"Rarely\\n or never\", df$CodingWithCoffee)\n# convert to factor and set levels so they show up in a logical order\ndf$CodingWithCoffee <- factor(df$CodingWithCoffee,\n levels = c(\"Rarely\\n or never\", \n \"Sometimes\", \n \"Usually\"))\n\n# calculate summary statistics for the variable of choice\ndf_summary <- group_by(df, CodingWithCoffee) %>%\n summarise(\n # mean\n mean_codinghours = mean(CodingHours), \n # standard deviation\n sd_codinghours = sd(CodingHours), \n # standard error\n se_codinghours = sd(CodingHours)/sqrt(length(CodingHours)))\n\n\n# 1. Error bars (standard error) -----------------------------------------------\n\nggplot(df_summary) +\n geom_errorbar(aes(x = CodingWithCoffee, \n ymin = mean_codinghours - se_codinghours,\n ymax = mean_codinghours + se_codinghours), \n width = .2) +\n geom_point(aes(x = CodingWithCoffee, y = mean_codinghours), \n size = 3) +\n coffee_labels + ylim(0,10)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/coffee_errorbars.png\", width = 5, height = 3, units = \"in\")\n\n# 2. Boxplot -------------------------------------------------------------------\n\nggplot(df) +\n geom_boxplot(aes(x = CodingWithCoffee, y = CodingHours)) +\n coffee_labels\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/coffee_boxplot.png\", width = 5, height = 3, units = \"in\")\n\n\n# 3. Error bar demonstration ---------------------------------------------------\n\n# get some nice colours from viridis (magma)\nerror_cols <- viridis::viridis_pal(option = \"magma\")(5)[2:4]\n# set labels to be used in the palette\nerror_labels = c(\"standard deviation\",\"95% confidence interval\",\"standard error\")\n\nggplot(df_summary) +\n # show the raw data\n geom_jitter(data = df, aes(x = CodingWithCoffee, \n y = CodingHours),\n alpha = .5, width = .05, col = \"grey\") +\n # standard deviation\n geom_errorbar(aes(x = CodingWithCoffee, \n ymin = mean_codinghours - sd_codinghours,\n ymax = mean_codinghours + sd_codinghours,\n col = \"SD\"), width = .2, lwd = 1) +\n # 95% confidence interval\n geom_errorbar(aes(x = CodingWithCoffee, \n ymin = mean_codinghours - 1.96*se_codinghours,\n ymax = mean_codinghours + 1.96*se_codinghours, \n col = \"CI\"), width = .2, lwd = 1) +\n # standard error\n geom_errorbar(aes(x = CodingWithCoffee, \n ymin = mean_codinghours - se_codinghours,\n ymax = mean_codinghours + se_codinghours, \n col = \"SE\"), width = .2, lwd = 1) +\n geom_point(aes(x = CodingWithCoffee, y = mean_codinghours), \n size = 3) +\n coffee_labels + ylim(c(0,11)) +\n # manual palette/legend set-up!\n scale_colour_manual(name = \"Uncertainty metric\", \n values = c(SD = error_cols[1], \n CI = error_cols[2], \n SE = error_cols[3]),\n labels = error_labels) +\n theme(legend.position = \"top\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/coffee_bars_demo.png\", width = 7, height = 5, units = \"in\")\n\n\n# 4. Jitter plot with violin ---------------------------------------------------\n\nggplot() +\n geom_jitter(data = df, aes(x = CodingWithCoffee, \n y = CodingHours),\n alpha = .5, width = .05, col = \"grey\") +\n geom_violin(data = df, aes(x = CodingWithCoffee, \n y = CodingHours), alpha = 0) +\n geom_linerange(data = df_summary,\n aes(x = CodingWithCoffee, \n ymin = mean_codinghours - se_codinghours,\n ymax = mean_codinghours + se_codinghours)) +\n geom_point(data = df_summary, \n aes(x = CodingWithCoffee, \n y = mean_codinghours), size = 3) +\n coffee_labels\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/coffee_violin_jitter.png\", width = 5, height = 3, units = \"in\")\n\n\n# 5. Density ridge plot --------------------------------------------------------\n\nggplot(df) + \n aes(y = CodingWithCoffee, x = CodingHours, fill = stat(x)) +\n geom_density_ridges_gradient(scale = 1.9, size = .2, rel_min_height = 0.005) +\n # colour palette (gradient according to CodingHours)\n scale_fill_viridis_c(option = \"magma\", direction = -1) +\n # remove legend - it's not necessary here!\n theme(legend.position = \"none\") +\n labs(title = coffee_labels$title, \n x = coffee_labels$y, \n y = \"Coffee \\nwhile coding\") + \n theme(axis.title.y = element_text(angle=0, hjust = 1, vjust = .9, \n margin = margin(t = 0, r = -50, b = 0, l = 0)))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nggsave(\"figures/coffee_density_ridges.png\", width = 5, height = 3, units = \"in\")\n\n# 6. Jitter vs. Rug plot ------------------------------------------------------------------\n\njitterplot <- ggplot(df, aes(x = CoffeeCupsPerDay, y = CodingHours)) +\n geom_jitter(alpha = .2) +\n geom_smooth(fill = error_cols[1], col = \"black\", method = lm, lwd = .7) +\n coffee_labels + ylim(c(0,11)) + labs(x = \"Cups of coffee (per day)\")\n\nrugplot <- ggplot(df, aes(x = CoffeeCupsPerDay, y = CodingHours)) +\n geom_smooth(fill = error_cols[1], col = \"black\", method = lm, lwd = .7) +\n geom_rug(position=\"jitter\", alpha = .7) + ylim(c(0,11)) +\n coffee_labels + labs(x = \"Cups of coffee (per day)\")\n\n# patch the two plots together\njitterplot + rugplot\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\n#ggsave(\"figures/coffee_jitter_vs_rugplot.png\", width = 10, height = 4, units = \"in\")\n```\n:::\n\n::: {.cell hash='index_cache/html/densiplot_9e12ea96cb628e826d38f0919f99fa44'}\n\n```{.r .cell-code}\n# Script to generate 95% confidence intervals of a generated random normal distribution\n# as an example in Day 2: Visualizing uncertainty.\n\n# load library\nlibrary(ggplot2)\nlibrary(magrittr)\nlibrary(dplyr)\n\n# set ggplot theme\ntheme_set(theme_classic() +\n theme(axis.title = element_text(size = 11, face = \"bold\"),\n axis.text = element_text(size = 11),\n plot.title = element_text(size = 13, face = \"bold\"),\n legend.title = element_text(size = 11, face = \"bold\"),\n legend.text = element_text(size = 10)))\n\n# set random seed\nset.seed(22)\n\n# generate population (random normal distribution)\ndf <- data.frame(\"value\" = rnorm(50, mean = 0, sd = 1))\n\n# descriptive stats for each distribution\ndesc_stats = df %>% \n summarise(mean_val = mean(value, na.rm = TRUE),\n se_val = sqrt(var(value)/length(value)))\n\n# build density plot!\np <- ggplot(data = df, aes(x = value, y = ..count..)) +\n geom_density(alpha = .2, lwd = .3) +\n xlim(c(min(df$value-1), max(df$value+1))) \n# extract plotted values\nbase_p <- ggplot_build(p)$data[[1]]\n# shade the 95% confidence interval\np + \n geom_area(data = subset(base_p, \n between(x, \n left = (desc_stats$mean_val - 1.96*desc_stats$se_val),\n right = (desc_stats$mean_val + 1.96*desc_stats$se_val))),\n aes(x = x, y = y), fill = \"cadetblue3\", alpha = .6) +\n # add vertical line to show population mean\n geom_vline(aes(xintercept = 0), lty = 2) +\n annotate(\"text\", x = 0.9, y = 19, label = \"True mean\", fontface = \"italic\") +\n # label axis!\n labs(x = \"Variable of interest\", y = \"\") \n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\n#ggsave(\"figures/confidenceinterval_example.png\", width = 5, height = 3.5, units = \"in\")\n```\n:::\n\n\n### Annotated resource library\n\nThis is an annotated library of data visualization resources we used to build the BIOS² Data Visualization Training, as well as some bonus resources we didn't have the time to include. Feel free to save this page as a reference for your data visualization adventures!\n\n------------------------------------------------------------------------\n\n#### Books & articles\n\n[**Fundamentals of Data Visualization**](https://serialmentor.com/dataviz/) A primer on making informative and compelling figures. This is the website for the book \"Fundamentals of Data Visualization\" by Claus O. Wilke, published by O'Reilly Media, Inc.\n\n[**Data Visualization: A practical introduction**](https://socviz.co/index.html#preface) An accessible primer on how to create effective graphics from data using R (mainly ggplot). This book provides a hands-on introduction to the principles and practice of data visualization, explaining what makes some graphs succeed while others fail, how to make high-quality figures from data using powerful and reproducible methods, and how to think about data visualization in an honest and effective way.\n\n[**Data Science Design (Chapter 6: Visualizing Data)**](https://link.springer.com/content/pdf/10.1007%2F978-3-319-55444-0.pdf) Covers the principles that make standard plot designs work, show how they can be misleading if not properly used, and develop a sense of when graphs might be lying, and how to construct better ones.\n\n[**Graphical Perception: Theory, Experimentation, and Application to the Development of Graphical Methods**](https://www.jstor.org/stable/2288400) Cleveland, William S., and Robert McGill. \"Graphical Perception: Theory, Experimentation, and Application to the Development of Graphical Methods.\" Journal of the American Statistical Association, vol. 79, no. 387, 1984, pp. 531--554. JSTOR, www.jstor.org/stable/2288400. Accessed 9 Oct. 2020.\n\n[**Graphical Perception and Graphical Methods for Analyzing Scientific Data**](10.1126/science.229.4716.828) Cleveland, William S., and Robert McGill. \"Graphical perception and graphical methods for analyzing scientific data.\" Science 229.4716 (1985): 828-833.\n\n[**From Static to Interactive: Transforming Data Visualization to Improve Transparency**](https://doi.org/10.1371/journal.pbio.1002484) Weissgerber TL, Garovic VD, Savic M, Winham SJ, Milic NM (2016) designed an interactive line graph that demonstrates how dynamic alternatives to static graphics for small sample size studies allow for additional exploration of empirical datasets. This [simple, free, web-based tool](http://statistika.mfub.bg.ac.rs/interactive-graph/) demonstrates the overall concept and may promote widespread use of interactive graphics.\n\n[**Data visualization: ambiguity as a fellow traveler**](https://doi.org/10.1038/nmeth.2530) Research that is being done about how to visualize uncertainty in data visualizations. Marx, V. Nat Methods 10, 613--615 (2013). \n\n[**Data visualization standards**](https://xdgov.github.io/data-design-standards/) Collection of guidance and resources to help create better data visualizations with less effort.\n\n------------------------------------------------------------------------\n\n#### Design principles\n\n[**Gestalt Principles for Data Visualization: Similarity, Proximity & Enclosure**](http://emeeks.github.io/gestaltdataviz/section1.html) Short visual guide to the Gestalt Principles.\n\n[**Why scientists need to be better at data visualization**](https://www.knowablemagazine.org/article/mind/2019/science-data-visualization?utm_campaign=2019-11-17) A great overview of principles that could improve how we visualize scientific data and results.\n\n[**A collection of graphic pitfalls**](https://www.data-to-viz.com/caveats.html) A collection of short articles about common issues with data visualizations that can mislead or obscure your message.\n\n------------------------------------------------------------------------\n\n#### Choosing a visualization\n\n[**Data Viz Project**](https://datavizproject.com/) This is a great place to get inspiration and guidance about how to choose an appropriate visualization. There are many visualizations we are not used to seeing in ecology!\n\n[**From data to Viz \\| Find the graphic you need**](https://www.data-to-viz.com/) Interactive tool to choose an appropriate visualization type for your data.\n\n------------------------------------------------------------------------\n\n#### Colour\n\n[**What to consider when choosing colors for data visualization**](https://blog.datawrapper.de/colors/) A short, visual guide on things to keep in mind when using colour, such as when and how to use colour gradients, the colour grey, etc.\n\n[**ColorBrewer: Color Advice for Maps**](https://colorbrewer2.org/) Tool to generate colour palettes for visualizations with colorblind-friendly options. You can also use these palettes in R using the [RColorBrewer](https://cran.r-project.org/web/packages/RColorBrewer/index.html) package, and the `scale_*_brewer()` (for discrete palettes) or `scale_*_distiller()` (for continuous palettes) functions in ggplot2.\n\n[**Color.review**](https://color.review/) Tool to pick or verify colour palettes with high relative contrast between colours, to ensure your information is readable for everyone.\n\n[**Coblis --- Color Blindness Simulator**](https://www.color-blindness.com/coblis-color-blindness-simulator/) Tool to upload an image and view it as they would appear to a colorblind person, with the option to simulate several color-vision deficiencies.\n\n[**500+ Named Colours with rgb and hex values**](http://cloford.com/resources/colours/500col.htm) List of named colours along with their hex values.\n\n[**CartoDB/CartoColor**](https://github.com/CartoDB/cartocolor) CARTOColors are a set of custom color palettes built on top of well-known standards for color use on maps, with next generation enhancements for the web and CARTO basemaps. Choose from a selection of sequential, diverging, or qualitative schemes for your next CARTO powered visualization using their [online module](https://carto.com/carto-colors/).\n\n------------------------------------------------------------------------\n\n#### Tools\n\n##### R\n\n[**The R Graph Gallery**](https://www.r-graph-gallery.com/index.html) A collection of charts made with the R programming language. Hundreds of charts are displayed in several sections, always with their reproducible code available. The gallery makes a focus on the tidyverse and ggplot2.\n\n###### Base R {.unnumbered}\n\n[**Cheatsheet: Margins in base R**](https://www.r-graph-gallery.com/74-margin-and-oma-cheatsheet) Edit your margins in base R to accommodate axis titles, legends, captions, etc.!\n\n[**Customizing tick marks in base R**](https://insileco.github.io/2020/08/29/custom-tick-marks-with-rs-base-graphics-system/) Seems like a simple thing, but it can be so frustrating! This is a great post about customizing tick marks with base plot in R.\n\n[**Animations in R (for time series)**](https://insileco.github.io/2017/07/05/animations-in-r-time-series-of-erythemal-irradiance-in-the-st.-lawrence/) If you want to use animations but don't want to use ggplot2, this demo might help you!\n\n###### ggplot2 {.unnumbered}\n\n[**Cheatsheet: ggplot2**](http://r-statistics.co/ggplot2-cheatsheet.html) Cheatsheet for ggplot2 in R - anything you want to do is probably covered here!\n\n[**Coding Club tutorial: Data Viz Part 1 - Beautiful and informative data visualization**](https://ourcodingclub.github.io/tutorials/datavis/) Great tutorial demonstrating how to customize titles, subtitles, captions, labels, colour palettes, and themes in ggplot2.\n\n[**Coding Club tutorial: Data Viz Part 2 - Customizing your figures**](https://ourcodingclub.github.io/tutorials/data-vis-2/) Great tutorial demonstrating how to customize titles, subtitles, captions, labels, colour palettes, and themes in ggplot2.\n\n[**ggplot flipbook**](https://evamaerey.github.io/ggplot_flipbook/ggplot_flipbook_xaringan.html#1) A flipbook-style demonstration that builds and customizes plots line by line using ggplot in R.\n\n[**gganimate: A Grammar of Animated Graphics**](https://github.com/thomasp85/gganimate) Package to create animated graphics in R (with ggplot2).\n\n##### Python\n\n[**The Python Graph Gallery**](https://python-graph-gallery.com/) This website displays hundreds of charts, always providing the reproducible python code.\n\n[**Python Tutorial: Intro to Matplotlib**](https://github.com/Randonnees-Datatrek/data-trek-2020/blob/master/Tutorials/Python_Tutorial/python_tutorial.ipynb) Introduction to basic functionalities of the Python's library Matplotlib covering basic plots, plot attributes, subplots and plotting the `iris` dataset.\n\n[**The Art of Effective Visualization of Multi-dimensional Data**](https://towardsdatascience.com/the-art-of-effective-visualization-of-multi-dimensional-data-6c7202990c57) Covers both univariate (one-dimension) and multivariate (multi-dimensional) data visualization strategies using the Python machine learning ecosystem.\n\n##### Julia\n\n[**Julia Plots Gallery**](https://goropikari.github.io/PlotsGallery.jl/) Display of various plots with reproducible code in Julia.\n\n[**Plots in Julia**](http://docs.juliaplots.org/latest/#Plots-powerful-convenience-for-visualization-in-Julia) Documentation for the Plots package in Julia, including demonstrations for animated plots, and links to tutorials.\n\n[**Animations in Julia**](http://docs.juliaplots.org/latest/animations/) How to start making animated plots in Julia.\n\n------------------------------------------------------------------------\n\n#### Customization\n\n[**Chart Studio**](https://plotly.com/chart-studio/) Web editor to create interactive plots with plotly. You can download the image as .html, or static images, without coding the figure yourself.\n\n[**PhyloPic**](http://phylopic.org/) Vector images of living organisms. This is great for ecologists who want to add silhouettes of their organisms onto their plots - search anything, and you will likely find it!\n\n[**Add icons on your R plot**](https://insileco.github.io/2017/05/23/add-icons-on-your-r-plot/) Add special icons to your plot as a great way to customize it, and save space with labels!\n\n------------------------------------------------------------------------\n\n#### Inspiration (pretty things!)\n\n[**Information is Beautiful**](https://informationisbeautiful.net/visualizations/) Collection of beautiful original visualizations about a variety of topics!\n\n[**TidyTuesday**](https://github.com/rfordatascience/tidytuesday) A weekly data project aimed at the R ecosystem, where people wrangle and visualize data in loads of creative ways. Browse what people have created ([#TidyTuesday](https://twitter.com/search?q=%23TidyTuesday) on Twitter is great too!), and the visualizations that have inspired each week's theme.\n\n[**Wind currents on Earth**](https://earth.nullschool.net/) Dynamic and interactive map of wind currents on Earth.\n\n[**A Day in the Life of Americans**](https://flowingdata.com/2015/12/15/a-day-in-the-life-of-americans/) Dynamic visualisation of how Americans spend their time in an average day.\n\n[**2019: The Year in Visual Stories and Graphics**](https://www.nytimes.com/interactive/2019/12/30/us/2019-year-in-graphics.html) Collection of the most popular visualizations by the New York Times in 2019.\n",
"supporting": [],
"filters": [
"rmarkdown/pagebreak.lua"
diff --git a/.quarto/_freeze/posts/2021-01-12-4-day-training-in-spatial-statistics-with-philippe-marchand/index/execute-results/html.json b/.quarto/_freeze/posts/2021-01-12-4-day-training-in-spatial-statistics-with-philippe-marchand/index/execute-results/html.json
index 6986b5b..9aebb99 100644
--- a/.quarto/_freeze/posts/2021-01-12-4-day-training-in-spatial-statistics-with-philippe-marchand/index/execute-results/html.json
+++ b/.quarto/_freeze/posts/2021-01-12-4-day-training-in-spatial-statistics-with-philippe-marchand/index/execute-results/html.json
@@ -1,7 +1,7 @@
{
- "hash": "19dde62c3bfc1dca0ccb3bd9ef87397b",
+ "hash": "79e046f2b374d59cdb91e5bdc7ad320a",
"result": {
- "markdown": "---\ntitle: \"Spatial Statistics in Ecology\"\ndescription: |\n Training session about statistical analysis of spatial data in ecology, hosted by Philippe Marchand (UQAT). | \n Session de formation sur l’analyse statistique des données spatiales en écologie, animée par Pr. Philippe Marchand (UQAT).\nauthor: \n - name: \"Philippe Marchand\"\n affiliation: Université du Québec en Abitibi-Témiscamingue\ncategories: [FR, EN, Technical]\ndate: \"2021-01-12\"\nimage: image.jpg\ntoc: true\nnumber-sections: true\nnumber-depth: 1\nexecute:\n freeze: true\n cache: true\n---\n\n\nVersion en français [à la suite](#statistiques-spatiales-en-écologie).\n\n# Spatial Statistics in Ecology\n\nBIOS² hosted an online training session about statistical analysis of spatial data in ecology, led by Pr. Philippe Marchand (UQAT). This 12-hour training was conducted in 4 sessions: January 12, 14, 19 & 21 (2021) from 1:00 to 4:00 pm EST.\n\nThe content included three types of spatial statistical analyses and their applications to ecology: (1) point pattern analysis to study the distribution of individuals or events in space; (2) geostatistical models to represent the spatial correlation of variables sampled at geolocated points; and (3) areal data models, which apply to measurements taken on areas in space and model spatial relationships as networks of neighbouring regions. The training also included practical exercises using the R statistical programming environment.\n\n[Philippe Marchand](https://github.com/pmarchand1) is a professor in ecology and biostatistics at Institut de recherche sur les forêts, Université du Québec en Abitibi-Témiscamingue (UQAT) and BIOS² academic member. His research focuses on modeling processes that influence the spatial distribution of populations, including: seed dispersal and seedling establishment, animal movement, and the spread of forest diseases.\n\n**If you wish to consult the lesson materials and follow the exercises at your own pace, you can access them through [this link](https://bios2.github.io/Marchand.html#category:EN). Basic knowledge of linear regression models and experience fitting them in R is recommended. Original repository can be found [here](https://github.com/pmarchand1/BIOS2-spatial-stats).**\n\n## Course outline\n\n| Day | Topics (EN) |\n|-----------------|:--------------------------|\n| 1 | • [Introduction to spatial statistics](#introduction) • [Point pattern analysis](#point-pattern) |\n| 2 | • [Spatial correlation](#spatial-correlation) • [Geostatistical models](#geostat-models) |\n| 3 | • [Areal data](#areal-data) • [Moran's I](#moran-i) • [Spatial autoregression models](#spatial-autoreg) • [Analysis of areal data in R](#analysis-areal) |\n| 4 | • [GLMM with spatial Gaussian process](#glmm-spatial-gaussian) • [GLMM with spatial autoregression](#glmm-spatial-autoreg) |\n\n\n# Introduction to spatial statistics {#introduction}\n\n## Types of spatial analyses\n\nIn this training, we will discuss three types of spatial analyses: point pattern analysis, geostatistical models and models for areal data.\n\nIn **point pattern analysis**, we have point data representing the position of individuals or events in a study area and we assume that all individuals or events have been identified in that area. That analysis focuses on the distribution of the positions of the points themselves. Here are some typical questions for the analysis of point patterns:\n\n- Are the points randomly arranged or clustered?\n\n- Are two types of points arranged independently?\n\n**Geostatistical models** represent the spatial distribution of continuous variables that are measured at certain sampling points. They assume that measurements of those variables at different points are correlated as a function of the distance between the points. Applications of geostatistical models include the smoothing of spatial data (e.g., producing a map of a variable over an entire region based on point measurements) and the prediction of those variables for non-sampled points.\n\n**Areal data** are measurements taken not at points, but for regions of space represented by polygons (e.g. administrative divisions, grid cells). Models representing these types of data define a network linking each region to its neighbours and include correlations in the variable of interest between neighbouring regions.\n\n## Stationarity and isotropy\n\nSeveral spatial analyses assume that the variables are **stationary** in space. As with stationarity in the time domain, this property means that summary statistics (mean, variance and correlations between measures of a variable) do not vary with translation in space. For example, the spatial correlation between two points may depend on the distance between them, but not on their absolute position.\n\nIn particular, there cannot be a large-scale trend (often called *gradient* in a spatial context), or this trend must be taken into account before modelling the spatial correlation of residuals.\n\nIn the case of point pattern analysis, stationarity (also called homogeneity) means that point density does not follow a large-scale trend.\n\nIn a **isotropic** statistical model, the spatial correlations between measurements at two points depend only on the distance between the points, not on the direction. In this case, the summary statistics do not change under a spatial rotation of the data.\n\n## Georeferenced data\n\nEnvironmental studies increasingly use data from geospatial data sources, i.e. variables measured over a large part of the globe (e.g. climate, remote sensing). The processing of these data requires concepts related to Geographic Information Systems (GIS), which are not covered in this workshop, where we focus on the statistical aspects of spatially varying data.\n\nThe use of geospatial data does not necessarily mean that spatial statistics are required. For example, we will often extract values of geographic variables at study points to explain a biological response observed in the field. In this case, the use of spatial statistics is only necessary when there is a spatial correlation in the residuals, after controlling for the effect of the predictors.\n\n# Point pattern analysis {#point-pattern}\n\n## Point pattern and point process\n\nA *point pattern* describes the spatial position (most often in 2D) of individuals or events, represented by points, in a given study area, often called the observation \"window\".\n\nIt is assumed that each point has a negligible spatial extent relative to the distances between the points. More complex methods exist to deal with spatial patterns of objects that have a non-negligible width, but this topic is beyond the scope of this workshop.\n\nA *point process* is a statistical model that can be used to simulate point patterns or explain an observed point pattern.\n\n## Complete spatial randomness\n\nComplete spatial randomness (CSR) is one of the simplest point patterns, which serves as a null model for evaluating the characteristics of real point patterns. In this pattern, the presence of a point at a given position is independent of the presence of points in a neighbourhood.\n\nThe process creating this pattern is a homogeneous Poisson process. According to this model, the number of points in any area $A$ follows a Poisson distribution: $N(A) \\sim \\text{Pois}(\\lambda A)$, where $\\lambda$ is the *intensity* of the process (i.e. the density of points per unit area). $N$ is independent between two disjoint regions, no matter how those regions are defined.\n\nIn the graph below, only the pattern on the right is completely random. The pattern on the left shows point aggregation (higher probability of observing a point close to another point), while the pattern in the center shows repulsion (low probability of observing a point very close to another).\n\n\n\n\n::: {.cell fig.dim='[9,3]' hash='index_cache/html/unnamed-chunk-2_c019229dfeb24b4b22a136e6b038583d'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\n## Exploratory or inferential analysis for a point pattern\n\nSeveral summary statistics are used to describe the characteristics of a point pattern. The simplest is the intensity $\\lambda$, which as mentioned above represents the density of points per unit area. If the point pattern is heterogeneous, the intensity is not constant, but depends on the position: $\\lambda(x, y)$.\n\nCompared to intensity, which is a first-order statistic, second-order statistics describe how the probability of the presence of a point in a region depends on the presence of other points. The Ripley's $K$ function presented in the next section is an example of a second-order summary statistic.\n\nStatistical inferences on point patterns usually consist of testing the hypothesis that the point pattern corresponds to a given null model, such as CSR or a more complex null model. Even for the simplest null models, we rarely know the theoretical distribution for a summary statistic of the point pattern under the null model. Hypothesis tests on point patterns are therefore performed by simulation: a large number of point patterns are simulated from the null model and the distribution of the summary statistics of interest for these simulations is compared to their values for the observed point pattern.\n\n## Ripley's K function\n\nRipley's K function $K(r)$ is defined as the mean number of points within a circle of radius $r$ around a point in the pattern, standardized by the intensity $\\lambda$.\n\nUnder the CSR null model, the mean number of points in any circle of radius $r$ is $\\lambda \\pi r^2$, thus in theory $K(r) = \\pi r^2$ for that model. A higher value of $K(r)$ means that there is an aggregation of points at the scale $r$, whereas a lower value means that there is repulsion.\n\nIn practice, $K(r)$ is estimated for a specific point pattern by the equation:\n\n$$ K(r) = \\frac{A}{n(n-1)} \\sum_i \\sum_{j > i} I \\left( d_{ij} \\le r \\right) w_{ij}$$\n\nwhere $A$ is the area of the observation window and $n$ is the number of points in the pattern, so $n(n-1)$ is the number of distinct pairs of points. We take the sum for all pairs of points of the indicator function $I$, which takes a value of 1 if the distance between points $i$ and $j$ is less than or equal to $r$. Finally, the term $w_{ij}$ is used to give extra weight to certain pairs of points to account for edge effects, as discussed in the next section.\n\nFor example, the graphs below show the estimated $K(r)$ function for the patterns shown above, for values of $r$ up to 1/4 of the window width. The red dashed curve shows the theoretical value for CSR and the gray area is an \"envelope\" produced by 99 simulations of that null pattern. The aggregated pattern shows an excess of neighbours up to $r = 0.25$ and the pattern with repulsion shows a significant deficit of neighbours for small values of $r$.\n\n\n\n\n::: {.cell fig.dim='[9,3]' hash='index_cache/html/unnamed-chunk-4_93b9963febba16ed4365408bd10b6c70'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\nIn addition to $K$, there are other statistics to describe the second-order properties of point patterns, such as the mean distance between a point and its nearest $N$ neighbours. You can refer to the Wiegand and Moloney (2013) textbook in the references to learn more about different summary statistics for point patterns.\n\n## Edge effects\n\nIn the context of point pattern analysis, edge effects are due to the fact that we have incomplete knowledge of the neighbourhood of points near the edge of the observation window, which can induce a bias in the calculation of statistics such as Ripley's $K$.\n\nDifferent methods have been developed to correct the bias due to edge effects. In Ripley's edge correction method, the contribution of a neighbour $j$ located at a distance $r$ from a point $i$ receives a weight $w_{ij} = 1/\\phi_i(r)$, where $\\phi_i(r)$ is the fraction of the circle of radius $r$ around $i$ contained in the observation window. For example, if 2/3 of the circle is in the window, this neighbour counts as 3/2 neighbours in the calculation of a statistic like $K$.\n\n\n\nRipley's method is one of the simplest to correct for edge effects, but is not necessarily the most efficient; in particular, larger weights given to certain pairs of points tend to increase the variance of the calculated statistic. Other correction methods are presented in specialized textbooks, such as Wiegand and Moloney (2013).\n\n## Example\n\nFor this example, we use the dataset [semis_xy.csv](data/semis_xy.csv), which represents the $(x, y)$ coordinates for seedlings of two species (*sp*, B = birch and P = poplar) in a 15 x 15 m plot.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-5_0f8146040b7a6a70fa3c497cc0385db2'}\n\n```{.r .cell-code}\nsemis <- read.csv(\"data/semis_xy.csv\")\nhead(semis)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n x y sp\n1 14.73 0.05 P\n2 14.72 1.71 P\n3 14.31 2.06 P\n4 14.16 2.64 P\n5 14.12 4.15 B\n6 9.88 4.08 B\n```\n:::\n:::\n\n\nThe *spatstat* package provides tools for point pattern analysis in R. The first step consists in transforming our data frame into a `ppp` object (point pattern) with the function of the same name. In this function, we specify which columns contain the coordinates *x* and *y* as well as the *marks*, which here will be the species codes. We also need to specify an observation window (`window`) using the `owin` function, where we provide the plot limits in *x* and *y*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-6_57149b36e4a5be5442a99b8f45b2dbdd'}\n\n```{.r .cell-code}\nlibrary(spatstat)\n\nsemis <- ppp(x = semis$x, y = semis$y, marks = as.factor(semis$sp),\n window = owin(xrange = c(0, 15), yrange = c(0, 15)))\nsemis\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nMarked planar point pattern: 281 points\nMultitype, with levels = B, P \nwindow: rectangle = [0, 15] x [0, 15] units\n```\n:::\n:::\n\n\nMarks can be numeric or categorical. Note that for categorical marks as is the case here, the variable must be explicitly converted to a factor.\n\nThe `plot` function applied to a point pattern shows a diagram of the pattern.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-7_ba656f4aa5befb58b9e9845ae787d99d'}\n\n```{.r .cell-code}\nplot(semis)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe `intensity` function calculates the density of points of each species by unit area (here, by $m^2$).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-8_0b22d4b3b39bd4dc862f8c161efb9330'}\n\n```{.r .cell-code}\nintensity(semis)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n B P \n0.6666667 0.5822222 \n```\n:::\n:::\n\n\nTo first analyze the distribution of each species separately, we split the pattern with `split`. Since the pattern contains categorical marks, it is automatically split according to the values of those marks. The result is a list of two point patterns.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-9_5ff3f6384afcf7ed706bbf891accd2fa'}\n\n```{.r .cell-code}\nsemis_split <- split(semis)\nplot(semis_split)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe `Kest` function calculates Ripley's $K$ for a series of distances up to (by default) 1/4 of the width of the window. Here we apply it to the first pattern (birch) by choosing `semis_split[[1]]`. Note that double square brackets are necessary to choose an item from a list in R.\n\nThe argument `correction = \"iso\"` tells the function to apply Ripley's correction for edge effects.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-10_67e4bd9ed190d1af69a48250adb1bc3d'}\n\n```{.r .cell-code}\nk <- Kest(semis_split[[1]], correction = \"iso\")\nplot(k)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nAccording to this graph, there seems to be an excess of neighbours for distances of 1 m and above. To check if this is a significant difference, we produce a simulation envelope with the `envelope` function. The first argument of `envelope` is a point pattern to which the simulations will be compared, the second one is a function to be computed (here, `Kest`) for each simulated pattern, then we add the arguments of the `Kest` function (here, only `correction`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-11_ebe814599d9537b0a51121b965182658'}\n\n```{.r .cell-code}\nplot(envelope(semis_split[[1]], Kest, correction = \"iso\"))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 99 simulations of CSR ...\n1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,\n41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,\n81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nAs indicated by the message, by default the function performs 99 simulations of the null model corresponding to complete spatial randomness (CSR).\n\nThe observed curve falls outside the envelope of the 99 simulations near $r = 2$. We must be careful not to interpret too quickly a result that is outside the envelope. Although there is about a 1% probability of obtaining a more extreme result under the null hypothesis at a given distance, the envelope is calculated for a large number of values of $r$ and is not corrected for multiple comparisons. Thus, a significant difference for a very small range of values of $r$ may be simply due to chance.\n\n### Exercise 1\n\nLooking at the graph of the second point pattern (poplar seedlings), can you predict where Ripley's $K$ will be in relation to the null hypothesis of complete spatial randomness? Verify your prediction by calculating Ripley's $K$ for this point pattern in R.\n\n## Effect of heterogeneity\n\nThe graph below illustrates a *heterogeneous* point pattern, i.e. it shows an density gradient (more points on the left than on the right).\n\n\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-13_36849871c75ced31ddf5bd09edb7ace9'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nA density gradient can be confused with an aggregation of points, as can be seen on the graph of the corresponding Ripley's $K$. In theory, these are two different processes:\n\n- Heterogeneity: The density of points varies in the study area, for example due to the fact that certain local conditions are more favorable to the presence of the species of interest.\n\n- Aggregation: The mean density of points is homogeneous, but the presence of one point increases the presence of other points in its vicinity, for example due to positive interactions between individuals.\n\nHowever, it may be difficult to differentiate between the two in practice, especially since some patterns may be both heterogeneous and aggregated.\n\nLet's take the example of the poplar seedlings from the previous exercise. The `density` function applied to a point pattern performs a kernel density estimation of the density of the seedlings across the plot. By default, this function uses a Gaussian kernel with a standard deviation `sigma` specified in the function, which determines the scale at which density fluctuations are \"smoothed\". Here, we use a value of 2 m for `sigma` and we first represent the estimated density with `plot`, before overlaying the points (`add = TRUE` means that the points are added to the existing plot rather than creating a new plot).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-14_3332987af85b2014bbebfa360ce15a9b'}\n\n```{.r .cell-code}\ndens_p <- density(semis_split[[2]], sigma = 2)\nplot(dens_p)\nplot(semis_split[[2]], add = TRUE)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nTo measure the aggregation or repulsion of points in a heterogeneous pattern, we must use the inhomogeneous version of the $K$ statistic (`Kinhom` in *spatstat*). This statistic is still equal to the mean number of neighbours within a radius $r$ of a point in the pattern, but rather than standardizing this number by the overall intensity of the pattern, it is standardized by the local estimated density. As above, we specify `sigma = 2` to control the level of smoothing for the varying density estimate.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-15_f82857163481aaf3f03a5dd201df8615'}\n\n```{.r .cell-code}\nplot(Kinhom(semis_split[[2]], sigma = 2, correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nTaking into account the heterogeneity of the pattern at a scale `sigma` of 2 m, there seems to be a deficit of neighbours starting at a radius of about 1.5 m. We can now check whether this deviation is significant.\n\nAs before, we use `envelope` to simulate the `Kinhom` statistic under the null model. However, the null model here is not a homogeneous Poisson process (CSR). It is instead a heterogeneous Poisson process simulated by the function `rpoispp(dens_p)`, i.e. the points are independent of each other, but their density is heterogeneous and given by `dens_p`. The `simulate` argument of the `envelope` function specifies the function used for simulations under the null model; this function must have one argument, here `x`, even if it is not used.\n\nFinally, in addition to the arguments needed for `Kinhom`, i.e. `sigma` and `correction`, we also specify `nsim = 199` to perform 199 simulations and `nrank = 5` to eliminate the 5 most extreme results on each side of the envelope, i.e. the 10 most extreme results out of 199, to achieve an interval containing about 95% of the probability under the null hypothesis.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-16_7119c82106369cf2aa8fe32fff918b5e'}\n\n```{.r .cell-code}\nkhet_p <- envelope(semis_split[[2]], Kinhom, sigma = 2, correction = \"iso\",\n nsim = 199, nrank = 5, simulate = function(x) rpoispp(dens_p))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(khet_p)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n*Note*: For a hypothesis test based on simulations of a null hypothesis, the $p$-value is estimated by $(m + 1)/(n + 1)$, where $n$ is the number of simulations and $m$ is the number of simulations where the value of the statistic is more extreme than that of the observed data. This is why the number of simulations is often chosen to be 99, 199, etc.\n\n### Exercise 2\n\nRepeat the heterogeneous density estimation and `Kinhom` calculation with a standard deviation `sigma` of 5 rather than 2. How does the smoothing level for the density estimation influence the conclusions?\n\nTo differentiate between a variation in the density of points from an interaction (aggregation or repulsion) between these points with this type of analysis, it is generally assumed that the two processes operate at different scales. Typically, we can test whether the points are aggregated at a small scale after accounting for a variation in density at a larger scale.\n\n## Relationship between two point patterns\n\nLet's consider a case where we have two point patterns, for example the position of trees of two species in a plot (orange and green points in the graph below). Each of the two patterns may or may not present an aggregation of points.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-17_b4289a87928bcb641b5e8e2bd2b6abf1'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nRegardless of whether points are aggregated at the species level, we want to determine whether the two species are arranged independently. In other words, does the probability of observing a tree of one species depend on the presence of a tree of the other species at a given distance?\n\nThe bivariate version of Ripley's $K$ allows us to answer this question. For two patterns noted 1 and 2, the function $K_{12}(r)$ calculates the mean number of points in pattern 2 within a radius $r$ from a point in pattern 1, standardized by the density of pattern 2.\n\nIn theory, this function is symmetrical, so $K_{12}(r) = K_{21}(r)$ and the result would be the same whether the points of pattern 1 or 2 are chosen as \"focal\" points for the analysis. However, the estimation of the two quantities for an observed pattern may differ, in particular because of edge effects. The variance of $K_{12}$ and $K_{21}$ between simulations of a null model may also differ, so the null hypothesis test may have more or less power depending on the choice of the focal species.\n\nThe choice of an appropriate null model is important here. In order to determine whether there is a significant attraction or repulsion between the two patterns, the position of one of the patterns must be randomly moved relative to that of the other pattern, while keeping the spatial structure of each pattern taken in isolation.\n\nOne way to do this randomization is to shift one of the two patterns horizontally and/or vertically by a random distance. The part of the pattern that \"comes out\" on one side of the window is attached to the other side. This method is called a toroidal shift, because by connecting the top and bottom as well as the left and right of a rectangular surface, we obtain the shape of a torus (a three-dimensional \"donut\").\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-18_2719c0934b27fb43697dae326b9542d1'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe graph above shows a translation of the green pattern to the right, while the orange pattern remains in the same place. The green points in the shaded area are brought back on the other side. Note that while this method generally preserves the structure of each pattern while randomizing their relative position, it can have some drawbacks, such as dividing point clusters that are near the cutoff point.\n\nLet's now check whether the position of the two species (birch and poplar) is independent in our plot. The function `Kcross` calculates the bivariate $K_{ij}$, we must specify which type of point (mark) is considered as the focal species $i$ and the neighbouring species $j$.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-19_4dcee95d46a21e9800bad80559da1926'}\n\n```{.r .cell-code}\nplot(Kcross(semis, i = \"P\", j = \"B\", correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nHere, the observed $K$ is lower than the theoretical value, indicating a possible repulsion between the two patterns.\n\nTo determine the envelope of the $K$ under the null hypothesis of independence of the two patterns, we must specify that the simulations are based on a translation of the patterns. We indicate that the simulations use the function `rshift` (random translation) with the argument `simulate = function(x) rshift(x, which = \"B\")`; here, the `x` argument in `simulate` corresponds to the original point pattern and the `which` argument indicates which of the patterns is translated. As in the previous case, the arguments needed for `Kcross`, i.e. `i`, `j` and `correction`, must be repeated in the `envelope` function.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-20_0ac003a9d3ff5047aa7ab53d990626d2'}\n\n```{.r .cell-code}\nplot(envelope(semis, Kcross, i = \"P\", j = \"B\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = function(x) rshift(x, which = \"B\")))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nHere, the observed curve is totally within the envelope, so we do not reject the null hypothesis of independence of the two patterns.\n\n### Questions\n\n1. What would be one reason for our choice to translate the points of the birch rather than poplar?\n\n2. Would the simulations generated by random translation be a good null model if the two patterns were heterogeneous?\n\n## Marked point patterns\n\nThe [fir.csv](data/fir.csv) dataset contains the $(x, y)$ coordinates of 822 fir trees in a 1 hectare plot and their status (A = alive, D = dead) following a spruce budworm outbreak.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-21_facfc5f20aa18027ead60eade7d1f3e8'}\n\n```{.r .cell-code}\nfir <- read.csv(\"data/fir.csv\")\nhead(fir)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n x y status\n1 31.50 1.00 A\n2 85.25 30.75 D\n3 83.50 38.50 A\n4 84.00 37.75 A\n5 83.00 33.25 A\n6 33.25 0.25 A\n```\n:::\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-22_8ca66569ad633346ebe5c4d72856947e'}\n\n```{.r .cell-code}\nfir <- ppp(x = fir$x, y = fir$y, marks = as.factor(fir$status),\n window = owin(xrange = c(0, 100), yrange = c(0, 100)))\nplot(fir)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nSuppose that we want to check whether fir mortality is independent or correlated between neighbouring trees. How does this question differ from the previous example, where we wanted to know if the position of the points of two species was independent?\n\nIn the previous example, the independence or interaction between the species referred to the formation of the pattern itself (whether or not seedlings of one species establish near those of the other species). Here, the characteristic of interest (survival) occurs after the establishment of the pattern, assuming that all those trees were alive at first and that some died as a result of the outbreak. So we take the position of the trees as fixed and we want to know whether the distribution of status (dead, alive) among those trees is random or shows a spatial pattern.\n\nIn Wiegand and Moloney's textbook, the first situation (establishment of seedlings of two species) is called a bivariate pattern, so it is really two interacting patterns, while the second is a single pattern with a qualitative *mark*. The *spatstat* package in R does not differentiate between the two in terms of pattern definition (types of points are always represented by the `marks` argument), but the analysis methods applied to the two questions differ.\n\nIn the case of a pattern with a qualitative mark, we can define a *mark connection function* $p_{ij}(r)$. For two points separated by a distance $r$, this function gives the probability that the first point has the mark $i$ and the second the mark $j$. Under the null hypothesis where the marks are independent, this probability is equal to the product of the proportions of each mark in the entire pattern, $p_{ij}(r) = p_i p_j$ independently of $r$.\n\nIn *spatstat*, the mark connection function is computed with the `markconnect` function, where the marks $i$ and $j$ and the type of edge correction must be specified. In our example, we see that two closely spaced points are less likely to have a different status (A and D) than expected under the assumption of random and independent distribution of marks (red dotted line).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-23_ea3bee43b75cb2228264e2bba732134d'}\n\n```{.r .cell-code}\nplot(markconnect(fir, i = \"A\", j = \"D\", correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIn this graph, the fluctuations in the function are due to the estimation error of a continuous $r$ function from a limited number of discrete point pairs.\n\nTo simulate the null model in this case, we use the `rlabel` function, which randomly reassigns the marks among the points of the pattern, keeping the points' positions fixed.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-24_b5961fa24a7b5816b3a04f809a6a674c'}\n\n```{.r .cell-code}\nplot(envelope(fir, markconnect, i = \"A\", j = \"D\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNote that since the `rlabel` function has only one required argument corresponding to the original point pattern, it was not necessary to specify: `simulate = function(x) rlabel(x)`.\n\nHere are the results for tree pairs of the same status A or D:\n\n\n::: {.cell fig.dim='[10,5]' hash='index_cache/html/unnamed-chunk-25_b52d50f419fba628767a4e51fec12988'}\n\n```{.r .cell-code}\npar(mfrow = c(1, 2))\nplot(envelope(fir, markconnect, i = \"A\", j = \"A\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(envelope(fir, markconnect, i = \"D\", j = \"D\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=960}\n:::\n:::\n\n\nIt therefore appears that fir mortality due to this outbreak is spatially aggregated, since trees located in close proximity to each other have a greater probability of sharing the same status than predicted by the null hypothesis.\n\n## References\n\nFortin, M.-J. and Dale, M.R.T. (2005) *Spatial Analysis: A Guide for Ecologists*. Cambridge University Press: Cambridge, UK.\n\nWiegand, T. and Moloney, K.A. (2013) *Handbook of Spatial Point-Pattern Analysis in Ecology*, CRC Press.\n\nThe dataset in the last example is a subet of the Lake Duparquet Research and Teaching Forest (LDRTF) data, available on Dryad [here](https://doi.org/10.5061/dryad.tqjq2bvwz).\n\n# Solutions\n\n### Exercise 1\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-26_b3fd18c8b6c242843edf3836d1967112'}\n\n```{.r .cell-code}\nplot(envelope(semis_split[[2]], Kest, correction = \"iso\"))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 99 simulations of CSR ...\n1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,\n41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,\n81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nPoplar seedlings seem to be significantly aggregated according to the $K$ function.\n\n### Exercise 2\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-27_acce28ca3e937720b0224ba60b6c233b'}\n\n```{.r .cell-code}\ndens_p <- density(semis_split[[2]], sigma = 5)\nplot(dens_p)\nplot(semis_split[[2]], add = TRUE)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nkhet_p <- envelope(semis_split[[2]], Kinhom, sigma = 5, correction = \"iso\",\n nsim = 199, nrank = 5, simulate = function(x) rpoispp(dens_p))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(khet_p)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nHere, as we estimate density variations at a larger scale, even after accounting for this variation, the poplar seedlings seem to be aggregated at a small scale.\n\n# Spatial correlation of a variable {#spatial-correlation}\n\n\n\n\n\nCorrelation between measurements of a variable taken at nearby points often occurs in environmental data. This principle is sometimes referred to as the \"first law of geography\" and is expressed in the following quote from Waldo Tobler: \"Everything is related to everything else, but near things are more related than distant things\".\n\nIn statistics, we often refer to *autocorrelation* as the correlation between measurements of the same variable taken at different times (temporal autocorrelation) or places (spatial autocorrelation).\n\n## Intrinsic or induced dependence\n\nThere are two basic types of spatial dependence on a measured variable $y$: an *intrinsic* dependence on $y$, or a dependence *induced* by external variables influencing $y$, which are themselves spatially correlated.\n\nFor example, suppose that the abundance of a species is correlated between two sites located near each other:\n\n- this spatial dependence can be induced if it is due to a spatial correlation of habitat factors that are favorable or unfavorable to the species;\n\n- or it can be intrinsic if it is due to the dispersion of individuals to nearby sites.\n\nIn many cases, both types of dependence affect a given variable.\n\nIf the dependence is simply induced and the external variables that cause it are included in the model explaining $y$, then the model residuals will be independent and we can use all the methods already seen that ignore spatial correlation.\n\nHowever, if the dependence is intrinsic or due to unmeasured external factors, then the spatial correlation of the residuals in the model will have to be taken into account.\n\n## Different ways to model spatial effects\n\nIn this training, we will directly model the spatial correlations of our data. It is useful to compare this approach to other ways of including spatial aspects in a statistical model.\n\nFirst, we could include predictors in the model that represent position (e.g., longitude, latitude). Such predictors may be useful for detecting a systematic large-scale trend or gradient, whether or not the trend is linear (e.g., with a generalized additive model).\n\nIn contrast to this approach, the models we will see now serve to model a spatial correlation in the random fluctuations of a variable (i.e., in the residuals after removing any systematic effect).\n\nMixed models use random effects to represent the non-independence of data on the basis of their grouping, i.e., after accounting for systematic fixed effects, data from the same group are more similar (their residual variation is correlated) than data from different groups. These groups were sometimes defined according to spatial criteria (observations grouped into sites).\n\nHowever, in the context of a random group effect, all groups are as different from each other, e.g., two sites within 100 km of each other are no more or less similar than two sites 2 km apart.\n\nThe methods we will see here and in the next parts of the training therefore allow us to model non-independence on a continuous scale (closer = more correlated) rather than just discrete (hierarchy of groups).\n\n# Geostatistical models {#geostat-models}\n\nGeostatistics refers to a group of techniques that originated in the earth sciences. Geostatistics is concerned with variables that are continuously distributed in space and where a number of points are sampled to estimate this distribution. A classic example of these techniques comes from the mining field, where the aim was to create a map of the concentration of ore at a site from samples taken at different points on the site.\n\nFor these models, we will assume that $z(x, y)$ is a stationary spatial variable measured at points with coordinates $x$ and $y$.\n\n## Variogram\n\nA central aspect of geostatistics is the estimation of the variogram $\\gamma_z$ . The variogram is equal to half the mean square difference between the values of $z$ for two points $(x_i, y_i)$ and $(x_j, y_j)$ separated by a distance $h$.\n\n$$\\gamma_z(h) = \\frac{1}{2} \\text{E} \\left[ \\left( z(x_i, y_i) - z(x_j, y_j) \\right)^2 \\right]_{d_{ij} = h}$$\n\nIn this equation, the $\\text{E}$ function with the index $d_{ij}=h$ designates the statistical expectation (i.e., the mean) of the squared deviation between the values of $z$ for points separated by a distance $h$.\n\nIf we want instead to express the autocorrelation $\\rho_z(h)$ between measures of $z$ separated by a distance $h$, it is related to the variogram by the equation:\n\n$$\\gamma_z = \\sigma_z^2(1 - \\rho_z)$$ ,\n\nwhere $\\sigma_z^2$ is the global variance of $z$.\n\nNote that $\\gamma_z = \\sigma_z^2$ when we reach a distance where the measurements of $z$ are independent, so $\\rho_z = 0$. In this case, we can see that $\\gamma_z$ is similar to a variance, although it is sometimes called \"semivariogram\" or \"semivariance\" because of the 1/2 factor in the above equation.\n\n## Theoretical models for the variogram\n\nSeveral parametric models have been proposed to represent the spatial correlation as a function of the distance between sampling points. Let us first consider a correlation that decreases exponentially:\n\n$$\\rho_z(h) = e^{-h/r}$$\n\nHere, $\\rho_z = 1$ for $h = 0$ and the correlation is multiplied by $1/e \\approx 0.37$ each time the distance increases by $r$. In this context, $r$ is called the *range* of the correlation.\n\nFrom the above equation, we can calculate the corresponding variogram.\n\n$$\\gamma_z(h) = \\sigma_z^2 (1 - e^{-h/r})$$\n\nHere is a graphical representation of this variogram.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-28_db8b05730133a816cb7d6c558cbd7757'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nBecause of the exponential function, the value of $\\gamma$ at large distances approaches the global variance $\\sigma_z^2$ without exactly reaching it. This asymptote is called a *sill* in the geostatistical context and is represented by the symbol $s$.\n\nFinally, it is sometimes unrealistic to assume a perfect correlation when the distance tends towards 0, because of a possible variation of $z$ at a very small scale. A *nugget* effect, denoted $n$, can be added to the model so that $\\gamma$ approaches $n$ (rather than 0) if $h$ tends towards 0. The term nugget comes from the mining origin of these techniques, where a nugget could be the source of a sudden small-scale variation in the concentration of a mineral.\n\nBy adding the nugget effect, the remainder of the variogram is \"compressed\" to keep the same sill, resulting in the following equation.\n\n$$\\gamma_z(h) = n + (s - n) (1 - e^{-h/r})$$\n\nIn the *gstat* package that we use below, the term $(s-n)$ is called a *partial sill* or `psill` for the exponential portion of the variogram.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-29_76ce196068f7afb370f9fcd84ff0bf2d'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIn addition to the exponential model, two other common theoretical models for the variogram are the Gaussian model (where the correlation follows a half-normal curve), and the spherical model (where the variogram increases linearly at the start and then curves and reaches the plateau at a distance equal to its range $r$). The spherical model thus allows the correlation to be exactly 0 at large distances, rather than gradually approaching zero in the case of the other models.\n\n| Model | $\\rho(h)$ | $\\gamma(h)$ |\n|------------------|-------------------------|-----------------------------|\n| Exponential | $\\exp\\left(-\\frac{h}{r}\\right)$ | $s \\left(1 - \\exp\\left(-\\frac{h}{r}\\right)\\right)$ |\n| Gaussian | $\\exp\\left(-\\frac{h^2}{r^2}\\right)$ | $s \\left(1 - \\exp\\left(-\\frac{h^2}{r^2}\\right)\\right)$ |\n| Spherical $(h < r)$ \\* | $1 - \\frac{3}{2}\\frac{h}{r} + \\frac{1}{2}\\frac{h^3}{r^3}$ | $s \\left(\\frac{3}{2}\\frac{h}{r} - \\frac{1}{2}\\frac{h^3}{r^3} \\right)$ |\n\n\\* For the spherical model, $\\rho = 0$ and $\\gamma = s$ if $h \\ge r$.\n\n\n::: {.cell fig.dim='[9,4]' hash='index_cache/html/unnamed-chunk-30_36d08077ec0b54caf8dbcbb8751648be'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\n## Empirical variogram\n\nTo estimate $\\gamma_z(h)$ from empirical data, we need to define distance classes, thus grouping different distances within a margin of $\\pm \\delta$ around a distance $h$, then calculating the mean square deviation for the pairs of points in that distance class.\n\n$$\\hat{\\gamma_z}(h) = \\frac{1}{2 N_{\\text{paires}}} \\sum \\left[ \\left( z(x_i, y_i) - z(x_j, y_j) \\right)^2 \\right]_{d_{ij} = h \\pm \\delta}$$\n\nWe will see in the next section how to estimate a variogram in R.\n\n## Regression model with spatial correlation\n\nThe following equation represents a multiple linear regression including residual spatial correlation:\n\n$$v = \\beta_0 + \\sum_i \\beta_i u_i + z + \\epsilon$$\n\nHere, $v$ designates the response variable and $u$ the predictors, to avoid confusion with the spatial coordinates $x$ and $y$.\n\nIn addition to the residual $\\epsilon$ that is independent between observations, the model includes a term $z$ that represents the spatially correlated portion of the residual variance.\n\nHere are suggested steps to apply this type of model:\n\n1. Fit the regression model without spatial correlation.\n\n2. Verify the presence of spatial correlation from the empirical variogram of the residuals.\n\n3. Fit one or more regression models with spatial correlation and select the one that shows the best fit to the data.\n\n# Geostatistical models in R\n\nThe *gstat* package contains functions related to geostatistics. For this example, we will use the `oxford` dataset from this package, which contains measurements of physical and chemical properties for 126 soil samples from a site, along with their coordinates `XCOORD` and `YCOORD`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-31_d42a00ecb66d27e6d127659ed2dfd66c'}\n\n```{.r .cell-code}\nlibrary(gstat)\n\ndata(oxford)\nstr(oxford)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n'data.frame':\t126 obs. of 22 variables:\n $ PROFILE : num 1 2 3 4 5 6 7 8 9 10 ...\n $ XCOORD : num 100 100 100 100 100 100 100 100 100 100 ...\n $ YCOORD : num 2100 2000 1900 1800 1700 1600 1500 1400 1300 1200 ...\n $ ELEV : num 598 597 610 615 610 595 580 590 598 588 ...\n $ PROFCLASS: Factor w/ 3 levels \"Cr\",\"Ct\",\"Ia\": 2 2 2 3 3 2 3 2 3 3 ...\n $ MAPCLASS : Factor w/ 3 levels \"Cr\",\"Ct\",\"Ia\": 2 3 3 3 3 2 2 3 3 3 ...\n $ VAL1 : num 3 3 4 4 3 3 4 4 4 3 ...\n $ CHR1 : num 3 3 3 3 3 2 2 3 3 3 ...\n $ LIME1 : num 4 4 4 4 4 0 2 1 0 4 ...\n $ VAL2 : num 4 4 5 8 8 4 8 4 8 8 ...\n $ CHR2 : num 4 4 4 2 2 4 2 4 2 2 ...\n $ LIME2 : num 4 4 4 5 5 4 5 4 5 5 ...\n $ DEPTHCM : num 61 91 46 20 20 91 30 61 38 25 ...\n $ DEP2LIME : num 20 20 20 20 20 20 20 20 40 20 ...\n $ PCLAY1 : num 15 25 20 20 18 25 25 35 35 12 ...\n $ PCLAY2 : num 10 10 20 10 10 20 10 20 10 10 ...\n $ MG1 : num 63 58 55 60 88 168 99 59 233 87 ...\n $ OM1 : num 5.7 5.6 5.8 6.2 8.4 6.4 7.1 3.8 5 9.2 ...\n $ CEC1 : num 20 22 17 23 27 27 21 14 27 20 ...\n $ PH1 : num 7.7 7.7 7.5 7.6 7.6 7 7.5 7.6 6.6 7.5 ...\n $ PHOS1 : num 13 9.2 10.5 8.8 13 9.3 10 9 15 12.6 ...\n $ POT1 : num 196 157 115 172 238 164 312 184 123 282 ...\n```\n:::\n:::\n\n\nSuppose that we want to model the magnesium concentration (`MG1`), represented as a function of the spatial position in the following graph.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-32_cf223f9501bba263c237e06328f21358'}\n\n```{.r .cell-code}\nlibrary(ggplot2)\nggplot(oxford, aes(x = YCOORD, y = XCOORD, size = MG1)) +\n geom_point() +\n coord_fixed()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNote that the $x$ and $y$ axes have been inverted to save space. The `coord_fixed()` function of *ggplot2* ensures that the scale is the same on both axes, which is useful for representing spatial data.\n\nWe can immediately see that these measurements were taken on a 100 m grid. It seems that the magnesium concentration is spatially correlated, although it may be a correlation induced by another variable. In particular, we know that the concentration of magnesium is negatively related to the soil pH (`PH1`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-33_a9ec8bcf320a9e52d1252e4725f81bf7'}\n\n```{.r .cell-code}\nggplot(oxford, aes(x = PH1, y = MG1)) +\n geom_point()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe `variogram` function of *gstat* is used to estimate a variogram from empirical data. Here is the result obtained for the variable `MG1`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-34_c3f828164d93cc2b3d38500281fe87b9'}\n\n```{.r .cell-code}\nvar_mg <- variogram(MG1 ~ 1, locations = ~ XCOORD + YCOORD, data = oxford)\nvar_mg\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n np dist gamma dir.hor dir.ver id\n1 225 100.0000 1601.404 0 0 var1\n2 200 141.4214 1950.805 0 0 var1\n3 548 215.0773 2171.231 0 0 var1\n4 623 303.6283 2422.245 0 0 var1\n5 258 360.5551 2704.366 0 0 var1\n6 144 400.0000 2948.774 0 0 var1\n7 570 427.5569 2994.621 0 0 var1\n8 291 500.0000 3402.058 0 0 var1\n9 366 522.8801 3844.165 0 0 var1\n10 200 577.1759 3603.060 0 0 var1\n11 458 619.8400 3816.595 0 0 var1\n12 90 670.8204 3345.739 0 0 var1\n```\n:::\n:::\n\n\nThe formula `MG1 ~ 1` indicates that no linear predictor is included in this model, while the argument `locations` indicates which variables in the data frame correspond to the spatial coordinates.\n\nIn the resulting table, `gamma` is the value of the variogram for the distance class centered on `dist`, while `np` is the number of pairs of points in that class. Here, since the points are located on a grid, we obtain regular distance classes (e.g.: 100 m for neighboring points on the grid, 141 m for diagonal neighbors, etc.).\n\nHere, we limit ourselves to the estimation of isotropic variograms, i.e. the variogram depends only on the distance between the two points and not on the direction. Although we do not have time to see it today, it is possible with *gstat* to estimate the variogram separately in different directions.\n\nWe can illustrate the variogram with `plot`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-35_dced0e607669b721d5ef7df8faa51cb2'}\n\n```{.r .cell-code}\nplot(var_mg, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIf we want to estimate the residual spatial correlation of `MG1` after including the effect of `PH1`, we can add that predictor to the formula.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-36_41f230bd5a30f1cb7752e89e361c338a'}\n\n```{.r .cell-code}\nvar_mg <- variogram(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford)\nplot(var_mg, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIncluding the effect of pH, the range of the spatial correlation seems to decrease, while the plateau is reached around 300 m. It even seems that the variogram decreases beyond 400 m. In general, we assume that the variance between two points does not decrease with distance, unless there is a periodic spatial pattern.\n\nThe function `fit.variogram` accepts as arguments a variogram estimated from the data, as well as a theoretical model described in a `vgm` function, and then estimates the parameters of that model according to the data. The fitting is done by the method of least squares.\n\nFor example, `vgm(\"Exp\")` means we want to fit an exponential model.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-37_b852e100bd05bd7def030586576b386c'}\n\n```{.r .cell-code}\nvfit <- fit.variogram(var_mg, vgm(\"Exp\"))\nvfit\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n model psill range\n1 Nug 0.000 0.00000\n2 Exp 1951.496 95.11235\n```\n:::\n:::\n\n\nThere is no nugget effect, because `psill = 0` for the `Nug` (nugget) part of the model. The exponential part has a sill at 1951 and a range of 95 m.\n\nTo compare different models, a vector of model names can be given to `vgm`. In the following example, we include the exponential, gaussian (\"Gau\") and spherical (\"Sph\") models.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-38_5af5359b8627d50d97bf2175f4728362'}\n\n```{.r .cell-code}\nvfit <- fit.variogram(var_mg, vgm(c(\"Exp\", \"Gau\", \"Sph\")))\nvfit\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n model psill range\n1 Nug 0.000 0.00000\n2 Exp 1951.496 95.11235\n```\n:::\n:::\n\n\nThe function gives us the result of the model with the best fit (lowest sum of squared deviations), which here is the same exponential model.\n\nFinally, we can superimpose the theoretical model and the empirical variogram on the same graph.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-39_acab997244a63895e5eaedd7b9e62465'}\n\n```{.r .cell-code}\nplot(var_mg, vfit, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n## Regression with spatial correlation\n\nWe have seen above that the *gstat* package allows us to estimate the variogram of the residuals of a linear model. In our example, the magnesium concentration was modeled as a function of pH, with spatially correlated residuals.\n\nAnother tool to fit this same type of model is the `gls` function of the *nlme* package, which is included with the installation of R.\n\nThis function applies the *generalized least squares* method to fit linear regression models when the residuals are not independent or when the residual variance is not the same for all observations. Since the estimates of the coefficients depend on the estimated correlations between the residuals and the residuals themselves depend on the coefficients, the model is fitted by an iterative algorithm:\n\n1. A classical linear regression model (without correlation) is fitted to obtain residuals.\n\n2. The spatial correlation model (variogram) is fitted with those residuals.\n\n3. The regression coefficients are re-estimated, now taking into account the correlations.\n\nSteps 2 and 3 are repeated until the estimates are stable at a desired precision.\n\nHere is the application of this method to the same model for the magnesium concentration in the `oxford` dataset. In the `correlation` argument of `gls`, we specify an exponential correlation model as a function of our spatial coordinates and we include a possible nugget effect.\n\nIn addition to the exponential correlation `corExp`, the `gls` function can also estimate a Gaussian (`corGaus`) or spherical (`corSpher`) model.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-40_0b3199847595fbf9b39d87618cbffc8f'}\n\n```{.r .cell-code}\nlibrary(nlme)\ngls_mg <- gls(MG1 ~ PH1, oxford, \n correlation = corExp(form = ~ XCOORD + YCOORD, nugget = TRUE))\nsummary(gls_mg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized least squares fit by REML\n Model: MG1 ~ PH1 \n Data: oxford \n AIC BIC logLik\n 1278.65 1292.751 -634.325\n\nCorrelation Structure: Exponential spatial correlation\n Formula: ~XCOORD + YCOORD \n Parameter estimate(s):\n range nugget \n478.0322964 0.2944753 \n\nCoefficients:\n Value Std.Error t-value p-value\n(Intercept) 391.1387 50.42343 7.757084 0\nPH1 -41.0836 6.15662 -6.673079 0\n\n Correlation: \n (Intr)\nPH1 -0.891\n\nStandardized residuals:\n Min Q1 Med Q3 Max \n-2.1846957 -0.6684520 -0.3687813 0.4627580 3.1918604 \n\nResidual standard error: 53.8233 \nDegrees of freedom: 126 total; 124 residual\n```\n:::\n:::\n\n\nTo compare this result with the adjusted variogram above, the parameters given by `gls` must be transformed. The range has the same meaning in both cases and corresponds to 478 m for the result of `gls`. The global variance of the residuals is the square of `Residual standard error`. The nugget effect here (0.294) is expressed as a fraction of that variance. Finally, to obtain the partial sill of the exponential part, the nugget effect must be subtracted from the total variance.\n\nAfter performing these calculations, we can give these parameters to the `vgm` function of *gstat* to superimpose this variogram estimated by `gls` on our variogram of the residuals of the classical linear model.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-41_bdace2c5570a84ab706e3cc520568742'}\n\n```{.r .cell-code}\ngls_range <- 478\ngls_var <- 53.823^2\ngls_nugget <- 0.294 * gls_var\ngls_psill <- gls_var - gls_nugget\n\ngls_vgm <- vgm(\"Exp\", psill = gls_psill, range = gls_range, nugget = gls_nugget)\n\nplot(var_mg, gls_vgm, col = \"black\", ylim = c(0, 4000))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nDoes the model fit the data less well here? In fact, this empirical variogram represented by the points was obtained from the residuals of the linear model ignoring the spatial correlation, so it is a biased estimate of the actual spatial correlations. The method is still adequate to quickly check if spatial correlations are present. However, to simultaneously fit the regression coefficients and the spatial correlation parameters, the generalized least squares (GLS) approach is preferable and will produce more accurate estimates.\n\nFinally, note that the result of the `gls` model also gives the AIC, which we can use to compare the fit of different models (with different predictors or different forms of spatial correlation).\n\n## Exercise\n\nThe [bryo_belg.csv](data/bryo_belg.csv) dataset is adapted from the data of this study:\n\n> Neyens, T., Diggle, P.J., Faes, C., Beenaerts, N., Artois, T. et Giorgi, E. (2019) Mapping species richness using opportunistic samples: a case study on ground-floor bryophyte species richness in the Belgian province of Limburg. *Scientific Reports* 9, 19122. https://doi.org/10.1038/s41598-019-55593-x\n\nThis data frame shows the specific richness of ground bryophytes (*richness*) for different sampling points in the Belgian province of Limburg, with their position *(x, y)* in km, in addition to information on the proportion of forest (*forest*) and wetlands (*wetland*) in a 1 km\\^2\\$ cell containing the sampling point.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-42_c25ae6f03a62752dff743e2d40b205a0'}\n\n```{.r .cell-code}\nbryo_belg <- read.csv(\"data/bryo_belg.csv\")\nhead(bryo_belg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n richness forest wetland x y\n1 9 0.2556721 0.5036614 228.9516 220.8869\n2 6 0.6449114 0.1172068 227.6714 219.8613\n3 5 0.5039905 0.6327003 228.8252 220.1073\n4 3 0.5987329 0.2432942 229.2775 218.9035\n5 2 0.7600775 0.1163538 209.2435 215.2414\n6 10 0.6865434 0.0000000 210.4142 216.5579\n```\n:::\n:::\n\n\nFor this exercise, we will use the square root of the specific richness as the response variable. The square root transformation often allows to homogenize the variance of the count data in order to apply a linear regression.\n\na) Fit a linear model of the transformed species richness to the proportion of forest and wetlands, without taking into account spatial correlations. What is the effect of the two predictors in this model?\n\nb) Calculate the empirical variogram of the model residuals in (a). Does there appear to be a spatial correlation between the points?\n\n*Note*: The `cutoff` argument to the `variogram` function specifies the maximum distance at which the variogram is calculated. You can manually adjust this value to get a good view of the sill.\n\nc) Re-fit the linear model in (a) with the `gls` function in the *nlme* package, trying different types of spatial correlations (exponential, Gaussian, spherical). Compare the models (including the one without spatial correlation) with the AIC.\n\nd) What is the effect of the proportion of forests and wetlands according to the model in (c)? Explain the differences between the conclusions of this model and the model in (a).\n\n# Kriging\n\nAs mentioned before, a common application of geostatistical models is to predict the value of the response variable at unsampled locations, a form of spatial interpolation called kriging (pronounced with a hard \"g\").\n\nThere are three basic types of kriging based on the assumptions made about the response variable:\n\n- Ordinary kriging: Stationary variable with an unknown mean.\n\n- Simple kriging: Stationary variable with a known mean.\n\n- Universal kriging: Variable with a trend given by a linear or non-linear model.\n\nFor all kriging methods, the predictions at a new point are a weighted mean of the values at known points. These weights are chosen so that kriging provides the best linear unbiased prediction of the response variable, if the model assumptions (in particular the variogram) are correct. That is, among all possible unbiased predictions, the weights are chosen to give the minimum mean square error. Kriging also provides an estimate of the uncertainty of each prediction.\n\nWhile we will not present the detailed kriging equations here, the weights depend on both the correlations (estimated by the variogram) between the sampled points and the new point, as well of the correlations between the sampled points themselves. In other words, sampled points near the new point are given more weight, but isolated sampled points are also given more weight, because sample points close to each other provide redundant information.\n\nKriging is an interpolation method, so the prediction at a sampled point will always be equal to the measured value (the measurement is supposed to have no error, just spatial variation). However, in the presence of a nugget effect, any small displacement from the sampled location will show variability according to the nugget.\n\nIn the example below, we generate a new dataset composed of randomly-generated (x, y) coordinates within the study area as well as randomly-generated pH values based on the `oxford` data. We then apply the function `krige` to predict the magnesium values at these new points. Note that we specify the variogram derived from the GLS results in the `model` argument to `krige`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-43_f81acecbca5eefa202e114614faebc54'}\n\n```{.r .cell-code}\nset.seed(14)\nnew_points <- data.frame(\n XCOORD = runif(100, min(oxford$XCOORD), max(oxford$XCOORD)),\n YCOORD = runif(100, min(oxford$YCOORD), max(oxford$YCOORD)),\n PH1 = rnorm(100, mean(oxford$PH1), sd(oxford$PH1))\n)\n\npred <- krige(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford,\n newdata = new_points, model = gls_vgm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[using universal kriging]\n```\n:::\n\n```{.r .cell-code}\nhead(pred)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n XCOORD YCOORD var1.pred var1.var\n1 227.0169 162.1185 47.13065 1269.002\n2 418.9136 465.9013 79.68437 1427.269\n3 578.5943 2032.7477 60.30539 1264.471\n4 376.2734 1530.7193 127.22366 1412.875\n5 591.5336 421.6290 105.88124 1375.485\n6 355.7369 404.3378 127.73055 1250.114\n```\n:::\n:::\n\n\nThe result of `krige` includes the new point coordinates, the prediction of the variable `var1.pred` along with its estimated variance `var1.var`. In the graph below, we show the mean MG1 predictions from kriging (triangles) along with the measurements (circles).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-44_8a46f7bb0f5137f5dae6fef418b6b61e'}\n\n```{.r .cell-code}\npred$MG1 <- pred$var1.pred\n\nggplot(oxford, aes(x = YCOORD, y = XCOORD, color = MG1)) +\n geom_point() +\n geom_point(data = pred, shape = 17, size = 2) +\n coord_fixed()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe estimated mean and variance from kriging can be used to simulate possible values of the variable at each new point, conditional on the sampled values. In the example below, we performed 4 conditional simulations by adding the argument `nsim = 4` to the same `krige` instruction.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-45_15e6975ae8f74fb12acd4b9d15610303'}\n\n```{.r .cell-code}\nsim_mg <- krige(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford,\n newdata = new_points, model = gls_vgm, nsim = 4)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\ndrawing 4 GLS realisations of beta...\n[using conditional Gaussian simulation]\n```\n:::\n\n```{.r .cell-code}\nhead(sim_mg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n XCOORD YCOORD sim1 sim2 sim3 sim4\n1 227.0169 162.1185 9.638739 34.53159 46.08685 77.86376\n2 418.9136 465.9013 60.029144 20.17179 76.46333 59.57924\n3 578.5943 2032.7477 100.791412 77.47887 73.50058 59.40279\n4 376.2734 1530.7193 112.615730 150.96664 78.76125 146.83928\n5 591.5336 421.6290 70.925240 72.85522 153.90610 126.63758\n6 355.7369 404.3378 161.608032 118.93640 134.45695 142.20074\n```\n:::\n:::\n\n::: {.cell fig.dim='[10,5]' hash='index_cache/html/unnamed-chunk-46_dc67747871861d460645cc2d898c2797'}\n\n```{.r .cell-code}\nlibrary(tidyr)\nsim_mg <- pivot_longer(sim_mg, cols = c(sim1, sim2, sim3, sim4), \n names_to = \"sim\", values_to = \"MG1\")\nggplot(sim_mg, aes(x = YCOORD, y = XCOORD, color = MG1)) +\n geom_point() +\n coord_fixed() +\n facet_wrap(~ sim)\n```\n\n::: {.cell-output-display}\n{width=960}\n:::\n:::\n\n\n# Solutions\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-47_46625f4b0eb7a89df12358298784d779'}\n\n```{.r .cell-code}\nbryo_lm <- lm(sqrt(richness) ~ forest + wetland, data = bryo_belg)\nsummary(bryo_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall:\nlm(formula = sqrt(richness) ~ forest + wetland, data = bryo_belg)\n\nResiduals:\n Min 1Q Median 3Q Max \n-1.8847 -0.4622 0.0545 0.4974 2.3116 \n\nCoefficients:\n Estimate Std. Error t value Pr(>|t|) \n(Intercept) 2.34159 0.08369 27.981 < 2e-16 ***\nforest 1.11883 0.13925 8.034 9.74e-15 ***\nwetland -0.59264 0.17216 -3.442 0.000635 ***\n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nResidual standard error: 0.7095 on 417 degrees of freedom\nMultiple R-squared: 0.2231,\tAdjusted R-squared: 0.2193 \nF-statistic: 59.86 on 2 and 417 DF, p-value: < 2.2e-16\n```\n:::\n:::\n\n\nThe proportion of forest has a significant positive effect and the proportion of wetlands has a significant negative effect on bryophyte richness.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-48_9f1b47ee10d87121e3853375afbb8273'}\n\n```{.r .cell-code}\nplot(variogram(sqrt(richness) ~ forest + wetland, locations = ~ x + y,\n data = bryo_belg, cutoff = 50), col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe variogram is increasing from 0 to at least 40 km, so there appears to be spatial correlations in the model residuals.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-49_2a94f7a8b64ea0bb9127648e255fcbd3'}\n\n```{.r .cell-code}\nbryo_exp <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corExp(form = ~ x + y, nugget = TRUE))\nbryo_gaus <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corGaus(form = ~ x + y, nugget = TRUE))\nbryo_spher <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corSpher(form = ~ x + y, nugget = TRUE))\n```\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-50_9d306abf18fdbd164c34d87f9f9832d8'}\n\n```{.r .cell-code}\nAIC(bryo_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 908.6358\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_exp)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 867.822\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_gaus)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 870.9592\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_spher)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 866.9117\n```\n:::\n:::\n\n\nThe spherical model has the smallest AIC.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-51_5c26da31bc0b2db751ce60929eb7b8be'}\n\n```{.r .cell-code}\nsummary(bryo_spher)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized least squares fit by REML\n Model: sqrt(richness) ~ forest + wetland \n Data: bryo_belg \n AIC BIC logLik\n 866.9117 891.1102 -427.4558\n\nCorrelation Structure: Spherical spatial correlation\n Formula: ~x + y \n Parameter estimate(s):\n range nugget \n43.1727664 0.6063187 \n\nCoefficients:\n Value Std.Error t-value p-value\n(Intercept) 2.0368769 0.2481636 8.207800 0.000\nforest 0.6989844 0.1481690 4.717481 0.000\nwetland -0.2441130 0.1809118 -1.349348 0.178\n\n Correlation: \n (Intr) forest\nforest -0.251 \nwetland -0.235 0.241\n\nStandardized residuals:\n Min Q1 Med Q3 Max \n-1.75204183 -0.06568688 0.61415597 1.15240370 3.23322743 \n\nResidual standard error: 0.7998264 \nDegrees of freedom: 420 total; 417 residual\n```\n:::\n:::\n\n\nBoth effects are less important in magnitude and the effect of wetlands is not significant anymore. As is the case for other types of non-independent residuals, the \"effective sample size\" here is less than the number of points, since points close to each other provide redundant information. Therefore, the relationship between predictors and response is less clear than given by the model assuming all these points were independent.\n\nNote that the results for all three `gls` models are quite similar, so the choice to include spatial correlations was more important than the exact shape assumed for the variogram.\n\n\n# Areal data {#areal-data}\n\nAreal data are variables measured for regions of space, defined by polygons. This type of data is more common in the social sciences, human geography and epidemiology, where data is often available at the scale of administrative divisions.\n\nThis type of data also appears frequently in natural resource management. For example, the following map shows the forest management units of the Ministère de la Forêt, de la Faune et des Parcs du Québec.\n\n\n\nSuppose that a variable is available at the level of these management units. How can we model the spatial correlation between units that are spatially close together?\n\nOne option would be to apply the geostatistical methods seen before, for example by calculating the distance between the centers of the polygons.\n\nAnother option, which is more adapted for areal data, is to define a network where each region is connected to neighbouring regions by a link. It is then assumed that the variables are directly correlated between neighbouring regions only. (Note, however, that direct correlations between immediate neighbours also generate indirect correlations for a chain of neighbours).\n\nIn this type of model, the correlation is not necessarily the same from one link to another. In this case, each link in the network can be associated with a *weight* representing its importance for the spatial correlation. We represent these weights by a matrix $W$ where $w_{ij}$ is the weight of the link between regions $i$ and $j$. A region has no link with itself, so $w_{ii} = 0$.\n\nA simple choice for $W$ is to assign a weight equal to 1 if the regions are neighbours, otherwise 0 (binary weight).\n\nIn addition to land divisions represented by polygons, another example of areal data consists of a grid where the variable is calculated for each cell of the grid. In this case, a cell generally has 4 or 8 neighbouring cells, depending on whether diagonals are included or not.\n\n# Moran's I {#moran-i}\n\nBefore discussing spatial autocorrelation models, we present Moran's $I$ statistic, which allows us to test whether a significant correlation is present between neighbouring regions.\n\nMoran's $I$ is a spatial autocorrelation coefficient of $z$, weighted by the $w_{ij}$. It therefore takes values between -1 and 1.\n\n$$I = \\frac{N}{\\sum_i \\sum_j w_{ij}} \\frac{\\sum_i \\sum_j w_{ij} (z_i - \\bar{z}) (z_j - \\bar{z})}{\\sum_i (z_i - \\bar{z})^2}$$\n\nIn this equation, we recognize the expression of a correlation, which is the product of the deviations from the mean for two variables $z_i$ and $z_j$, divided by the product of their standard deviations (it is the same variable here, so we get the variance). The contribution of each pair $(i, j)$ is multiplied by its weight $w_{ij}$ and the term on the left (the number of regions $N$ divided by the sum of the weights) ensures that the result is bounded between -1 and 1.\n\nSince the distribution of $I$ is known in the absence of spatial autocorrelation, this statistic serves to test the null hypothesis that there is no spatial correlation between neighbouring regions.\n\nAlthough we will not see an example in this course, Moran's $I$ can also be applied to point data. In this case, we divide the pairs of points into distance classes and calculate $I$ for each distance class; the weight $w_{ij} = 1$ if the distance between $i$ and $j$ is in the desired distance class, otherwise 0.\n\n# Spatial autoregression models {#spatial-autoreg}\n\nLet us recall the formula for a linear regression with spatial dependence:\n\n$$v = \\beta_0 + \\sum_i \\beta_i u_i + z + \\epsilon$$\n\nwhere $z$ is the portion of the residual variance that is spatially correlated.\n\nThere are two main types of autoregressive models to represent the spatial dependence of $z$: conditional autoregression (CAR) and simultaneous autoregressive (SAR).\n\n## Conditional autoregressive (CAR) model\n\nIn the conditional autoregressive model, the value of $z_i$ for the region $i$ follows a normal distribution: its mean depends on the value $z_j$ of neighbouring regions, multiplied by the weight $w_{ij}$ and a correlation coefficient $\\rho$; its standard deviation $\\sigma_{z_i}$ may vary from one region to another.\n\n$$z_i \\sim \\text{N}\\left(\\sum_j \\rho w_{ij} z_j,\\sigma_{z_i} \\right)$$\n\nIn this model, if $w_{ij}$ is a binary matrix (0 for non-neighbours, 1 for neighbours), then $\\rho$ is the coefficient of partial correlation between neighbouring regions. This is similar to a first-order autoregressive model in the context of time series, where the autoregression coefficient indicates the partial correlation.\n\n## Simultaneous autoregressive (SAR) model\n\nIn the simultaneous autoregressive model, the value of $z_i$ is given directly by the sum of contributions from neighbouring values $z_j$, multiplied by $\\rho w_{ij}$, with an independent residual $\\nu_i$ of standard deviation $\\sigma_z$.\n\n$$z_i = \\sum_j \\rho w_{ij} z_j + \\nu_i$$\n\nAt first glance, this looks like a temporal autoregressive model. However, there is an important conceptual difference. For temporal models, the causal influence is directed in only one direction: $v(t-2)$ affects $v(t-1)$ which then affects $v(t)$. For a spatial model, each $z_j$ that affects $z_i$ depends in turn on $z_i$. Thus, to determine the joint distribution of $z$, a system of equations must be solved simultaneously (hence the name of the model).\n\nFor this reason, although this model resembles the formula of CAR model, the solutions of the two models differ and in the case of SAR, the coefficient $\\rho$ is not directly equal to the partial correlation due to each neighbouring region.\n\nFor more details on the mathematical aspects of these models, see the article by Ver Hoef et al. (2018) suggested in reference.\n\nFor the moment, we will consider SAR and CAR as two types of possible models to represent a spatial correlation on a network. We can always fit several models and compare them with the AIC to choose the best form of correlation or the best weight matrix.\n\nThe CAR and SAR models share an advantage over geostatistical models in terms of efficiency. In a geostatistical model, spatial correlations are defined between each pair of points, although they become negligible as distance increases. For a CAR or SAR model, only neighbouring regions contribute and most weights are equal to 0, making these models faster to fit than a geostatistical model when the data are massive.\n\n# Analysis of areal data in R {#analysis-areal}\n\nTo illustrate the analysis of areal data in R, we load the packages *sf* (to read geospatial data), *spdep* (to define spatial networks and calculate Moran's $I$) and *spatialreg* (for SAR and CAR models).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-52_bbb39418b6f206ecf18ea280d1186280'}\n\n```{.r .cell-code}\nlibrary(sf)\nlibrary(spdep)\nlibrary(spatialreg)\n```\n:::\n\n\nAs an example, we will use a dataset that presents some of the results of the 2018 provincial election in Quebec, with population characteristics of each riding. This data is included in a *shapefile* (.shp) file type, which we can read with the `read_sf` function of the *sf* package.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-53_57544cb924c4156b05da2ae4a2ea020a'}\n\n```{.r .cell-code}\nelect2018 <- read_sf(\"data/elect2018.shp\")\nhead(elect2018)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nSimple feature collection with 6 features and 9 fields\nGeometry type: MULTIPOLYGON\nDimension: XY\nBounding box: xmin: 97879.03 ymin: 174515.3 xmax: 694261.1 ymax: 599757.1\nProjected CRS: LambertAQ\n# A tibble: 6 × 10\n circ age_moy pct_frn pct_prp rev_med propCAQ propPQ propPLQ propQS\n \n1 Abitibi-Est 40.8 0.963 0.644 34518 42.7 19.5 18.8 15.7\n2 Abitibi-Ouest 42.2 0.987 0.735 33234 34.1 33.3 11.3 16.6\n3 Acadie 40.3 0.573 0.403 25391 16.5 9 53.8 13.8\n4 Anjou-Louis-Riel 43.5 0.821 0.416 31275 28.9 14.7 39.1 14.5\n5 Argenteuil 43.3 0.858 0.766 31097 38.9 21.1 17.4 12.2\n6 Arthabaska 43.4 0.989 0.679 30082 61.8 9.4 11.4 12.6\n# … with 1 more variable: geometry \n```\n:::\n:::\n\n\n*Note*: The dataset is actually composed of 4 files with the extensions .dbf, .prj, .shp and .shx, but it is sufficient to write the name of the .shp file in `read_sf`.\n\nThe columns of the dataset are, in order:\n\n- the name of the electoral riding (`circ`);\n- four characteristics of the population (`age_moy` = mean age, `pct_frn` = fraction of the population that speaks mainly French at home, `pct_prp` = fraction of households that own their home, `rev_med` = median income);\n- four columns showing the fraction of votes obtained by the main parties (CAQ, PQ, PLQ, QS);\n- a `geometry` column that contains the geometric object (multipolygon) corresponding to the riding.\n\nTo illustrate one of the variables on a map, we call the `plot` function with the name of the column in square brackets and quotation marks.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-54_b911c1230b37d88999c315735187b9c4'}\n\n```{.r .cell-code}\nplot(elect2018[\"rev_med\"])\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIn this example, we want to model the fraction of votes obtained by the CAQ based on the characteristics of the population in each riding and taking into account the spatial correlations between neighbouring ridings.\n\n## Definition of the neighbourhood network\n\nThe `poly2nb` function of the *spdep* package defines a neighbourhood network from polygons. The result `vois` is a list of 125 elements where each element contains the indices of the neighbouring (bordering) polygons of a given polygon.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-55_98b699432f680855147ba1bd583f3497'}\n\n```{.r .cell-code}\nvois <- poly2nb(elect2018)\nvois[[1]]\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 2 37 63 88 101 117\n```\n:::\n:::\n\n\nThus, the first riding (Abitibi-Est) has 6 neighbouring ridings, for which the names can be found as follows:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-56_1fa15a9556e3ec5f51ffe127e1e42830'}\n\n```{.r .cell-code}\nelect2018$circ[vois[[1]]]\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] \"Abitibi-Ouest\" \"Gatineau\" \n[3] \"Laviolette-Saint-Maurice\" \"Pontiac\" \n[5] \"Rouyn-Noranda-Témiscamingue\" \"Ungava\" \n```\n:::\n:::\n\n\nWe can illustrate this network by extracting the coordinates of the center of each district, creating a blank map with `plot(elect2018[\"geometry\"])`, then adding the network as an additional layer with `plot(vois, add = TRUE, coords = coords)`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-57_f0d7bd96b26b0a6cd39daec9f4aad58b'}\n\n```{.r .cell-code}\ncoords <- st_centroid(elect2018) %>%\n st_coordinates()\nplot(elect2018[\"geometry\"])\nplot(vois, add = TRUE, col = \"red\", coords = coords)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nWe can \"zoom\" on southern Québec by choosing the limits `xlim` and `ylim`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-58_1fa7ea9cbb36326317c26af33b739d1c'}\n\n```{.r .cell-code}\nplot(elect2018[\"geometry\"], \n xlim = c(400000, 800000), ylim = c(100000, 500000))\nplot(vois, add = TRUE, col = \"red\", coords = coords)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nWe still have to add weights to each network link with the `nb2listw` function. The style of weights \"B\" corresponds to binary weights, i.e. 1 for the presence of link and 0 for the absence of link between two ridings.\n\nOnce these weights are defined, we can verify with Moran's test whether there is a significant autocorrelation of votes obtained by the CAQ between neighbouring ridings.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-59_94da4f87bfc6fa6486cce26e9c1ed239'}\n\n```{.r .cell-code}\npoids <- nb2listw(vois, style = \"B\")\n\nmoran.test(elect2018$propCAQ, poids)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\n\tMoran I test under randomisation\n\ndata: elect2018$propCAQ \nweights: poids \n\nMoran I statistic standard deviate = 13.148, p-value < 2.2e-16\nalternative hypothesis: greater\nsample estimates:\nMoran I statistic Expectation Variance \n 0.680607768 -0.008064516 0.002743472 \n```\n:::\n:::\n\n\nThe value $I = 0.68$ is very significant judging by the $p$-value of the test.\n\nLet's verify if the spatial correlation persists after taking into account the four characteristics of the population, therefore by inspecting the residuals of a linear model including these four predictors.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-60_48eb067e5cfdccfc3e81ace94767cddc'}\n\n```{.r .cell-code}\nelect_lm <- lm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, data = elect2018)\nsummary(elect_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall:\nlm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018)\n\nResiduals:\n Min 1Q Median 3Q Max \n-30.9890 -4.4878 0.0562 6.2653 25.8146 \n\nCoefficients:\n Estimate Std. Error t value Pr(>|t|) \n(Intercept) 1.354e+01 1.836e+01 0.737 0.463 \nage_moy -9.170e-01 3.855e-01 -2.378 0.019 * \npct_frn 4.588e+01 5.202e+00 8.820 1.09e-14 ***\npct_prp 3.582e+01 6.527e+00 5.488 2.31e-07 ***\nrev_med -2.624e-05 2.465e-04 -0.106 0.915 \n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nResidual standard error: 9.409 on 120 degrees of freedom\nMultiple R-squared: 0.6096,\tAdjusted R-squared: 0.5965 \nF-statistic: 46.84 on 4 and 120 DF, p-value: < 2.2e-16\n```\n:::\n\n```{.r .cell-code}\nmoran.test(residuals(elect_lm), poids)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\n\tMoran I test under randomisation\n\ndata: residuals(elect_lm) \nweights: poids \n\nMoran I statistic standard deviate = 6.7047, p-value = 1.009e-11\nalternative hypothesis: greater\nsample estimates:\nMoran I statistic Expectation Variance \n 0.340083290 -0.008064516 0.002696300 \n```\n:::\n:::\n\n\nMoran's $I$ has decreased but remains significant, so some of the previous correlation was induced by these predictors, but there remains a spatial correlation due to other factors.\n\n## Spatial autoregression models\n\nFinally, we fit SAR and CAR models to these data with the `spautolm` (*spatial autoregressive linear model*) function of *spatialreg*. Here is the code for a SAR model including the effect of the same four predictors.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-61_13bb8dc5c63cce02c362b41c905f9de5'}\n\n```{.r .cell-code}\nelect_sar <- spautolm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids)\nsummary(elect_sar)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids)\n\nResiduals:\n Min 1Q Median 3Q Max \n-23.08342 -4.10573 0.24274 4.29941 23.08245 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 15.09421119 16.52357745 0.9135 0.36098\nage_moy -0.70481703 0.32204139 -2.1886 0.02863\npct_frn 39.09375061 5.43653962 7.1909 6.435e-13\npct_prp 14.32329345 6.96492611 2.0565 0.03974\nrev_med 0.00016730 0.00023209 0.7208 0.47101\n\nLambda: 0.12887 LR test value: 42.274 p-value: 7.9339e-11 \nNumerical Hessian standard error of lambda: 0.012069 \n\nLog likelihood: -433.8862 \nML residual variance (sigma squared): 53.028, (sigma: 7.282)\nNumber of observations: 125 \nNumber of parameters estimated: 7 \nAIC: 881.77\n```\n:::\n:::\n\n\nThe value given by `Lambda` in the summary corresponds to the coefficient $\\rho$ in our description of the model. The likelihood-ratio test (`LR test`) confirms that this residual spatial correlation (after controlling for the effect of predictors) is significant.\n\nThe estimated effects for the predictors are similar to those of the linear model without spatial correlation. The effects of mean age, fraction of francophones and fraction of homeowners remain significant, although their magnitude has decreased somewhat.\n\nTo fit a CAR rather than SAR model, we must specify `family = \"CAR\"`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-62_29349c4a3573934d0da78be8a806d927'}\n\n```{.r .cell-code}\nelect_car <- spautolm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids, family = \"CAR\")\nsummary(elect_car)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids, family = \"CAR\")\n\nResiduals:\n Min 1Q Median 3Q Max \n-21.73315 -4.24623 -0.24369 3.44228 23.43749 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 16.57164696 16.84155327 0.9840 0.325128\nage_moy -0.79072151 0.32972225 -2.3981 0.016478\npct_frn 38.99116707 5.43667482 7.1719 7.399e-13\npct_prp 17.98557474 6.80333470 2.6436 0.008202\nrev_med 0.00012639 0.00023106 0.5470 0.584364\n\nLambda: 0.15517 LR test value: 40.532 p-value: 1.9344e-10 \nNumerical Hessian standard error of lambda: 0.0026868 \n\nLog likelihood: -434.7573 \nML residual variance (sigma squared): 53.9, (sigma: 7.3416)\nNumber of observations: 125 \nNumber of parameters estimated: 7 \nAIC: 883.51\n```\n:::\n:::\n\n\nFor a CAR model with binary weights, the value of `Lambda` (which we called $\\rho$) directly gives the partial correlation coefficient between neighbouring districts. Note that the AIC here is slightly higher than the SAR model, so the latter gave a better fit.\n\n## Exercise\n\nThe `rls_covid` dataset, in *shapefile* format, contains data on detected COVID-19 cases (`cas`), number of cases per 1000 people (`taux_1k`) and the population density (`dens_pop`) in each of Quebec's local health service networks (RLS) (Source: Data downloaded from the Institut national de santé publique du Québec as of January 17, 2021).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-63_93fde0bc2a6d31114d1cad8dee5f0aa1'}\n\n```{.r .cell-code}\nrls_covid <- read_sf(\"data/rls_covid.shp\")\nhead(rls_covid)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nSimple feature collection with 6 features and 5 fields\nGeometry type: MULTIPOLYGON\nDimension: XY\nBounding box: xmin: 785111.2 ymin: 341057.8 xmax: 979941.5 ymax: 541112.7\nProjected CRS: Conique_conforme_de_Lambert_du_MTQ_utilis_e_pour_Adresse_Qu_be\n# A tibble: 6 × 6\n RLS_code RLS_nom cas taux_1k dens_…¹ geometry\n \n1 0111 RLS de Kamouraska 152 7.34 6.76 (((827028.3 412772.4, 82…\n2 0112 RLS de Rivière-du-Lo… 256 7.34 19.6 (((855905 452116.9, 8557…\n3 0113 RLS de Témiscouata 81 4.26 4.69 (((911829.4 441311.2, 91…\n4 0114 RLS des Basques 28 3.3 5.35 (((879249.6 471975.6, 87…\n5 0115 RLS de Rimouski 576 9.96 15.5 (((917748.1 503148.7, 91…\n6 0116 RLS de La Mitis 76 4.24 5.53 (((951316 523499.3, 9525…\n# … with abbreviated variable name ¹dens_pop\n```\n:::\n:::\n\n\nFit a linear model of the number of cases per 1000 as a function of population density (it is suggested to apply a logarithmic transform to the latter). Check whether the model residuals are correlated between bordering RLS with a Moran's test and then model the same data with a conditional autoregressive model.\n\n## Reference\n\nVer Hoef, J.M., Peterson, E.E., Hooten, M.B., Hanks, E.M. and Fortin, M.-J. (2018) Spatial autoregressive models for statistical inference from ecological data. *Ecological Monographs* 88: 36-59.\n\n\n\n\n\n# GLMM with spatial Gaussian process {#glmm-spatial-gaussian}\n\n## Data\n\nThe `gambia` dataset found in the *geoR* package presents the results of a study of malaria prevalence among children of 65 villages in The Gambia. We will use a slightly transformed version of the data found in the file [gambia.csv](data/gambia.csv).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-64_c90dcebc741300cf593af262129c15ab'}\n\n```{.r .cell-code}\nlibrary(geoR)\n\ngambia <- read.csv(\"data/gambia.csv\")\nhead(gambia)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n id_village x y pos age netuse treated green phc\n1 1 349.6313 1458.055 1 1783 0 0 40.85 1\n2 1 349.6313 1458.055 0 404 1 0 40.85 1\n3 1 349.6313 1458.055 0 452 1 0 40.85 1\n4 1 349.6313 1458.055 1 566 1 0 40.85 1\n5 1 349.6313 1458.055 0 598 1 0 40.85 1\n6 1 349.6313 1458.055 1 590 1 0 40.85 1\n```\n:::\n:::\n\n\nHere are the fields in that dataset:\n\n- *id_village*: Identifier of the village.\n- *x* and *y*: Spatial coordinates of the village (in kilometers, based on UTM coordinates).\n- *pos*: Binary response, whether the child tested positive for malaria.\n- *age*: Age of the child in days.\n- *netuse*: Whether or not the child sleeps under a bed net.\n- *treated*: Whether or not the bed net is treated.\n- *green*: Remote sensing based measure of greenness of vegetation (measured at the village level).\n- *phc*: Presence or absence of a public health centre for the village.\n\nWe can count the number of positive cases and total children tested by village to map the fraction of positive cases (or prevalence, *prev*).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-65_8c814c1bf1c630ff765172316c6e438a'}\n\n```{.r .cell-code}\n# Create village-level dataset\ngambia_agg <- group_by(gambia, id_village, x, y, green, phc) %>%\n summarize(pos = sum(pos), total = n()) %>%\n mutate(prev = pos / total) %>%\n ungroup()\n```\n\n::: {.cell-output .cell-output-stderr}\n```\n`summarise()` has grouped output by 'id_village', 'x', 'y', 'green'. You can\noverride using the `.groups` argument.\n```\n:::\n\n```{.r .cell-code}\nhead(gambia_agg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n# A tibble: 6 × 8\n id_village x y green phc pos total prev\n \n1 1 350. 1458. 40.8 1 17 33 0.515\n2 2 359. 1460. 40.8 1 19 63 0.302\n3 3 360. 1460. 40.1 0 7 17 0.412\n4 4 364. 1497. 40.8 0 8 24 0.333\n5 5 366. 1460. 40.8 0 10 26 0.385\n6 6 367. 1463. 40.8 0 7 18 0.389\n```\n:::\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-66_ae2eb69bc71b443b86ab8b607284711a'}\n\n```{.r .cell-code}\nggplot(gambia_agg, aes(x = x, y = y)) +\n geom_point(aes(color = prev)) +\n geom_path(data = gambia.borders, aes(x = x / 1000, y = y / 1000)) +\n coord_fixed() +\n theme_minimal() +\n scale_color_viridis_c()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nWe use the `gambia.borders` dataset from the *geoR* package to trace the country boundaries with `geom_path`. Since those boundaries are in meters, we divide by 1000 to get the same scale as our points. We also use `coord_fixed` to ensure a 1:1 aspect ratio between the axes and use the `viridis` color scale, which makes it easier to visualize a continuous variable compared with the default gradient scale in *ggplot2*.\n\nBased on this map, there seems to be spatial correlation in malaria prevalence, with the eastern cluster of villages showing more high prevalence values (yellow-green) and the middle cluster showing more low prevalence values (purple).\n\n## Non-spatial GLMM\n\nFor this first example, we will ignore the spatial aspect of the data and model the presence of malaria (*pos*) as a function of the use of a bed net (*netuse*) and the presence of a public health centre (*phc*). Since we have a binary response, we need to use a logistic regression model (a GLM). Since we have predictors at both the individual and village level, and we expect that children of the same village have more similar probabilities of having malaria even after accounting for those predictors, we need to add a random effect of the village. The result is a GLMM that we fit using the `glmer` function in the *lme4* package.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-67_5c5fd662cb4ced05e844aabdfdb7a676'}\n\n```{.r .cell-code}\nlibrary(lme4)\n\nmod_glmm <- glmer(pos ~ netuse + phc + (1 | id_village), \n data = gambia, family = binomial)\nsummary(mod_glmm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized linear mixed model fit by maximum likelihood (Laplace\n Approximation) [glmerMod]\n Family: binomial ( logit )\nFormula: pos ~ netuse + phc + (1 | id_village)\n Data: gambia\n\n AIC BIC logLik deviance df.resid \n 2428.0 2450.5 -1210.0 2420.0 2031 \n\nScaled residuals: \n Min 1Q Median 3Q Max \n-2.1286 -0.7120 -0.4142 0.8474 3.3434 \n\nRandom effects:\n Groups Name Variance Std.Dev.\n id_village (Intercept) 0.8149 0.9027 \nNumber of obs: 2035, groups: id_village, 65\n\nFixed effects:\n Estimate Std. Error z value Pr(>|z|) \n(Intercept) 0.1491 0.2297 0.649 0.5164 \nnetuse -0.6044 0.1442 -4.190 2.79e-05 ***\nphc -0.4985 0.2604 -1.914 0.0556 . \n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nCorrelation of Fixed Effects:\n (Intr) netuse\nnetuse -0.422 \nphc -0.715 -0.025\n```\n:::\n:::\n\n\nAccording to these results, both *netuse* and *phc* result in a decrease of malaria prevalence, although the effect of *phc* is not significant at a threshold $\\alpha = 0.05$. The intercept (0.149) is the logit of the probability of malaria presence for a child with no bednet and no public health centre, but it is the mean intercept across all villages, and there is a lot of variation between villages, based on the random effect standard deviation of 0.90. We can get the estimated intercept for each village with the function `coef`:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-68_3720c229ebd5b2262ea78c97fa323bc0'}\n\n```{.r .cell-code}\nhead(coef(mod_glmm)$id_village)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n (Intercept) netuse phc\n1 0.93727515 -0.6043602 -0.4984835\n2 0.09204843 -0.6043602 -0.4984835\n3 0.22500620 -0.6043602 -0.4984835\n4 -0.46271089 -0.6043602 -0.4984835\n5 0.13680037 -0.6043602 -0.4984835\n6 -0.03723346 -0.6043602 -0.4984835\n```\n:::\n:::\n\n\nSo for example, the intercept for village 1 is around 0.94, equivalent to a probability of 72%:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-69_5db6d43ef9ff435eae9aedd3aebe48f9'}\n\n```{.r .cell-code}\nplogis(0.937)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 0.7184933\n```\n:::\n:::\n\n\nwhile the intercept in village 2 is equivalent to a probability of 52%:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-70_8c98817d65db7e2319175c4f3cba494c'}\n\n```{.r .cell-code}\nplogis(0.092)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 0.5229838\n```\n:::\n:::\n\n\nThe [DHARMa package](https://cran.r-project.org/web/packages/DHARMa/vignettes/DHARMa.html) provides a general method for checking whether the residuals of a GLMM are distributed according to the specified model and whether there is any residual trend. The package works by simulating replicates of each observation according to the fitted model and then determining a \"standardized residual\", which is the relative position of the observed value with respect to the simulated values, e.g. 0 if the observation is smaller than all the simulations, 0.5 if it is in the middle, etc. If the model represents the data well, each value of the standardized residual between 0 and 1 should be equally likely, so the standardized residuals should produce a uniform distribution between 0 and 1.\n\nThe `simulateResiduals` function performs the calculation of the standardized residuals, then the `plot` function plots the diagnostic graphs with the results of certain tests.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-71_7045ff49e2f9776387a59c78b53a1341'}\n\n```{.r .cell-code}\nlibrary(DHARMa)\nres_glmm <- simulateResiduals(mod_glmm)\nplot(res_glmm)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe graph on the left is a quantile-quantile plot of standardized residuals. The results of three statistical tests also also shown: a Kolmogorov-Smirnov (*KS*) test which checks whether there is a deviation from the theoretical distribution, a dispersion test that checks whether there is underdispersion or overdispersion, and an outlier test based on the number of residuals that are more extreme than all the simulations. Here, we get a significant result for the outliers, though the message indicates that this result might have an inflated type I error rate in this case.\n\nOn the right, we generally get a graph of standardized residuals (in *y*) as a function of the rank of the predicted values, in order to check for any leftover trend in the residual. Here, the predictions are binned by quartile, so it might be better to instead aggregate the predictions and residuals by village, which we can do with the `recalculateResiduals` function.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-72_65a9d2bb93c9d14f4d7fcc7b40b03c87'}\n\n```{.r .cell-code}\nplot(recalculateResiduals(res_glmm, group = gambia$id_village))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe plot to the right now shows individual points, along with a quantile regression for the 1st quartile, the median and the 3rd quartile. In theory, these three curves should be horizontal straight lines (no leftover trend in the residuals vs. predictions). The curve for the 3rd quartile (in red) is significantly different from a horizontal line, which could indicate some systematic effect that is missing from the model.\n\n## Spatial GLMM with spaMM\n\nThe *spaMM* (spatial mixed models) package is a relatively new R package that can perform approximate maximum likelihood estimation of parameters for GLMM with spatial dependence, modelled either as a Gaussian process or with a CAR (we will see the latter in the last section). The package implements different algorithms, but there is a single `fitme` function that chooses the appropriate algorithm for each model type. For example, here is the same (non-spatial) model as above fit with *spaMM*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-73_4095dfb1a2890efd12578324ce9cfb41'}\n\n```{.r .cell-code}\nlibrary(spaMM)\n\nmod_spamm_glmm <- fitme(pos ~ netuse + phc + (1 | id_village),\n data = gambia, family = binomial)\nsummary(mod_spamm_glmm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + (1 | id_village)\nEstimation of lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.1491 0.2287 0.6519\nnetuse -0.6045 0.1420 -4.2567\nphc -0.4986 0.2593 -1.9231\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n id_village : 0.8151 \n --- Coefficients for log(lambda):\n Group Term Estimate Cond.SE\n id_village (Intercept) -0.2045 0.2008\n# of obs: 2035; # of groups: id_village, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1210.016\n```\n:::\n:::\n\n\nNote that the estimates of the fixed effects as well as the variance of random effects are nearly identical to those obtained by `glmer` above.\n\nWe can now use *spaMM* to fit the same model with the addition of spatial correlations between villages. In the formula of the model, this is represented as a random effect `Matern(1 | x + y)`, which means that the intercepts are spatially correlated between villages following a Matérn correlation function of coordinates (*x, y*). The Matérn function is a flexible function for spatial correlation that includes a shape parameter $\\nu$ (`nu`), so that when $\\nu = 0.5$ it is equivalent to the exponential correlation but as $\\nu$ grows to large values, it approaches a Gaussian correlation. We could let the function estimate $\\nu$, but here we will fix it to 0.5 with the `fixed` argument of `fitme`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-74_d3aef70cffd85f41f037e30922c132c2'}\n\n```{.r .cell-code}\nmod_spamm <- fitme(pos ~ netuse + phc + Matern(1 | x + y) + (1 | id_village),\n data = gambia, family = binomial, fixed = list(nu = 0.5))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nIncrease spaMM.options(separation_max=<.>) to at least 21 if you want to check separation (see 'help(separation)').\n```\n:::\n\n```{.r .cell-code}\nsummary(mod_spamm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + Matern(1 | x + y) + (1 | id_village)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.06861 0.3352 0.2047\nnetuse -0.51719 0.1407 -3.6757\nphc -0.44416 0.2052 -2.1648\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.nu 1.rho \n0.50000000 0.05128692 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n x + y : 0.6421 \n id_village : 0.1978 \n# of obs: 2035; # of groups: x + y, 65; id_village, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1197.968\n```\n:::\n:::\n\n\nLet's first check the random effects of the model. The spatial correlation function has a parameter `rho` equal to 0.0513. This parameter in *spaMM* is the inverse of the range, so here the range of exponential correlation is 1/0.0513 or around 19.5 km. There are now two variance prameters, the one identified as `x + y` is the long-range variance (i.e. sill) for the exponential correlation model whereas the one identified as `id_village` shows the non-spatially correlated portion of the variation between villages.\n\nIn fact, while we left the random effects `(1 | id_village)` in the formula to represent the non-spatial portion of variation between villages, we could also represent this with a nugget effect in the geostatistical model. In both cases, it would represent the idea that even two villages very close to each other would have different baseline prevalences in the model.\n\nBy default, the `Matern` function has no nugget effect, but we can add one by specifying a non-zero `Nugget` in the initial parameter list `init`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-75_dbd5d25ae78a3c934126be892144af99'}\n\n```{.r .cell-code}\nmod_spamm2 <- fitme(pos ~ netuse + phc + Matern(1 | x + y),\n data = gambia, family = binomial, fixed = list(nu = 0.5),\n init = list(Nugget = 0.1))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nIncrease spaMM.options(separation_max=<.>) to at least 21 if you want to check separation (see 'help(separation)').\n```\n:::\n\n```{.r .cell-code}\nsummary(mod_spamm2)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + Matern(1 | x + y)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.06861 0.3352 0.2047\nnetuse -0.51719 0.1407 -3.6757\nphc -0.44416 0.2052 -2.1648\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.nu 1.Nugget 1.rho \n0.50000000 0.23551027 0.05128692 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n x + y : 0.8399 \n# of obs: 2035; # of groups: x + y, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1197.968\n```\n:::\n:::\n\n\nAs you can see, all estimates are the same, except that the variance of the spatial portion (sill) is now 0.84 and the nugget is equal to a fraction 0.235 of that sill, so a variance of 0.197, which is the same as the `id_village` random effect in the version above. Thus the two formulations are equivalent.\n\nNow, recall the coefficients we obtained for the non-spatial GLMM:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-76_2ff7323dca01a1d9207ef38489d6b664'}\n\n```{.r .cell-code}\nsummary(mod_glmm)$coefficients\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 0.1490596 0.2296971 0.6489399 5.163772e-01\nnetuse -0.6043602 0.1442448 -4.1898243 2.791706e-05\nphc -0.4984835 0.2604083 -1.9142382 5.558973e-02\n```\n:::\n:::\n\n\nIn the spatial version, both fixed effects have moved slightly towards zero, but the standard error of the effect of `phc` has decreased. It is interesting that the inclusion of spatial dependence has allowed us to estimate more precisely the effect of having a public health centre in the village. This would not always be the case: for a predictor that is also strongly correlated in space, spatial correlation in the response makes it harder to estimate the effect of this predictor, since it is confounded with the spatial effect. However, for a predictor that is not correlated in space, including the spatial effect reduces the residual (non-spatial) variance and may thus increase the precision of the predictor's effect.\n\nThe *spaMM* package is also compatible with *DHARMa* for residual diagnostics. (You can in fact ignore the warning that it is not in the class of supported models, this is due to using the `fitme` function rather than a specific algorithm function in *spaMM*.)\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-77_435151fa87f7c6c10fa17fe4778779f0'}\n\n```{.r .cell-code}\nres_spamm <- simulateResiduals(mod_spamm2)\nplot(res_spamm)\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nplot(recalculateResiduals(res_spamm, group = gambia$id_village))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nFinally, while we will show how to make and visualize spatial predictions below, we can produce a quick map of the estimated spatial effects in a *spaMM* model with the `filled.mapMM` function.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-78_9aa73f93f8884bdd0fab5e2e18929e73'}\n\n```{.r .cell-code}\nfilled.mapMM(mod_spamm2)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n## Gaussian process models vs. smoothing splines\n\nIf you are familiar with generalized additive models (GAM), you might think that the spatial variation in malaria prevalence (as shown in the map above) could be represented by a 2D smoothing spline (as a function of $x$ and $y$) within a GAM.\n\nThe code below fits the GAM equivalent of our Gaussian process GLMM above with the `gam` function in the *mgcv* package. The spatial effect is represented by the 2D spline `s(x, y)` whereas the non-spatial random effect of village is represented by `s(id_village, bs = \"re\")`, which is the same as `(1 | id_village)` in the previous models. Note that for the `gam` function, categorical variables must be explicitly converted to factors.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-79_ae40737239f2e38abf88e2861e3870b5'}\n\n```{.r .cell-code}\nlibrary(mgcv)\ngambia$id_village <- as.factor(gambia$id_village)\nmod_gam <- gam(pos ~ netuse + phc + s(id_village, bs = \"re\") + s(x, y), \n data = gambia, family = binomial)\n```\n:::\n\n\nTo visualize the 2D spline, we will use the [*gratia* package](https://fromthebottomoftheheap.net/2018/10/23/introducing-gratia/).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-80_d5c74c6f14896719f6bab59691ffa563'}\n\n```{.r .cell-code}\nlibrary(gratia)\ndraw(mod_gam)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNote that the plot of the spline `s(x, y)` (top right) does not extend too far from the locations of the data (other areas are blank). In this graph, we can also see that the village random effects follow the expected Gaussian distribution (top left).\n\nNext, we will use both the spatial GLMM from the previous section and this GAMM to predict the mean prevalence on a spatial grid of points contained in the file [gambia_pred.csv](data/gambia_pred.csv). The graph below adds those prediction points (in black) on the previous map of the data points.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-81_29ad1d87f053e7c4195d592da7d54ff1'}\n\n```{.r .cell-code}\ngambia_pred <- read.csv(\"data/gambia_pred.csv\")\n\nggplot(gambia_agg, aes(x = x, y = y)) +\n geom_point(data = gambia_pred) +\n geom_point(aes(color = prev)) +\n geom_path(data = gambia.borders, aes(x = x / 1000, y = y / 1000)) +\n coord_fixed() +\n theme_minimal() +\n scale_color_viridis_c()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nTo make predictions from the GAMM model at those points, the code below goes through the following steps:\n\n- All predictors in the model must be in the prediction data frame, so we add constant values of *netuse* and *phc* (both equal to 1) for all points. Thus, we will make predictions of malaria prevalence in the case where a net is used and a public health centre is present. We also add a constant *id_village*, although it will not be used in predictions (see below).\n\n- We call the `predict` function on the output of `gam` to produce predictions at the new data points (argument `newdata`), including standard errors (`se.fit = TRUE`) and excluding the village random effects, so the prediction is made for an \"average village\". The resulting object `gam_pred` will have columns `fit` (mean prediction) and `se.fit` (standard error). Those predictions and standard errors are on the link (logit) scale.\n\n- We add the original prediction data frame to `gam_pred` with `cbind`.\n\n- We add columns for the mean prediction and 50% confidence interval boundaries (mean $\\pm$ 0.674 standard error), converted from the logit scale to the probability scale with `plogis`. We choose a 50% interval since a 95% interval may be too wide here to contrast the different predictions on the map at the end of this section.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-82_a655e5eb759da0f74f34c89ed61d58a2'}\n\n```{.r .cell-code}\ngambia_pred <- mutate(gambia_pred, netuse = 1, phc = 1, id_village = 1)\n\ngam_pred <- predict(mod_gam, newdata = gambia_pred, se.fit = TRUE, \n exclude = \"s(id_village)\")\ngam_pred <- cbind(gambia_pred, as.data.frame(gam_pred))\ngam_pred <- mutate(gam_pred, pred = plogis(fit), \n lo = plogis(fit - 0.674 * se.fit), # 50% CI\n hi = plogis(fit + 0.674 * se.fit))\n```\n:::\n\n\n*Note*: The reason we do not make predictions directly on the probability (response) scale is that the normal formula for confidence intervals applies more accurately on the logit scale. Adding a certain number of standard errors around the mean on the probability scale would lead to less accurate intervals and maybe even confidence intervals outside the possible range (0, 1) for a probability.\n\nWe apply the same strategy to make predictions from the *spaMM* spatial GLMM model. There are a few differences in the `predict` method compared with the GAMM case.\n\n- The argument `binding = \"fit\"` means that mean predictions (`fit` column) will be attached to the prediction dataset and returned as `spamm_pred`.\n\n- The `variances = list(linPred = TRUE)` tells `predict` to calculate the variance of the linear predictor (so the square of the standard error). However, it appears as an attribute `predVar` in the output data frame rather than a `se.fit` column, so we move it to a column on the next line.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-83_8466cc239c165bb619c3ec38ce8db16a'}\n\n```{.r .cell-code}\nspamm_pred <- predict(mod_spamm, newdata = gambia_pred, type = \"link\",\n binding = \"fit\", variances = list(linPred = TRUE))\nspamm_pred$se.fit <- sqrt(attr(spamm_pred, \"predVar\"))\nspamm_pred <- mutate(spamm_pred, pred = plogis(fit), \n lo = plogis(fit - 0.674 * se.fit),\n hi = plogis(fit + 0.674 * se.fit))\n```\n:::\n\n\nFinally, we combine both sets of predictions as different rows of a `pred_all` dataset with `bind_rows`. The name of the dataset each prediction originates from (`gam` or `spamm`) will appear in the \"model\" column (argument `.id`). To simplify production of the next plot, we then use `pivot_longer` in the *tidyr* package to change the three columns \"pred\", \"lo\" and \"hi\" to two columns, \"stat\" and \"value\" (`pred_tall` has thus three rows for every row in `pred_all`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-84_7a8a967d3486a1ba90686ccd4eede914'}\n\n```{.r .cell-code}\npred_all <- bind_rows(gam = gam_pred, spamm = spamm_pred, .id = \"model\")\n\nlibrary(tidyr)\npred_tall <- pivot_longer(pred_all, c(pred, lo, hi), names_to = \"stat\",\n values_to = \"value\")\n```\n:::\n\n\nHaving done these steps, we can finally look at the prediction maps (mean, lower and upper bounds of the 50% confidence interval) with `ggplot`. The original data points are shown in red.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-85_31003401bd646a7f13b4009bc478ce83'}\n\n```{.r .cell-code}\nggplot(pred_tall, aes(x = x, y = y)) +\n geom_point(aes(color = value)) +\n geom_point(data = gambia_agg, color = \"red\", size = 0) +\n coord_fixed() +\n facet_grid(stat~model) +\n scale_color_viridis_c() +\n theme_minimal()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nWhile both models agree that there is a higher prevalence near the eastern cluster of villages, the GAMM also estimates a higher prevalence at a few points (western edge and around the center) where there is no data. This is an artifact of the shape of the spline fit around the data points, since a spline is meant to fit a global, although nonlinear, trend. In contrast, the geostatistical model represents the spatial effect as local correlations and reverts to the overall mean prevalence when far from any data points, which is a safer assumption. This is one reason to choose a geostatistical / Gaussian process model in this case.\n\n## Bayesian methods for GLMMs with Gaussian processes\n\nBayesian models provide a flexible framework to express models with complex dependence structure among the data, including spatial dependence. However, fitting a Gaussian process model with a fully Bayesian approach can be slow, due the need to compute a spatial covariance matrix between all point pairs at each iteration.\n\nThe INLA (integrated nested Laplace approximation) method performs an approximate calculation of the Bayesian posterior distribution, which makes it suitable for spatial regression problems. We do not cover it in this course, but I recommend the textbook by Paula Moraga (in the references section below) that provides worked examples of using INLA for various geostatistical and areal data models, in the context of epidemiology, including models with both space and time dependence. The book presents the same Gambia malaria data as an example of a geostatistical dataset, which inspired its use in this course.\n\n# GLMM with spatial autoregression {#glmm-spatial-autoreg}\n\nWe return to the last example of the previous part, where we modelled the rate of COVID-19 cases (cases / 1000) for administrative health network divisions (RLS) in Quebec as a function of their population density. The rate is given by the \"taux_1k\" column in the `rls_covid` shapefile.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-86_dee7e0520a18d70a7e5f70f91e7f0d0a'}\n\n```{.r .cell-code}\nlibrary(sf)\nrls_covid <- read_sf(\"data/rls_covid.shp\")\nrls_covid <- rls_covid[!is.na(rls_covid$dens_pop), ]\nplot(rls_covid[\"taux_1k\"])\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nPreviously, we modelled the logarithm of this rate as a linear function of the logarithm of population density, with the residual variance correlated among neighbouring units via a CAR (conditional autoregression) structure, as shown in the code below.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-87_51a48c9cba07b64df6887bc1c93140b3'}\n\n```{.r .cell-code}\nlibrary(spdep)\nlibrary(spatialreg)\n\nrls_nb <- poly2nb(rls_covid)\nrls_w <- nb2listw(rls_nb, style = \"B\")\n\ncar_lm <- spautolm(log(taux_1k) ~ log(dens_pop), data = rls_covid,\n listw = rls_w, family = \"CAR\")\nsummary(car_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = log(taux_1k) ~ log(dens_pop), data = rls_covid, \n listw = rls_w, family = \"CAR\")\n\nResiduals:\n Min 1Q Median 3Q Max \n-1.201858 -0.254084 -0.053348 0.281482 1.427053 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 1.702068 0.168463 10.1035 < 2.2e-16\nlog(dens_pop) 0.206623 0.032848 6.2903 3.169e-10\n\nLambda: 0.15762 LR test value: 23.991 p-value: 9.6771e-07 \nNumerical Hessian standard error of lambda: 0.0050486 \n\nLog likelihood: -80.68953 \nML residual variance (sigma squared): 0.2814, (sigma: 0.53048)\nNumber of observations: 95 \nNumber of parameters estimated: 4 \nAIC: 169.38\n```\n:::\n:::\n\n\nAs a reminder, the `poly2nb` function in the *spdep* package creates a list of neighbours based on bordering polygons in a shapefile, then the `nb2listw` converts it to a list of weights, here binary weights (`style = \"B\"`) so that each bordering region receives the same weight of 1 in the autoregressive model.\n\nInstead of using the rates, it would be possible to model the cases directly (column \"cas\" in the dataset) with a Poisson regression, which is appropriate for count data. To account for the fact that if the risk per person were equal, cases would be proportional to population, we can add the unit's population `pop` as an *offset* in the Poisson regression. Therefore, the model would look like: `cas ~ log(dens_pop) + offset(log(pop))`. Note that since the Poisson regression uses a logarithmic link, that model with `log(pop)` as an offset assumes that `log(cas / pop)` (so the log rate) is proportional to `log(dens_pop)`, just like the linear model above, but it has the advantage of modelling the stochasticity of the raw data (the number of cases) directly with a Poisson distribution.\n\nWe do not have the population in this data, but we can estimate it from the cases and the rate (cases / 1000) as follows:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-88_dd571339361d6d0f00653ec574a812b8'}\n\n```{.r .cell-code}\nrls_covid$pop <- rls_covid$cas / rls_covid$taux_1k * 1000\n```\n:::\n\n\nTo define a CAR model in *spaMM*, we need a weights matrix rather than a list of weights as in the *spatialreg* package. Fortunately, the *spdep* package also includes a function `nb2mat` to convert the neighbours list to a matrix of weights, here again using binary weights. To avoid a warning, we specify the row and column names of that matrix to be equal to the IDs associated with each unit (`RLS_code`). Then, we add a term `adjacency(1 | RLS_code)` to the model to specify that the residual variation between different groups defined by `RLS_code` is spatially correlated with a CAR structure (here, each group has only one observation since we have one data point by RLS unit).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-89_96e9784ebad8d38cbd211f444a330b0c'}\n\n```{.r .cell-code}\nlibrary(spaMM)\n\nrls_mat <- nb2mat(rls_nb, style = \"B\")\nrownames(rls_mat) <- rls_covid$RLS_code\ncolnames(rls_mat) <- rls_covid$RLS_code\n\nrls_spamm <- fitme(cas ~ log(dens_pop) + offset(log(pop)) + adjacency(1 | RLS_code),\n data = rls_covid, adjMatrix = rls_mat, family = poisson)\nsummary(rls_spamm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: cas ~ log(dens_pop) + offset(log(pop)) + adjacency(1 | RLS_code)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: poisson( link = log ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) -5.1618 0.16855 -30.625\nlog(dens_pop) 0.1999 0.03267 6.119\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.rho \n0.1576605 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n RLS_code : 0.266 \n# of obs: 95; # of groups: RLS_code, 95 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -709.3234\n```\n:::\n:::\n\n\nNote that the spatial correlation coefficient `rho` (0.158) is similar to the equivalent quantity in the `spautolm` model above, where it was called `Lambda`. The effect of `log(dens_pop)` is also approximately 0.2 in both models.\n\n## Reference\n\nMoraga, Paula (2019) Geospatial Health Data: Modeling and Visualization with R-INLA and Shiny. Chapman & Hall/CRC Biostatistics Series. Available online at .\n\n------------------------------------------------------------------------\n\n# Statistiques spatiales en écologie {#statistiques-spatiales-en-écologie}\n\nBIOS² a organisé une session de formation en ligne sur l'analyse statistique des données spatiales en écologie, animée par le Pr. Philippe Marchand (UQAT). Cette formation de 12 heures s'est déroulée en 4 sessions : 12, 14, 19 & 21 janvier (2021) de 13h00 à 16h00 HNE.\n\nLe contenu comprenait trois types d'analyses statistiques spatiales et leurs applications en écologie : (1) l'analyse des patrons de points qui permet d'étudier la distribution d'individus ou d'événements dans l'espace; (2) les modèles géostatistiques qui représentent la corrélation spatiale de variables échantillonnées à des points géoréférencés; et (3) les modèles de données aréales, qui s'appliquent aux mesures prises sur des régions de l'espace et qui représentent les liens spatiaux par le biais de réseaux de voisinage. La formation comprenait également des exercices pratiques utilisant l'environnement de programmation statistique R.\n\n[Philippe Marchand](https://github.com/pmarchand1) est professeur d'écologie et de biostatistique à l'Institut de recherche sur les forêts, Université du Québec en Abitibi-Témiscamingue (UQAT) et membre académique de BIOS². Ses travaux de recherche portent sur la modélisation de processus qui influencent la distribution spatiale des populations, incluant: la dispersion des graines et l'établissement des semis, le mouvement des animaux, et la propagation des épidémies forestières.\n\n**Si vous souhaitez consulter le matériel pédagogique et suivre les exercices à votre propre rythme, vous pouvez y accéder par [ce lien](https://bios2.github.io/Marchand.html#category:FR). Une connaissance de base des modèles de régression linéaire et une expérience de l'ajustement de ces modèles dans R sont recommandées. Le repositoire original se trouve [ici](https://github.com/pmarchand1/BIOS2-spatial-stats).**\n\n## Plan du cours\n\n| Jour | Sujets | \n|-----------------|:--------------------------|\n| 1 | • [Introduction aux statistiques spatiales](#introduction-fr) • [Analyse des patrons de points](#point-pattern-fr) |\n| 2 | • [Corrélation spatiale d'une variable](#spatial-correlation-fr) • [Modèles géostatistiques](#geostat-models-fr) | \n| 3 | • [Données aréales](#areal-data-fr) • [Indice de Moran](#moran-i-fr) • [Modèles d'autorégression spatiale](#spatial-autoreg-fr) • [Analyse des données aréales dans R](#analysis-areal-fr) |\n| 4 | • [GLMM avec processus spatial gaussien](#glmm-spatial-gaussian-fr) • [GLMM avec autorégression spatiale](#glmm-spatial-autoreg-fr)| \n\n# Introduction aux statistiques spatiales {#introduction-fr}\n\n## Types d'analyses spatiales\n\nDans le cadre de cette formation, nous discuterons de trois types d'analyses spatiales: l'analyse des patrons de points, les modèles géostatistiques et les modèles de données aréales.\n\nDans l'**analyse des patrons de points**, nous avons des données ponctuelles représentant la position d'individus ou d'événements dans une région d'étude et nous supposons que tous les individus ou événements ont été recensés dans cette région. Cette analyse s'intéresse à la distribution des positions des points eux-mêmes. Voici quelques questions typiques de l'analyse des patrons de points:\n\n- Les points sont-ils disposés aléatoirement ou agglomérés?\n\n- Deux types de points sont-ils disposés indépendamment?\n\nLes **modèles géostatistiques** visent à représenter la distribution spatiale de variables continues qui sont mesurés à certains points d'échantillonnage. Ils supposent que les mesures de ces variables à différents points sont corrélées en fonction de la distance entre ces points. Parmi les applications des modèles géostatistiques, notons le lissage des données spatiales (ex.: produire une carte d'une variable sur l'ensemble d'une région en fonction des mesures ponctuelles) et la prédiction de ces variables pour des points non-échantillonnés.\n\nLes **données aréales** sont des mesures prises non pas à des points, mais pour des régions de l'espace représentées par des polygones (ex.: divisions du territoire, cellules d'une grille). Les modèles représentant ces types de données définissent un réseau de voisinage reliant les régions et incluent une corrélation spatiale entre régions voisines. \n\n## Stationnarité et isotropie\n\nPlusieurs analyses spatiales supposent que les variables sont **stationnaires** dans l'espace. Comme pour la stationnarité dans le domaine temporel, cette propriété signifie que les statistiques sommaires (moyenne, variance et corrélations entre mesures d'une variable) ne varient pas avec une translation dans l'espace. Par exemple, la corrélation spatiale entre deux points peut dépendre de la distance les séparant, mais pas de leur position absolue.\n\nEn particulier, il ne peut pas y avoir de tendance à grande échelle (souvent appelée *gradient* dans un contexte spatial), ou bien cette tendance doit être prise en compte afin de modéliser la corrélation spatiale des résidus.\n\nDans le cas de l'analyse des patrons de points, la stationnarité (aussi appelée homogénéité dans ce contexte) signifie que la densité des points ne suit pas de tendance à grande échelle.\n\nDans un modèle statistique **isotropique**, les corrélations spatiales entre les mesures à deux points dépendent seulement de la distance entre ces points, pas de la direction. Dans ce cas, les statistiques sommaires ne varient pas si on effectue une rotation dans l'espace.\n\n## Données géoréférencées\n\nLes études environnementales utilisent de plus en plus de données provenant de sources de données géospatiales, c'est-à-dire des variables mesurées sur une grande partie du globe (ex.: climat, télédétection). Le traitement de ces données requiert des concepts liés aux systèmes d'information géographique (SIG), qui ne sont pas couverts dans cet atelier, alors que nous nous concentrons sur les aspects statistiques de données variant dans l'espace.\n\nL'utilisation de données géospatiales ne signifie pas nécessairement qu'il faut avoir recours à des statistiques spatiales. Par exemple, il est courant d'extraire les valeurs de ces variables géographiques à des points d'étude pour expliquer une réponse biologique observée sur le terrain. Dans ce cas, l'utilisation de statistiques spatiales est seulement nécessaire en présence d'une corrélation spatiale dans les résidus, après avoir tenu compte de l'effet des prédicteurs.\n\n\n# Analyse des patrons de points {#point-pattern-fr}\n\n## Patron de points et processus ponctuel\n\nUn patron de points (*point pattern*) décrit la position spatiale (le plus souvent en 2D) d'individus ou d'événements, représentés par des points, dans une aire d'étude donnée, souvent appelée la *fenêtre* d'observation. \n\nOn suppose que chaque point a une étendue spatiale négligeable par rapport aux distances entre les points. Des méthodes plus complexes existent pour traiter des patrons spatiaux d'objets qui ont une largeur non-néligeable, mais ce sujet dépasse la portée de cet atelier.\n\nUn processus ponctuel (*point process*) est un modèle statistique qui peut être utilisé pour simuler des patrons de points ou expliquer un patron de points observé.\n\n## Structure spatiale totalement aléatoire\n\nUne structure spatiale totalement aléatoire (*complete spatial randomness*) est un des patrons les plus simples, qui sert de modèle nul pour évaluer les caractéristiques de patrons de points réels. Dans ce patron, la présence d'un point à une position donnée est indépendante de la présence de points dans un voisinage. \n\nLe processus créant ce patron est un processus de Poisson homogène. Selon ce modèle, le nombre de points dans toute région de superficie $A$ suit une distribution de Poisson: $N(A) \\sim \\text{Pois}(\\lambda A)$, où $\\lambda$ est l'*intensité* du processus (i.e. la densité de points). $N$ est indépendant entre deux régions disjointes, peu importe comment ces régions sont définies.\n\nDans le graphique ci-dessous, seul le patron à droite est totalement aléatoire. Le patron à gauche montre une agrégation des points (probabilité plus grande d'observer un point si on est à proximité d'un autre point), tandis que le patron du centre montre une répulsion (faible probabilité d'observer un point très près d'un autre).\n\n\n\n\n::: {.cell fig.dim='[9,3]' hash='index_cache/html/unnamed-chunk-91_adc67cb15e035b62bde9aae5a2aa1217'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\n## Analyse exploratoire ou inférentielle pour un patron de points\n\nPlusieurs statistiques sommaires sont utilisées pour décrire les caractéristiques un patron de points. La plus simple est l'**intensité** $\\lambda$, qui comme mentionné plus haut représente la densité de points par unité de surface. Si le patron de points est hétérogène, l'intensité n'est pas constante, mais dépend de la position: $\\lambda(x, y)$.\n\nPar rapport à l'intensité qui est une statistique dite de premier ordre, les statistiques de second ordre décrivent comment la probabilité de présence d'un point dans une région dépend de la présence d'autres points. L'indice $K$ de Ripley présenté dans la prochaine section est un exemple de statistique sommaire de second ordre.\n\nLes inférences statistiques réalisées sur des patrons de points consistent habituellement à tester l'hypothèse que le patron de points correspond à un modèle nul donné, par exemple une structure spatiale totalement aléatoire, ou un modèle nul plus complexe. Même pour les modèles nuls les plus simples, nous connaissons rarement la distribution théorique pour une statistique sommaire du patron de points sous le modèle nul. Les tests d'hypothèses sur les patrons de points sont donc réalisés par simulation: on simule un grand nombre de patrons de points à partir du modèle nul et on compare la distribution des statistiques sommaires qui nous intéressent pour ces simulations à la valeur des statistiques pour le patron de points observé.\n\n## Indice $K$ de Ripley\n\nL'indice de Ripley $K(r)$ est défini comme le nombre moyen de points se trouvant dans un cercle de rayon $r$ donné autour d'un point du patron, normalisé par l'intensité $\\lambda$. \n\nPour un patron totalement aléatoire, le nombre moyen de points dans un cercle de rayon $r$ est $\\lambda \\pi r^2$, donc en théorie $K(r) = \\pi r^2$ pour ce modèle nul. Une valeur de $K(r)$ supérieure signifie qu'il y a agrégation des points à l'échelle $r$, tandis qu'une valeur inférieure signifie qu'il y a une répulsion.\n\nEn pratique, $K(r)$ est estimé pour un patron de points donné par l'équation:\n\n$$ K(r) = \\frac{A}{n(n-1)} \\sum_i \\sum_{j > i} I \\left( d_{ij} \\le r \\right) w_{ij}$$\n\noù $A$ est l'aire de la fenêtre d'observation et $n$ est le nombre de points du patron, donc $n(n-1)$ est le nombre de paires de points distinctes. On fait la somme pour toutes les paires de points de la fonction indicatrice $I$, qui prend une valeur de 1 si la distance entre les points $i$ et $j$ est inférieure ou égale à $r$. Finalement, le terme $w_{ij}$ permet de donner un poids supplémentaire à certaines paires de points pour tenir compte des effets de bordure, tel que discuté dans la section suivante.\n\nPar exemple, les graphiques ci-dessous présentent la fonction estimée $K(r)$ pour les patrons illustrés ci-dessus, pour des valeurs de $r$ allant jusqu'à 1/4 de la largeur de la fenêtre. La courbe pointillée rouge indique la valeur théorique pour une structure spatiale totalement aléatoire et la zone grise est une \"enveloppe\" produite par 99 simulations de ce modèle nul. Le patron agrégé montre un excès de voisins jusqu'à $r = 0.25$ et le patron avec répulsion montre un déficit significatif de voisins pour les petites valeurs de $r$. \n\n\n\n\n::: {.cell fig.dim='[9,3]' hash='index_cache/html/unnamed-chunk-93_6abeb25aeaeb61368f985f60bb26c046'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\nOutre le $K$, il existe d'autres statistiques pour décrire les propriétés de second ordre du patron, par exemple la distance moyenne entre un point et ses $N$ plus proches voisins. Vous pouvez consulter le manuel de Wiegand et Moloney (2013) suggéré en référence pour en apprendre plus sur différentes statistiques sommaires des patrons de points.\n\n## Effets de bordure\n\nDans le contexte de l'analyse de patrons de points, l'effet de bordure (\"edge effect\") est dû au fait que nous avons une connaissance incomplète du voisinage des points près du bord de la fenêtre d'observation, ce qui peut induire un biais dans le calcul des statistiques comme le $K$ de Ripley. \n\nDifférentes méthodes ont été développées pour corriger le biais dû aux effets de bordure. Selon la méthode de Ripley, la contribution d'un voisin $j$ situé à une distance $r$ d'un point $i$ reçoit un poids $w_{ij} = 1/\\phi_i(r)$, où $\\phi_i(r)$ est la fraction du cercle de rayon $r$ autour de $i$ contenu dans la fenêtre d'observation. Par exemple, si 2/3 du cercle se trouve dans la fenêtre, ce voisin compte pour 3/2 voisins dans le calcul d'une statistique comme $K$.\n\n\n\nLa méthode de Ripley est une des plus simples pour corriger les effets de bordure, mais n'est pas nécessairement la plus efficace; notamment, les poids plus grands donnés à certaines paires de points tend à accroître la variance du calcul de la statistique. D'autres méthodes de correction sont présentées dans les manuels spécialisés, comme celui de Wiegand et Moloney (2013) en référence.\n\n## Exemple\n\nPour cet exemple, nous utilisons le jeu de données [semis_xy.csv](data/semis_xy.csv), qui représente les coordonnées $(x, y)$ de semis de deux espèces (*sp*, B = bouleau et P = peuplier) dans une placette de 15 x 15 m.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-94_327e5e9e3c1899c6fc6b1fb294f06e68'}\n\n```{.r .cell-code}\nsemis <- read.csv(\"data/semis_xy.csv\")\nhead(semis)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n x y sp\n1 14.73 0.05 P\n2 14.72 1.71 P\n3 14.31 2.06 P\n4 14.16 2.64 P\n5 14.12 4.15 B\n6 9.88 4.08 B\n```\n:::\n:::\n\n\nLe package *spatstat* permet d'effectuer des analyses de patrons de point dans R. La première étape consiste à transformer notre tableau de données en objet `ppp` (patron de points) avec la fonction du même nom. Dans cette fonction, nous spécifions quelles colonnes contiennent les coordonnées *x* et *y* ainsi que les marques (`marks`), qui seront ici les codes d'espèce. Il faut aussi spécifier une fenêtre d'observation (`window`) à l'aide de la fonction `owin`, à laquelle nous indiquons les limites de la placette en *x* et *y*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-95_e246a905ab0e728b8bebd2e4c7effcef'}\n\n```{.r .cell-code}\nlibrary(spatstat)\n\nsemis <- ppp(x = semis$x, y = semis$y, marks = as.factor(semis$sp),\n window = owin(xrange = c(0, 15), yrange = c(0, 15)))\nsemis\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nMarked planar point pattern: 281 points\nMultitype, with levels = B, P \nwindow: rectangle = [0, 15] x [0, 15] units\n```\n:::\n:::\n\n\nLes marques peuvent être numériques ou catégorielles. Notez que pour des marques catégorielles comme c'est le cas ici, il faut convertir explicitement la variable en facteur.\n\nLa fonction `plot` appliquée à un patron de points montre un diagramme du patron.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-96_96d77aa12e04c69ed21ee84e297dba59'}\n\n```{.r .cell-code}\nplot(semis)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLa fonction `intensity` calcule la densité des points de chaque espèce par unité de surface, ici en $m^2$.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-97_beac65d0093c1448eec5b7873eb79e0b'}\n\n```{.r .cell-code}\nintensity(semis)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n B P \n0.6666667 0.5822222 \n```\n:::\n:::\n\n\nPour analyser d'abord séparément la distribution de chaque espèce, nous séparons le patron avec `split`. Puisque le patron contient des marques catégorielles, la séparation se fait automatiquement en fonction de la valeur des marques. Le résultat est une liste de deux patrons de points.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-98_b03959fb9ef2a14b73c3512a12d3e227'}\n\n```{.r .cell-code}\nsemis_split <- split(semis)\nplot(semis_split)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLa fonction `Kest` calcule le $K$ de Ripley pour une série de distances allant (par défaut) jusqu'à 1/4 de la largeur de la fenêtre. Ici, nous l'appliquons au premier patron (bouleau) en choisissant `semis_split[[1]]`. Notez que les doubles crochets sont nécessaires pour choisir un élément d'une liste dans R.\n\nL'argument `correction = \"iso\"` indique d'appliquer la méthode de Ripley pour corriger les effets de bordure.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-99_181444d1e19a264175dc77ad57d2d3d0'}\n\n```{.r .cell-code}\nk <- Kest(semis_split[[1]], correction = \"iso\")\nplot(k)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nSelon ce graphique, il semble y avoir une excès de voisins à partir d'un rayon de 1 m. Pour vérifier s'il s'agit d'un écart significatif, nous produisons une enveloppe de simulation avec la fonction `envelope`. Le permier argument d'`envelope` est un patron de point auquel les simulations seront comparées, le deuxième une fonction à calculer (ici, `Kest`) pour chaque patron simulé, puis on y ajoute les arguments de la fonction `Kest` (ici, seulement `correction`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-100_c8ef12d95e636626e72d894b8455cc8e'}\n\n```{.r .cell-code}\nplot(envelope(semis_split[[1]], Kest, correction = \"iso\"))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 99 simulations of CSR ...\n1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,\n41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,\n81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nTel qu'indiqué par le message, cette fonction effectue par défaut 99 simulations de l'hypothèse nulle correspondant à une structure spatiale totalement aléatoire (CSR, pour *complete spatial randomness*).\n\nLa courbe observée sort de l'enveloppe des 99 simulations près de $r = 2$. Il faut être prudent de ne pas interpréter trop rapidement un résultat sortant de l'enveloppe. Même s'il y a environ une probabilité de 1% d'obtenir un résultat plus extrême selon l'hypothèse nulle à une distance donnée, l'enveloppe est calculée pour un grand nombre de valeurs de la distance et nous n'effectuons pas de correction pour les comparaisons multiples. Ainsi, un écart significatif pour une très petite plage de valeurs de $r$ peut être simplement dû au hasard.\n\n\n### Exercice 1\n\nEn regardant le graphique du deuxième patron de points (semis de peuplier), pouvez-vous prédire où se situera le $K$ de Ripley par rapport à l'hypothèse nulle d'une structure spatiale totalement aléatoire? Vérifiez votre prédiction en calculant le $K$ de Ripley pour ce patron de points dans R.\n\n\n## Effet de l'hétérogénéité\n\nLe graphique ci-dessous illustre un patron de points *hétérogène*, c'est-à-dire qu'il présente un gradient d'intensité (plus de points à gauche qu'à droite).\n\n\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-102_4f8ece21b321a6bc37f12ea916525a4e'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nUn gradient de densité peut être confondu avec une agrégation des points, comme on peut voir sur le graphique du $K$ de Ripley correspondant. En théorie, il s'agit de deux processus différents:\n\n- Hétérogénéité: La densité de points varie dans la région d'étude, par exemple dû au fait que certaines conditions locales sont plus propices à la présence de l'espèce étudiée.\n\n- Agrégation: La densité moyenne des points est homogène, mais la présence d'un point augmente la présence d'autre points dans son voisinage, par exemple en raison d'interactions positives entre les individus.\n\nCependant, il peut être difficile de différencier les deux en pratique, surtout que certains patrons peuvent être à la fois hétérogènes et agrégés.\n\nPrenons l'exemple des semis de peuplier de l'exercice précédent. La fonction `density` appliquée à un patron de points effectue une estimation par noyau (*kernel density estimation*) de la densité des semis à travers la placette. Par défaut, cette fonction utilise un noyau gaussien avec un écart-type `sigma` spécifié dans la fonction, qui détermine l'échelle à laquelle les fluctuations de densité sont \"lissées\". Ici, nous utilisons une valeur de 2 m pour `sigma` et nous représentons d'abord la densité estimée avec `plot`, avant d'y superposer les points (`add = TRUE` signifie que les points sont ajoutés au graphique existant plutôt que de créer un nouveau graphique).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-103_293155d4d47f9be8ba5f92c275edfe33'}\n\n```{.r .cell-code}\ndens_p <- density(semis_split[[2]], sigma = 2)\nplot(dens_p)\nplot(semis_split[[2]], add = TRUE)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nPour mesurer l'agrégation ou la répulsion des points d'un patron hétérogène, nous devons utilisé la version non-homogène de la statistique $K$ (`Kinhom` dans *spatstat*). Cette statistique est toujours égale au nombre moyen de voisins dans un rayon $r$ d'un point du patron, mais plutôt que de normaliser ce nombre par l'intensité globale du patron, il est normalisé par l'estimation locale de la densité de points. Comme ci-dessus, nous spécifions `sigma = 2` pour contrôler le niveau de lissage de l'estimation de la densité variable.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-104_2e7d6e77388db4c6cf95e3825468e730'}\n\n```{.r .cell-code}\nplot(Kinhom(semis_split[[2]], sigma = 2, correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEn tenant compte de l'hétérogénéité du patron à une échelle `sigma` de 2 m, il semble donc y avoir un déficit de voisins à partir d'environ 1.5 m des points du patron. Il reste à voir si cette déviation est significative.\n\nComme précédemment, nous utilisons `envelope` pour simuler la statistique `Kinhom` sous le modèle nul. Cependant, ici le modèle nul n'est pas un processus de Poisson homogène (structure spatiale totalement aléatoire). Il s'agit plutôt d'un processus de Poisson hétérogène simulé par la fonction `rpoispp(dens_p)`, c'est-à-dire que les points sont indépendants les uns des autres, mais leur densité est hétérogène et donnée par `dens_p`. L'argument `simulate` de la fonction `envelope` permet de spécifier une fonction utilisée pour les simulations sous le modèle nul; cette fonction doit avoir un argument, ici `x`, même s'il n'est pas utilisé.\n\nFinalement, en plus des arguments nécessaires pour `Kinhom`, soit `sigma` et `correction`, nous spécifions aussi `nsim = 199` pour réaliser 199 simulations et `nrank = 5` pour éliminer les 5 résultats les plus extrêmes de chaque côté de l'enveloppe, donc les 10 plus extrêmes sur 199, pour réaliser un intervalle contenant environ 95% de la probabilité sous l'hypothèse nulle.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-105_372339d2d2e016521c3700d91cc77898'}\n\n```{.r .cell-code}\nkhet_p <- envelope(semis_split[[2]], Kinhom, sigma = 2, correction = \"iso\",\n nsim = 199, nrank = 5, simulate = function(x) rpoispp(dens_p))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(khet_p)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n*Note*: Pour un test d'hypothèse basé sur des simulations d'une hypothèse nulle, la valeur $p$ est estimée par $(m + 1)/(n + 1)$, où $n$ est le nombre de simulations et $m$ est le nombre de simulations où la valeur de la statistique est plus extrême que celle des données observées. C'est pour cette raison qu'on choisit un nombre de simulations comme 99, 199, etc.\n\n### Exercice 2\n\nRépétez l'estimation de la densité hétérogène et le calcul de `Kinhom` avec un écart-type `sigma` de 5 plutôt que 2. Comment le niveau de lissage pour la densité influence-t-il les conclusions?\n\nPour différencier une variation de densité des points et d'une interaction (agrégation ou répulsion) entre ces points avec ce type d'analyse, il faut généralement supposer que les deux processus opèrent à différentes échelles. Typiquement, nous pouvons tester si les points sont agrégés à petite échelle après avoir tenu compte d'une variation de la densité à une échelle plus grande.\n\n\n## Relation entre deux patrons de points\n\nConsidérons un cas où nous avons deux patrons de points, par exemple la position des arbres de deux espèces dans une parcelle (points oranges et verts dans le graphique ci-dessous). Chacun des deux patrons peut présenter ou non des agrégations de points. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-106_a7d54ff1bdd2b3ad9381ec359732b6e9'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nSans égard à cette agrégation au niveau de l'espèce, nous voulons déterminer si les deux espèces sont disposées indépendamment. Autrement dit, la probabilité d'observer un arbre d'une espèce dépend-elle de la présence d'un arbre de l'autre espèce à une distance donnée?\n\nLa version bivariée du $K$ de Ripley permet de répondre à cette question. Pour deux patrons désignés 1 et 2, l'indice $K_{12}(r)$ calcule le nombre moyen de points du patron 2 dans un rayon $r$ autour d'un point du patron 1, normalisé par la densité du patron 2.\n\nEn théorie, cet indice est symétrique, donc $K_{12}(r) = K_{21}(r)$ et le résultat serait le même si on choisit les points du patron 1 ou 2 comme points \"focaux\" pour l'analyse. Cependant, l'estimation des deux quantités pour un patron observé peut différer, notamment en raison des effets de bord. La variabilité peut aussi être différente pour $K_{12}$ et $K_{21}$ entre les simulations d'un modèle nul, donc le test de l'hypothèse nulle peut avoir une puissance différente selon le choix de l'espèce focale.\n\nLe choix d'un modèle nul approprié est important ici. Afin de déterminer s'il existe une attraction ou une répulsion significative entre les deux patrons, il faut déplacer aléatoirement la position d'un des patrons relative à celle de l'autre patron, tout en conservant la structure spatiale de chaque patron pris isolément.\n\nUne des façons d'effectuer cette randomisation consiste à décaler l'un des deux patrons horizontalement et/ou verticalement d'une distance aléatoire. La partie du patron qui \"sort\" d'un côté de la fenêtre est rattachée de l'autre côté. Cette méthode s'appelle une translation toroïdale (*toroidal shift*), car en connectant le haut et le bas ainsi que la gauche et la droite d'une surface rectangulaire, on obtient la forme d'un tore (un \"beigne\" en trois dimensions).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-107_1757cb541cf05d572ea82ab56ed6f90e'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLe graphique ci-dessus illustre une translation du patron vert vers la droite, tandis que le patron orange reste au même endroit. Les points verts dans la zone ombragée sont ramenés de l'autre côté. Notez que si cette méthode préserve de façon générale la structure de chaque patron tout en randomisant leur position relative, elle peut comporter certains inconvénients, comme de diviser des amas de points qui se trouvent près du point de coupure.\n\nVérifions maintenant s'il y a une dépendance entre la position des deux espèces (bouleau et peuplier) dans notre placette. La fonction `Kcross` calcule l'indice bivarié $K_{ij}$, il faut spécifier quel type de point est considéré comme l'espèce focale $i$ et l'espèce voisine $j$.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-108_e1fb67c992e6fbc5436f40af7db13109'}\n\n```{.r .cell-code}\nplot(Kcross(semis, i = \"P\", j = \"B\", correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIci, le $K$ observé est inférieur à la valeur théorique, indiquant une répulsion possible des deux patrons.\n\nPour déterminer l'enveloppe du $K$ selon l'hypothèse nulle d'indépendance des deux patrons, nous devons spécifier que les simulations doivent être basées sur une translation des patrons. Nous indiquons que les simulations doivent utiliser la fonction `rshift` (translation aléatoire) avec l'argument `simulate = function(x) rshift(x, which = \"B\")`; ici, l'argument `x` de `simulate` correspond au patron de points original et l'argument `which` indique quel type de points subit la translation. Comme pour le cas précédent, il faut répéter dans la fonction `envelope` les arguments nécessaires pour `Kcross`, soit `i`, `j` et `correction`. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-109_727b1efb5e977942d084f00027cda511'}\n\n```{.r .cell-code}\nplot(envelope(semis, Kcross, i = \"P\", j = \"B\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = function(x) rshift(x, which = \"B\")))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIci, la courbe observée se situe totalement dans l'enveloppe, donc nous ne rejetons pas l'hypothèse nulle d'indépendance des deux patrons.\n\n### Questions\n\n1. Quelle raison pourrait justifier ici notre choix d'effectuer la translation des points du bouleau plutôt que du peuplier?\n\n2. Est-ce que les simulations générées par translation aléatoire constitueraient un bon modèle nul si les deux patrons étaient hétérogènes?\n\n\n## Patrons de points marqués\n\nLe jeu de données [fir.csv](data/fir.csv) contient les coordonnées $(x, y)$ de 822 sapins dans une placette d'un hectare et leur statut (A = vivant, D = mort) suivant une épidémie de tordeuse des bourgeons de l'épinette.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-110_b43d75059cee9e8f87a67abfa290388c'}\n\n```{.r .cell-code}\nfir <- read.csv(\"data/fir.csv\")\nhead(fir)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n x y status\n1 31.50 1.00 A\n2 85.25 30.75 D\n3 83.50 38.50 A\n4 84.00 37.75 A\n5 83.00 33.25 A\n6 33.25 0.25 A\n```\n:::\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-111_2327e6a3855266c0ba92a5eed5b7ce1a'}\n\n```{.r .cell-code}\nfir <- ppp(x = fir$x, y = fir$y, marks = as.factor(fir$status),\n window = owin(xrange = c(0, 100), yrange = c(0, 100)))\nplot(fir)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nSupposons que nous voulons vérifier si la mortalité des sapins est indépendante ou corrélée entre arbres rapprochés. En quoi cette question diffère-t-elle de l'exemple précédent où nous voulions savoir si la position des points de deux espèces était indépendante?\n\nDans l'exemple précédent, l'indépendance ou l'interaction entre les espèces référait à la formation du patron lui-même (que des semis d'une espèce s'établissent ou non à proximité de ceux de l'autre espèce). Ici, la caractéristique qui nous intéresse (survie des sapins) est postérieure à l'établissement du patron, en supposant que tous ces arbres étaient vivants d'abord et que certains sont morts suite à l'épidémie. Donc nous prenons la position des arbres comme fixe et nous voulons savoir si la distribution des statuts (mort, vivant) entre ces arbres est aléatoire ou présente un patron spatial.\n\nDans le manuel de Wiegand et Moloney, la première situation (établissement de semis de deux espèces) est appelé patron bivarié, donc il s'agit vraiment de deux patrons qui interagissent, tandis que la deuxième est un seul patron avec une *marque* qualitative. Le package *spatstat* dans R ne fait pas de différences entre les deux au niveau de la définition du patron (les types de points sont toujours représentés par l'argument `marks`), mais les méthodes d'analyse appliquées aux deux questions diffèrent.\n\nDans le cas d'un patron avec une marque qualitative, nous pouvons définir une fonction de connexion de marques (*mark connection function*) $p_{ij}(r)$. Pour deux points séparés par une distance $r$, cette fonction donne la probabilité que le premier point porte la marque $i$ et le deuxième la marque $j$. Selon l'hypothèse nulle où les marques sont indépendantes, cette probabilité est égale au produit des proportions de chaque marque dans le patron entier, $p_{ij}(r) = p_i p_j$ indépendamment de $r$.\n\nDans *spatstat*, la fonction de connexion de marques est calculée avec la fonction `markconnect`, où il faut spécifier les marques $i$ et $j$ ainsi que le type de correction des effets de bord. Dans notre exemple, nous voyons que deux points rapprochés ont moins de chance d'avoir une statut différent (A et D) que prévu selon l'hypothèse de distribution aléatoire et indépendante des marques (ligne rouge pointillée).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-112_e925b891841588727659504a7a0c6e6d'}\n\n```{.r .cell-code}\nplot(markconnect(fir, i = \"A\", j = \"D\", correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nDans ce graphique, les ondulations dans la fonction sont dues à l'erreur d'estimation d'une fonction continue de $r$ à partir d'un nombre limité de paires de points discrètes.\n\nPour simuler le modèle nul dans ce cas-ci, nous utilisons la fonction `rlabel` qui réassigne aléatoirement les marques parmi les points du patron, en maintenant la position des points.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-113_41cb4b77111500454c477fbd4c96dd08'}\n\n```{.r .cell-code}\nplot(envelope(fir, markconnect, i = \"A\", j = \"D\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNotez que puisque la fonction `rlabel` a un seul argument obligatoire correspondant au patron de points original, il n'était pas nécessaire de spécifier au long: `simulate = function(x) rlabel(x)`.\n\nVoici les résultats pour les paires d'arbres du même statut A ou D:\n\n\n::: {.cell fig.dim='[10,5]' hash='index_cache/html/unnamed-chunk-114_2a3fc9a64a69a67d1266f0273c3bb85c'}\n\n```{.r .cell-code}\npar(mfrow = c(1, 2))\nplot(envelope(fir, markconnect, i = \"A\", j = \"A\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(envelope(fir, markconnect, i = \"D\", j = \"D\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=960}\n:::\n:::\n\n\nIl semble donc que la mortalité des sapins due à cette épidémie est agrégée spatialement, puisque les arbres situés à proximité l'un de l'autre ont une plus grande probabilité de partager le même statut que prévu par l'hypothèse nulle.\n\n## Références\n\nFortin, M.-J. et Dale, M.R.T. (2005) *Spatial Analysis: A Guide for Ecologists*. Cambridge University Press: Cambridge, UK. \n\nWiegand, T. et Moloney, K.A. (2013) *Handbook of Spatial Point-Pattern Analysis in Ecology*, CRC Press.\n\nLe jeu de données du dernier exemple est tiré des données de la Forêt d'enseignement et de recherche du Lac Duparquet (FERLD), disponibles sur Dryad en suivant [ce lien](https://doi.org/10.5061/dryad.tqjq2bvwz).\n\n\n# Solutions\n\n### Exercice 1\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-115_7bc8effd281fccbd2a1c1e21cd801493'}\n\n```{.r .cell-code}\nplot(envelope(semis_split[[2]], Kest, correction = \"iso\"))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 99 simulations of CSR ...\n1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,\n41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,\n81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLes semis de peuplier semblent significativement agrégés selon la valeur du $K$.\n\n### Exercice 2\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-116_53115f6ed07f7e0e4e7d2c8989998e70'}\n\n```{.r .cell-code}\ndens_p <- density(semis_split[[2]], sigma = 5)\nplot(dens_p)\nplot(semis_split[[2]], add = TRUE)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nkhet_p <- envelope(semis_split[[2]], Kinhom, sigma = 5, correction = \"iso\",\n nsim = 199, nrank = 5, simulate = function(x) rpoispp(dens_p))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(khet_p)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIci, puisque nous estimons la variation de densité à une plus grande échelle, même après avoir tenu compte de cette variation, les semis de peuplier semblent agrégés à petite échelle.\n\n\n# Corrélation spatiale d'une variable {#spatial-correlation-fr}\n\nLa corrélation entre les mesures d'une variable prises à des points rapprochés est une caractéristique dans de nombreux jeux de données. Ce principe est parfois appelé \"première loi de la géographie\" et exprimé par la citation de Waldo Tobler: \"Everything is related to everything else, but near things are more related than distant things.\" (Tout est relié, mais les choses rapprochées le sont davantage que celles éloignées).\n\nEn statistique, nous parlons souvent d'*autocorrélation* pour désigner la corrélation qui existe entre les mesures d'une même variable prises à différents moments (autocorrélation temporelle) ou différents lieux (autocorrélation spatiale).\n\n## Dépendance intrinsèque ou induite\n\nIl existe deux types fondamentaux de dépendance spatiale sur une variable mesurée $y$: une dépendance *intrinsèque* à $y$, ou une dépendance *induite* par des variables externes influençant $y$, qui sont elles-mêmes corrélées dans l'espace.\n\nPar exemple, supposons que l'abondance d'une espèce soit corrélée entre deux sites rapprochés:\n\n- cette dépendance spatiale peut être induite si elle est due à une corrélation spatiale des facteurs d'habitat qui favorisent ou défavorisent l'espèce;\n\n- ou elle peut être intrinsèque si elle est due à la dispersion d'individus entre sites rapprochés.\n\nDans plusieurs cas, les deux types de dépendance affectent une variable donnée.\n\nSi la dépendance est simplement induite et que les variables externes qui en sont la cause sont incluses dans le modèle expliquant $y$, alors les résidus du modèle seront indépendants et nous pouvons utiliser toutes les méthodes déjà vues qui ignorent la dépendance spatiale.\n\nCependant, si la dépendance est intrinsèque ou due à des influences externes non-mesurées, alors il faudra tenir compte de la dépendance spatiale des résidus dans le modèle.\n\n## Différentes façons de modéliser les effets spatiaux\n\nDans cette formation, nous modéliserons directement les corrélations spatiales de nos données. Il est utile de comparer cette approche à d'autres façons d'inclure des aspects spatiaux dans un modèle statistique.\n\nD'abord, nous pourrions inclure des prédicteurs dans le modèle qui représentent la position (ex.: longitude, latitude). De tels prédicteurs peuvent être utiles pour détecter une tendance ou un gradient systématique à grande échelle, que cette tendance soit linéaire ou non (par exemple, avec un modèle additif généralisé).\n\nEn contraste à cette approche, les modèles que nous verrons maintenant servent à modéliser une corrélation spatiale dans les fluctuations aléatoires d'une variable (i.e., dans les résidus après avoir enlevé tout effet systématique).\n\nLes modèles mixtes utilisent des effets aléatoires pour représenter la non-indépendance de données sur la base de leur groupement, c'est-à-dire qu'après avoir tenu compte des effets fixes systématiques, les données d'un même groupe sont plus semblables (leur variation résiduelle est corrélée) par rapport aux données de groupes différents. Ces groupes étaient parfois définis selon des critères spatiaux (observations regroupées en sites).\n\nCependant, dans un contexte d'effet aléatoire de groupe, tous les groupes sont aussi différents les uns des autres, ex.: deux sites à 100 km l'un de l'autre ne sont pas plus ou moins semblables que deux sites distants de 2 km.\n\nLes méthodes que nous verrons ici et dans les prochains parties de la formation nous permettent donc ce modéliser la non-indépendance sur une échelle continue (plus proche = plus corrélé) plutôt que seulement discrète (hiérarchie de groupements).\n\n\n# Modèles géostatistiques {#geostat-models-fr}\n\nLa géostatistique désigne un groupe de techniques tirant leur origine en sciences de la Terre. Elle s'intéresse à des variables distribuées de façon continue dans l'espace, dont on cherche à estimer la distribution en échantillonnant un nombre de points. Un exemple classique de ces techniques provient du domaine minier, où l'on cherchait à créer une carte de la concentration du minerai sur un site à partir d'échantillons pris à différents points du site.\n\nPour ces modèles, nous supposerons que $z(x, y)$ est une variable spatiale stationnaire mesurée selon les coordonnées $x$ et $y$.\n\n## Variogramme\n\nUn aspect central de la géostatistique est l'estimation du variogramme $\\gamma_z$ de la variable $z$. Le variogramme est égal à la moitié de l'écart carré moyen entre les valeurs de $z$ pour deux points $(x_i, y_i)$ et $(x_j, y_j)$ séparés par une distance $h$.\n\n$$\\gamma_z(h) = \\frac{1}{2} \\text{E} \\left[ \\left( z(x_i, y_i) - z(x_j, y_j) \\right)^2 \\right]_{d_{ij} = h}$$\n\nDans cette équation, la fonction $\\text{E}$ avec l'indice $d_{ij}=h$ désigne l'espérance statistique (autrement dit, la moyenne) de l'écart au carré entre les valeurs de $z$ pour les points séparés par une distance $h$.\n\nSi on préfère exprimer l'autocorrélation $\\rho_z(h)$ entre mesures de $z$ séparées par une distance $h$, celle-ci est reliée au variogramme par l'équation:\n\n$$\\gamma_z = \\sigma_z^2(1 - \\rho_z)$$ ,\n\noù $\\sigma_z^2$ est la variance globale de $z$. \n\nNotez que $\\gamma_z = \\sigma_z^2$ si nous sommes à une distance où les mesures de $z$ sont indépendantes, donc $\\rho_z = 0$. Dans ce cas, on voit bien que $\\gamma_z$ s'apparente à une variance, même s'il est parfois appelé \"semivariogramme\" ou \"semivariance\" en raison du facteur 1/2 dans l'équation ci-dessus.\n\n## Modèles théoriques du variogramme\n\nPlusieurs modèles paramétriques ont été proposés pour représenter la corrélation spatiale en fonction de la distance entre points d'échantillonnage. Considérons d'abord une corrélation qui diminue de façon exponentielle: \n\n$$\\rho_z(h) = e^{-h/r}$$\n\nIci, $\\rho_z = 1$ pour $h = 0$ et la corréaltion est multipliée par $1/e \\approx 0.37$ pour chaque augmentation de $r$ de la distance. Dans ce contexte, $r$ se nomme la portée (*range*) de la corrélation.\n\nÀ partir de l'équation ci-dessus, nous pouvons calculer le variogramme correspondant.\n\n$$\\gamma_z(h) = \\sigma_z^2 (1 - e^{-h/r})$$\n\nVoici une représentation graphique de ce variogramme.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-117_94b4bef8ba36e1b515cfee5fff6c1ebb'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEn raison de la fonction exponentielle, la valeur de $\\gamma$ à des grandes distances s'approche de la variance globale $\\sigma_z^2$ sans exactement l'atteindre. Cette asymptote est appelée palier (*sill*) dans le contexte géostatistique et représentée par le symbole $s$.\n\nFinalement, il n'est parfois pas réaliste de supposer une corrélation parfaite lorsque la distance tend vers 0, en raison d'une variation possible de $z$ à très petite échelle. On peut ajouter au modèle un effet de pépite (*nugget*), noté $n$, pour que $\\gamma$ s'approche de $n$ (plutôt que 0) si $h$ tend vers 0. Le terme pépite provient de l'origine minière de ces techniques, où une pépite d'un minerai pourrait être la source d'une variation abrupte de la concentration à petite échelle.\n\nEn ajoutant l'effet de pépite, le reste du variogramme est \"compressé\" pour conserver le même palier, ce qui résulte en l'équation suivante.\n\n$$\\gamma_z(h) = n + (s - n) (1 - e^{-h/r})$$\n\nDans le package *gstat* que nous utiliserons ci-dessous, le terme $(s - n)$ est le palier partiel (*partial sill*, ou `psill`) pour la partie exponentielle.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-118_616ef9e44728a1524a3df51fd61bde38'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEn plus du modèle exponentiel, deux autres modèles théoriques courants pour le variogramme sont le modèle gaussien (où la corrélation suit une courbe demi-normale), ainsi que le modèle sphérique (où le variogramme augmente de façon linéaire au départ pour ensuite courber et atteindre le palier à une distance égale à sa portée $r$). Le modèle sphérique permet donc à la corrélation d'être exactement 0 à grande distance, plutôt que de s'approcher graduellement de zéro dans le cas des autres modèles.\n\n Modèle | $\\rho(h)$ | $\\gamma(h)$\n-------|-----------|-------------\nExponentiel | $\\exp\\left(-\\frac{h}{r}\\right)$ | $s \\left(1 - \\exp\\left(-\\frac{h}{r}\\right)\\right)$\nGaussien | $\\exp\\left(-\\frac{h^2}{r^2}\\right)$ | $s \\left(1 - \\exp\\left(-\\frac{h^2}{r^2}\\right)\\right)$\nSphérique $(h < r)$ * | $1 - \\frac{3}{2}\\frac{h}{r} + \\frac{1}{2}\\frac{h^3}{r^3}$ | $s \\left(\\frac{3}{2}\\frac{h}{r} - \\frac{1}{2}\\frac{h^3}{r^3} \\right)$\n\n\\* Pour le modèle sphérique, $\\rho = 0$ et $\\gamma = s$ si $h \\ge r$.\n\n\n\n::: {.cell fig.dim='[9,4]' hash='index_cache/html/unnamed-chunk-119_df4e0a7376691267996d3cce69016995'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\n## Variogramme empirique\n\nPour estimer $\\gamma_z(h)$ à partir de données empiriques, nous devons définir des classes de distance, donc grouper différentes distances dans une marge $\\pm \\delta$ autour d'une distance $h$, puis calculer l'écart-carré moyen pour les paires de points dans cette classe de distance.\n\n$$\\hat{\\gamma_z}(h) = \\frac{1}{2 N_{\\text{paires}}} \\sum \\left[ \\left( z(x_i, y_i) - z(x_j, y_j) \\right)^2 \\right]_{d_{ij} = h \\pm \\delta}$$\n\nNous verrons dans la partie suivante comment estimer un variogramme dans R.\n\n## Modèle de régression avec corrélation spatiale\n\nL'équation suivante représente une régression linéaire multiple incluant une corrélation spatiale résiduelle:\n\n$$v = \\beta_0 + \\sum_i \\beta_i u_i + z + \\epsilon$$\n\nIci, $v$ désigne la variable réponse et $u$ les prédicteurs, pour ne pas confondre avec les coordonnées spatiales $x$ et $y$. \n\nEn plus du résidu $\\epsilon$ qui est indépendant entre les observations, le modèle inclut un terme $z$ qui représente la portion spatialement corrélée de la variance résiduelle.\n\nVoici une suggestions d'étapes à suivre pour appliquer ce type de modèle:\n\n1. Ajuster le modèle de régression sans corrélation spatiale.\n\n2. Vérifier la présence de corrélation spatiale à partir du variogramme empirique des résidus.\n\n3. Ajuster un ou plusieurs modèles de régression avec corrélation spatiale et choisir celui qui montre le meilleur ajustement aux données. \n\n# Modèles géostatistiques dans R\n\nLe package *gstat* contient des fonctions liées à la géostatistique. Pour cet exemple, nous utiliserons le jeu de données `oxford` de ce package, qui contient des mesures de propriétés physiques et chimiques pour 126 échantillons du sol d'un site, ainsi que leurs coordonnées `XCOORD` et `YCOORD`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-120_bb070aeb602b5bb93fe5df883fdd6dbe'}\n\n```{.r .cell-code}\nlibrary(gstat)\n\ndata(oxford)\nstr(oxford)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n'data.frame':\t126 obs. of 22 variables:\n $ PROFILE : num 1 2 3 4 5 6 7 8 9 10 ...\n $ XCOORD : num 100 100 100 100 100 100 100 100 100 100 ...\n $ YCOORD : num 2100 2000 1900 1800 1700 1600 1500 1400 1300 1200 ...\n $ ELEV : num 598 597 610 615 610 595 580 590 598 588 ...\n $ PROFCLASS: Factor w/ 3 levels \"Cr\",\"Ct\",\"Ia\": 2 2 2 3 3 2 3 2 3 3 ...\n $ MAPCLASS : Factor w/ 3 levels \"Cr\",\"Ct\",\"Ia\": 2 3 3 3 3 2 2 3 3 3 ...\n $ VAL1 : num 3 3 4 4 3 3 4 4 4 3 ...\n $ CHR1 : num 3 3 3 3 3 2 2 3 3 3 ...\n $ LIME1 : num 4 4 4 4 4 0 2 1 0 4 ...\n $ VAL2 : num 4 4 5 8 8 4 8 4 8 8 ...\n $ CHR2 : num 4 4 4 2 2 4 2 4 2 2 ...\n $ LIME2 : num 4 4 4 5 5 4 5 4 5 5 ...\n $ DEPTHCM : num 61 91 46 20 20 91 30 61 38 25 ...\n $ DEP2LIME : num 20 20 20 20 20 20 20 20 40 20 ...\n $ PCLAY1 : num 15 25 20 20 18 25 25 35 35 12 ...\n $ PCLAY2 : num 10 10 20 10 10 20 10 20 10 10 ...\n $ MG1 : num 63 58 55 60 88 168 99 59 233 87 ...\n $ OM1 : num 5.7 5.6 5.8 6.2 8.4 6.4 7.1 3.8 5 9.2 ...\n $ CEC1 : num 20 22 17 23 27 27 21 14 27 20 ...\n $ PH1 : num 7.7 7.7 7.5 7.6 7.6 7 7.5 7.6 6.6 7.5 ...\n $ PHOS1 : num 13 9.2 10.5 8.8 13 9.3 10 9 15 12.6 ...\n $ POT1 : num 196 157 115 172 238 164 312 184 123 282 ...\n```\n:::\n:::\n\n\nSupposons que nous souhaitons modéliser la concentration de magnésium (`MG1`), représentée en fonction de la position spatiale dans le graphique suivant.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-121_16158cd54c4487cc58ec9fd8dedf3de7'}\n\n```{.r .cell-code}\nlibrary(ggplot2)\nggplot(oxford, aes(x = YCOORD, y = XCOORD, size = MG1)) +\n geom_point() +\n coord_fixed()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNotez que les axes $x$ et $y$ ont été inversés par souci d'espace. La fonction `coord_fixed()` de *ggplot2* assure que l'échelle soit la même sur les deux axes, ce qui est utile pour représenter des données spatiales. \n\nNous voyons tout de suite que ces mesures ont été prises sur une grille de 100 m de côté. Il semble que la concentration de magnésium soit spatialement corrélée, bien qu'il puisse s'agir d'une corrélation induite par une autre variable. Nous savons notamment que la concentration de magnésium est reliée négativement au pH du sol (`PH1`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-122_d467da9d444c7554518f3d138f017425'}\n\n```{.r .cell-code}\nggplot(oxford, aes(x = PH1, y = MG1)) +\n geom_point()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLa fonction `variogram` de *gstat* sert à estimer un variogramme à partir de données empiriques. Voici le résultat obtenu pour la variable `MG1`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-123_d148763eb057ac91a7c45c4a49d51a00'}\n\n```{.r .cell-code}\nvar_mg <- variogram(MG1 ~ 1, locations = ~ XCOORD + YCOORD, data = oxford)\nvar_mg\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n np dist gamma dir.hor dir.ver id\n1 225 100.0000 1601.404 0 0 var1\n2 200 141.4214 1950.805 0 0 var1\n3 548 215.0773 2171.231 0 0 var1\n4 623 303.6283 2422.245 0 0 var1\n5 258 360.5551 2704.366 0 0 var1\n6 144 400.0000 2948.774 0 0 var1\n7 570 427.5569 2994.621 0 0 var1\n8 291 500.0000 3402.058 0 0 var1\n9 366 522.8801 3844.165 0 0 var1\n10 200 577.1759 3603.060 0 0 var1\n11 458 619.8400 3816.595 0 0 var1\n12 90 670.8204 3345.739 0 0 var1\n```\n:::\n:::\n\n\nLa formule `MG1 ~ 1` indique qu'aucun prédicteur linéaire n'est inclus dans ce modèle, tandis que l'argument `locations` indique quelles variables du tableau correspondent aux coordonnées spatiales. \n\nDans le tableau obtenu, `gamma` est la valeur du variogramme pour la classe de distance centrée sur `dist`, tandis que `np` est le nombre de paires de points dans cette classe. Ici, puisque les points sont situés sur une grille, nous obtenons des classes de distance régulières (ex.: 100 m pour les points voisins sur la grille, 141 m pour les voisins en diagonale, etc.).\n\nNous nous limitons ici à l'estimation de variogrammes isotropiques, c'est-à-dire que le variogramme dépend seulement de la distance entre les deux points et non de la direction. Bien que nous n'ayons pas le temps de le voir aujourd'hui, il est possible avec *gstat* d'estimer séparément le variogramme dans différentes directions.\n\nNous pouvons illustrer le variogramme avec `plot`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-124_ca0a474a676de6872283aecd1d7057df'}\n\n```{.r .cell-code}\nplot(var_mg, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nSi nous voulons estimer la corrélation spatiale résiduelle de `MG1` après avoir inclus l'effet de `PH1`, nous pouvons ajouter ce prédicteur à la formule.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-125_11cddc5b7e870cd1cc0cda1a95fac338'}\n\n```{.r .cell-code}\nvar_mg <- variogram(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford)\nplot(var_mg, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEn incluant l'effet du pH, la portée de la corrélation spatiale semble diminuer, alors que le plateau est atteint autour de 300 m. Il semble même que le variogramme diminue au-delà de 400 m. En général, nous supposons que la variance entre deux points ne diminue pas avec la distance, à moins d'avoir un patron spatial périodique.\n\nLa fonction `fit.variogram` accepte comme arguments un variogramme estimé à partir des données, ainsi qu'un modèle théorique décrit dans une fonction `vgm`, puis estime les paramètres de ce modèle en fonction des données. L'ajustement se fait par la méthode des moindres carrés.\n\nPar exemple, `vgm(\"Exp\")` indique d'ajuster un modèle exponentiel. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-126_03d3f3aa8b262e89fa7d8da65b62e30c'}\n\n```{.r .cell-code}\nvfit <- fit.variogram(var_mg, vgm(\"Exp\"))\nvfit\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n model psill range\n1 Nug 0.000 0.00000\n2 Exp 1951.496 95.11235\n```\n:::\n:::\n\n\nIl n'y a aucun effet de pépite, car `psill = 0` pour la partie `Nug` (*nugget*) du modèle. La partie exponentielle a un palier à 1951 et une portée de 95 m.\n\nPour comparer différents modèles, on peut donner un vecteur de noms de modèles à `vgm`. Dans l'exemple suivant, nous incluons les modèles exponentiel, gaussien (\"Gau\") et sphérique (\"Sph\").\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-127_2f3bfeceade9f4f4dfc5b3eba9eda432'}\n\n```{.r .cell-code}\nvfit <- fit.variogram(var_mg, vgm(c(\"Exp\", \"Gau\", \"Sph\")))\nvfit\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n model psill range\n1 Nug 0.000 0.00000\n2 Exp 1951.496 95.11235\n```\n:::\n:::\n\n\nLa fonction nous donne le résultat du modèle le mieux ajusté (plus faible somme des écarts au carré), qui est ici le même modèle exponentiel.\n\nFinalement, nous pouvons superposer le modèle théorique et le variogramme empirique sur un même graphique.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-128_c877e0be691daa5fe18f6d2ba00dfdcd'}\n\n```{.r .cell-code}\nplot(var_mg, vfit, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n## Régression avec corrélation spatiale\n\nNous avons vu ci-dessus que le package *gstat* permet d'estimer le variogramme des résidus d'un modèle linéaire. Dans notre exemple, la concentration de magnésium était modélisée en fonction du pH, avec des résidus spatialement corrélés.\n\nUn autre outil pour ajuster ce même type de modèle est la fonction `gls` du package *nlme*, qui est inclus avec l'installation de R. \n\nCette fonction applique la méthode des moindres carrés généralisés (*generalized least squares*) pour ajuster des modèles de régression linéaire lorsque les résidus ne sont pas indépendants ou lorsque la variance résiduelle n'est pas la même pour toutes les observations. Comme les estimés des coefficients dépendent de l'estimé des corrélations entre les résidus et que ces derniers dépendent eux-mêmes des coefficients, le modèle est ajusté par un algorithme itératif:\n\n1. On ajuste un modèle de régression linéaire classique (sans corrélation) pour obtenir des résidus.\n\n2. On ajuste le modèle de corrélation spatiale (variogramme) avec ses résidus.\n\n3. On ré-estime les coefficients de la régression en tenant compte maintenant des corrélations.\n\nLes étapes 2 et 3 sont répétées jusqu'à ce que les estimés soient stables à une précision voulue.\n\nVoici l'application de cette méthode au même modèle pour la concentration de magnésium dans le jeu de données `oxford`. Dans l'argument `correlation` de `gls`, nous spécifions un modèle de corrélation exponentielle en fonction de nos coordonnées spatiales et indiquons que nous voulons aussi estimer un effet de pépite.\n\nEn plus de la corrélation exponentielle `corExp`, la fonction `gls` peut aussi estimer un modèle gaussien (`corGaus`) ou sphérique (`corSpher`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-129_c4131310eb8ea32e0ccf4187e678e982'}\n\n```{.r .cell-code}\nlibrary(nlme)\ngls_mg <- gls(MG1 ~ PH1, oxford, \n correlation = corExp(form = ~ XCOORD + YCOORD, nugget = TRUE))\nsummary(gls_mg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized least squares fit by REML\n Model: MG1 ~ PH1 \n Data: oxford \n AIC BIC logLik\n 1278.65 1292.751 -634.325\n\nCorrelation Structure: Exponential spatial correlation\n Formula: ~XCOORD + YCOORD \n Parameter estimate(s):\n range nugget \n478.0322964 0.2944753 \n\nCoefficients:\n Value Std.Error t-value p-value\n(Intercept) 391.1387 50.42343 7.757084 0\nPH1 -41.0836 6.15662 -6.673079 0\n\n Correlation: \n (Intr)\nPH1 -0.891\n\nStandardized residuals:\n Min Q1 Med Q3 Max \n-2.1846957 -0.6684520 -0.3687813 0.4627580 3.1918604 \n\nResidual standard error: 53.8233 \nDegrees of freedom: 126 total; 124 residual\n```\n:::\n:::\n\n\nPour comparer ce résultat au variogramme ajusté ci-dessus, il faut transformer les paramètres donnés par `gls`. La portée (range) a le même sens dans les deux cas et correspond à 478 m pour le résultat de `gls`. La variance globale des résidus est le carré de `Residual standard error`. L'effet de pépite ici (0.294) est exprimé comme fraction de cette variance. Finalement, pour obtenir le palier partiel de la partie exponentielle, il faut soustraire l'effet de pépite de la variance totale. \n\nAprès avoir réalisé ces calculs, nous pouvons donner ces paramètres à la fonction `vgm` de *gstat* pour superposer ce variogramme estimé par `gls` à notre variogramme des résidus du modèle linéaire classique.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-130_1b4118890801a03647e2f78590f222be'}\n\n```{.r .cell-code}\ngls_range <- 478\ngls_var <- 53.823^2\ngls_nugget <- 0.294 * gls_var\ngls_psill <- gls_var - gls_nugget\n\ngls_vgm <- vgm(\"Exp\", psill = gls_psill, range = gls_range, nugget = gls_nugget)\n\nplot(var_mg, gls_vgm, col = \"black\", ylim = c(0, 4000))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEst-ce que le modèle est moins bien ajusté aux données ici? En fait, ce variogramme empirique représenté par les points avait été obtenu à partir des résidus du modèle linéaire ignorant la corrélation spatiale, donc c'est un estimé biaisé des corrélations spatiales réelles. La méthode est quand même adéquate pour vérifier rapidement s'il y a présence de corrélations spatiales. Toutefois, pour ajuster simultanément les coefficients de la régression et les paramètres de corrélation spatiale, l'approche des moindres carrés généralisés (GLS) est préférable et produira des estimés plus justes.\n\nFinalement, notez que le résultat du modèle `gls` donne aussi l'AIC, que nous pouvons utiliser pour comparer l'ajustement de différents modèles (avec différents prédicteurs ou différentes formes de corrélation spatiale).\n\n## Exercice\n\nLe fichier [bryo_belg.csv](data/bryo_belg.csv) est adapté des données de l'étude: \n\n> Neyens, T., Diggle, P.J., Faes, C., Beenaerts, N., Artois, T. et Giorgi, E. (2019) Mapping species richness using opportunistic samples: a case study on ground-floor bryophyte species richness in the Belgian province of Limburg. *Scientific Reports* 9, 19122. https://doi.org/10.1038/s41598-019-55593-x\n\nCe tableau de données indique la richesse spécifique des bryophytes au sol (*richness*) pour différents points d'échantillonnage de la province belge de Limbourg, avec leur position *(x, y)* en km, en plus de l'information sur la proportion de forêts (*forest*) et de milieux humides (*wetland*) dans une cellule de 1 km$^2$ contenant le point d'échantillonnage.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-131_9e78f0ec8229f51b3dcf95f72b18a23a'}\n\n```{.r .cell-code}\nbryo_belg <- read.csv(\"data/bryo_belg.csv\")\nhead(bryo_belg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n richness forest wetland x y\n1 9 0.2556721 0.5036614 228.9516 220.8869\n2 6 0.6449114 0.1172068 227.6714 219.8613\n3 5 0.5039905 0.6327003 228.8252 220.1073\n4 3 0.5987329 0.2432942 229.2775 218.9035\n5 2 0.7600775 0.1163538 209.2435 215.2414\n6 10 0.6865434 0.0000000 210.4142 216.5579\n```\n:::\n:::\n\n\nPour cet exercice, nous utiliserons la racine carrée de la richesse spécifique comme variable réponse. La transformation racine carrée permet souvent d'homogénéiser la variance des données de comptage afin d'y appliquer une régression linéaire. \n\na) Ajustez un modèle linéaire de la richesse spécifique transformée en fonction de la fraction de forêt et de milieux humides, sans tenir compte des corrélations spatiales. Quel est l'effet des deux prédicteurs selon ce modèle?\n\nb) Calculez le variogramme empirique des résidus du modèle en (a). Semble-t-il y avoir une corrélation spatiale entre les points?\n\n*Note*: L'argument `cutoff` de la fonction `variogram` spécifie la distance maximale à laquelle le variogramme est calculé. Vous pouvez ajuster manuellement cette valeur pour bien voir le palier.\n\nc) Ré-ajustez le modèle linéaire en (a) avec la fonction `gls` du package *nlme*, en essayant différents types de corrélations spatiales (exponentielle, gaussienne, sphérique). Comparez les modèles (incluant celui sans corrélation spatiale) avec l'AIC.\n\nd) Quel est l'effet de la fraction de forêts et de milieux humides selon le modèle en (c)? Expliquez les différences entre les conclusions de ce modèle et du modèle en (a).\n\n\n# Krigeage\n\nTel que mentionné précédemment, une application courante des modèles géostatistiques consiste à prédire la valeur de la variable de réponse à des points non-échantillonnés, une forme d'interpolation spatiale appelée krigeage (*kriging*).\n\nIl existe trois principaux types de krigeage selon les suppositions faites au sujet de la variable réponse:\n\n- Krigeage ordinaire: variable stationnaire avec une moyenne inconnue.\n\n- Krigeage simple: Variable stationnaire avec une moyenne connue.\n\n- Krigeage universel: Variable dont la tendance est donnée par un modèle linéaire ou non linéaire.\n\nPour toutes les méthodes de krigeage, les prédictions à un nouveau point sont une moyenne pondérée des valeurs à des points connus. Ces pondérations sont choisies de manière à ce que le krigeage fournisse la meilleure prédiction linéaire non biaisée de la variable de réponse, si les hypothèses du modèle (en particulier le variogramme) sont correctes. C'est-à-dire que, parmi toutes les prédictions non biaisées possibles, les poids sont choisis de manière à donner l'erreur quadratique moyenne minimale. Le krigeage fournit également une estimation de l'incertitude de chaque prédiction.\n\nBien que nous ne présentions pas ici les équations détaillées du krigeage, les poids dépendent à la fois des corrélations (estimées par le variogramme) entre les points échantillonnés et le nouveau point, ainsi que des corrélations entre les points échantillonnés eux-mêmes. Autrement dit, les points échantillonnés proches du nouveau point ont plus de poids, mais les points échantillonnés isolés ont également plus de poids, car les points échantillonnés proches les uns des autres fournissent une informations redondante.\n\nLe krigeage est une méthode d'interpolation, donc la prédiction à un point échantillonné sera toujours égale à la valeur mesurée (la variable est supposée être mesurée sans erreur, elle varie seulement entre les points). Cependant, en présence d'un effet de pépite, tout petit déplacement par rapport à l'endroit échantillonné présentera une variabilité en fonction de la pépite.\n\nDans l'exemple ci-dessous, nous générons un nouvel ensemble de données composé de coordonnées (x, y) générées de façon aléatoire dans la zone d'étude ainsi que des valeurs de pH générées de façon aléatoire sur la base des données `oxford`. Nous appliquons ensuite la fonction `krige` pour prédire les valeurs de magnésium à ces nouveaux points. Notez que nous spécifions le variogramme dérivé des résultats du `gls` dans l'argument `model` de `krige`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-132_027c26268d41b1f7157bb584e297db99'}\n\n```{.r .cell-code}\nset.seed(14)\nnew_points <- data.frame(\n XCOORD = runif(100, min(oxford$XCOORD), max(oxford$XCOORD)),\n YCOORD = runif(100, min(oxford$YCOORD), max(oxford$YCOORD)),\n PH1 = rnorm(100, mean(oxford$PH1), sd(oxford$PH1))\n)\n\npred <- krige(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford,\n newdata = new_points, model = gls_vgm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[using universal kriging]\n```\n:::\n\n```{.r .cell-code}\nhead(pred)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n XCOORD YCOORD var1.pred var1.var\n1 227.0169 162.1185 47.13065 1269.002\n2 418.9136 465.9013 79.68437 1427.269\n3 578.5943 2032.7477 60.30539 1264.471\n4 376.2734 1530.7193 127.22366 1412.875\n5 591.5336 421.6290 105.88124 1375.485\n6 355.7369 404.3378 127.73055 1250.114\n```\n:::\n:::\n\n\nLe résultat de `krige` comprend les nouvelles coordonnées du point, la prédiction de la variable `var1.pred` ainsi que sa variance estimée `var1.var`. Dans le graphique ci-dessous, nous montrons les prédictions moyennes de MG1 à partir du krigeage (triangles) ainsi que les mesures (cercles).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-133_1b4299bab8f6eba5fe4ea3b112a66235'}\n\n```{.r .cell-code}\npred$MG1 <- pred$var1.pred\n\nggplot(oxford, aes(x = YCOORD, y = XCOORD, color = MG1)) +\n geom_point() +\n geom_point(data = pred, shape = 17, size = 2) +\n coord_fixed()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLa moyenne et la variance estimées par krigeage peuvent être utilisées pour simuler les valeurs possibles de la variable à chaque nouveau point, conditionnellement aux valeurs échantillonnées. Dans l'exemple ci-dessous, nous avons effectué 4 simulations conditionnelles en ajoutant l'argument `nsim = 4` à la même instruction `krige`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-134_9a008c1eb0ae0b7b22fbfc9aa9ca64ba'}\n\n```{.r .cell-code}\nsim_mg <- krige(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford,\n newdata = new_points, model = gls_vgm, nsim = 4)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\ndrawing 4 GLS realisations of beta...\n[using conditional Gaussian simulation]\n```\n:::\n\n```{.r .cell-code}\nhead(sim_mg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n XCOORD YCOORD sim1 sim2 sim3 sim4\n1 227.0169 162.1185 9.638739 34.53159 46.08685 77.86376\n2 418.9136 465.9013 60.029144 20.17179 76.46333 59.57924\n3 578.5943 2032.7477 100.791412 77.47887 73.50058 59.40279\n4 376.2734 1530.7193 112.615730 150.96664 78.76125 146.83928\n5 591.5336 421.6290 70.925240 72.85522 153.90610 126.63758\n6 355.7369 404.3378 161.608032 118.93640 134.45695 142.20074\n```\n:::\n:::\n\n::: {.cell fig.dim='[10,5]' hash='index_cache/html/unnamed-chunk-135_3de9cc48384c950ead05df0c82810126'}\n\n```{.r .cell-code}\nlibrary(tidyr)\nsim_mg <- pivot_longer(sim_mg, cols = c(sim1, sim2, sim3, sim4), \n names_to = \"sim\", values_to = \"MG1\")\nggplot(sim_mg, aes(x = YCOORD, y = XCOORD, color = MG1)) +\n geom_point() +\n coord_fixed() +\n facet_wrap(~ sim)\n```\n\n::: {.cell-output-display}\n{width=960}\n:::\n:::\n\n\n\n# Solutions\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-136_e5d36a60c009aa3f50973208ae8f2f5b'}\n\n```{.r .cell-code}\nbryo_lm <- lm(sqrt(richness) ~ forest + wetland, data = bryo_belg)\nsummary(bryo_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall:\nlm(formula = sqrt(richness) ~ forest + wetland, data = bryo_belg)\n\nResiduals:\n Min 1Q Median 3Q Max \n-1.8847 -0.4622 0.0545 0.4974 2.3116 \n\nCoefficients:\n Estimate Std. Error t value Pr(>|t|) \n(Intercept) 2.34159 0.08369 27.981 < 2e-16 ***\nforest 1.11883 0.13925 8.034 9.74e-15 ***\nwetland -0.59264 0.17216 -3.442 0.000635 ***\n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nResidual standard error: 0.7095 on 417 degrees of freedom\nMultiple R-squared: 0.2231,\tAdjusted R-squared: 0.2193 \nF-statistic: 59.86 on 2 and 417 DF, p-value: < 2.2e-16\n```\n:::\n:::\n\n\nLa proportion de forêts a un effet positif significatif et la proportion de milieux humides a un effet négatif significatif sur la richesse des bryophytes.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-137_ec3dcc9a8a06613df18c98b96808666b'}\n\n```{.r .cell-code}\nplot(variogram(sqrt(richness) ~ forest + wetland, locations = ~ x + y,\n data = bryo_belg, cutoff = 50), col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLe variogramme augmente au moins jusqu'à une distance de 40 km, il semble donc y avoir des corrélations spatiales dans les résidus du modèle.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-138_7c7f1feca29413974ebbf1ffe2ed08c2'}\n\n```{.r .cell-code}\nbryo_exp <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corExp(form = ~ x + y, nugget = TRUE))\nbryo_gaus <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corGaus(form = ~ x + y, nugget = TRUE))\nbryo_spher <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corSpher(form = ~ x + y, nugget = TRUE))\n```\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-139_8c08d48b4eaefbe6cc8947569ca14603'}\n\n```{.r .cell-code}\nAIC(bryo_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 908.6358\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_exp)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 867.822\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_gaus)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 870.9592\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_spher)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 866.9117\n```\n:::\n:::\n\n\nLe modèle sphérique a l'AIC le plus faible.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-140_6c6c64ec797a7b31d531a376b94c8dbc'}\n\n```{.r .cell-code}\nsummary(bryo_spher)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized least squares fit by REML\n Model: sqrt(richness) ~ forest + wetland \n Data: bryo_belg \n AIC BIC logLik\n 866.9117 891.1102 -427.4558\n\nCorrelation Structure: Spherical spatial correlation\n Formula: ~x + y \n Parameter estimate(s):\n range nugget \n43.1727664 0.6063187 \n\nCoefficients:\n Value Std.Error t-value p-value\n(Intercept) 2.0368769 0.2481636 8.207800 0.000\nforest 0.6989844 0.1481690 4.717481 0.000\nwetland -0.2441130 0.1809118 -1.349348 0.178\n\n Correlation: \n (Intr) forest\nforest -0.251 \nwetland -0.235 0.241\n\nStandardized residuals:\n Min Q1 Med Q3 Max \n-1.75204183 -0.06568688 0.61415597 1.15240370 3.23322743 \n\nResidual standard error: 0.7998264 \nDegrees of freedom: 420 total; 417 residual\n```\n:::\n:::\n\n\nLa magnitude des deux effets est moins importante et l'effet des milieux humides n'est plus significatif. Comme c'est le cas pour d'autres types de résidus non indépendants, la \"taille effective\" de l'échantillon est ici inférieure au nombre de points, car des points proches les uns des autres fournissent une information redondante. Par conséquent, la relation entre les prédicteurs et la réponse est moins claire que celle donnée par le modèle supposant que tous ces points étaient indépendants.\n\nNotez que les résultats pour les trois modèles `gls` sont assez similaires, donc le choix d'inclure des corrélations spatiales était plus important que la forme exacte supposée pour le variogramme.\n\n\n# Données aréales {#areal-data-fr}\n\nLes données aréales sont des variables mesurées pour des régions de l'espace; ces régions sont définies par des polygones. Ce type de données est plus courant en sciences sociales, en géographie humaine et en épidémiologie, où les données sont souvent disponibles à l'échelle de divisions administratives du territoire. \n\nCe type de données apparaît aussi fréquemment dans la gestion des ressources naturelles. Par exemple, la carte suivante montre les unités d'aménagement forestier du Ministère de la Forêts, de la Faune et des Parcs du Québec.\n\n\n\nSupposons qu'une certaine variable soit disponible au niveau de ces divisions du territoire. Comment pouvons-nous modéliser la corrélation spatiale entre les unités qui sont spatialement rapprochées?\n\nUne option serait d'appliquer les méthodes géostatistiques vues précédemment, en calculant par exemple la distance entre les centres des polygones.\n\nUne autre option, qui est davantage privilégiée pour les données aréales, consiste à définir un réseau où chaque région est connectée aux régions voisines par un lien. On suppose ensuite que les variables sont directement corrélées entre régions voisines seulement. (Notons toutefois que les corrélations directes entre voisins immédiats génèrent aussi des corrélations indirectes pour une chaîne de voisins.)\n\nDans ce type de modèle, la corrélation n'est pas nécessairement la même d'un lien à un autre. Dans ce cas, chaque lien du réseau peut être associé à un *poids* représentant son importance pour la corrélation spatiale. Nous représentons ces poids par une matrice $W$ où $w_{ij}$ est le poids du lien entre les régions $i$ et $j$. Une région n'a pas de lien avec elle-même, donc $w_{ii} = 0$.\n\nUn choix simple pour $W$ consiste à assigner un poids égal à 1 si les régions sont voisines, sinon 0 (poids binaires).\n\nOutre les divisions du territoire en polygones, un autre exemple de données aréales consiste en une grille où la variable est compilée pour chaque cellule de la grille. Dans ce cas, une cellule a généralement 4 ou 8 cellules voisines, selon que les diagonales soient incluses ou non.\n\n# Indice de Moran {#moran-i-fr}\n\nAvant de discuter des modèles d'autocorrélation spatiale, nous présentons l'indice $I$ de Moran, qui permet de tester si une corrélation significative est présente entre régions voisines. \n\nL'indice de Moran est un coefficient d'autocorrélation spatiale des $z$, pondéré par les poids $w_{ij}$. Il prend donc des valeurs entre -1 et 1.\n\n$$I = \\frac{N}{\\sum_i \\sum_j w_{ij}} \\frac{\\sum_i \\sum_j w_{ij} (z_i - \\bar{z}) (z_j - \\bar{z})}{\\sum_i (z_i - \\bar{z})^2}$$\n\nDans cette équation, nous reconnaissons l'expression d'une corrélation, soit le produit des écarts à la moyenne de deux variables $z_i$ et $z_j$, divisé par le produit de leurs écarts-types (qui est le même, donc on obtient la variance). La contribution de chaque paire $(i, j)$ est multipliée par son poids $w_{ij}$ et le terme à gauche (le nombre de régions $N$ divisé par la somme des poids) assure que le résultat soit borné entre -1 et 1.\n\nPuisque la distribution de $I$ est connue en l'absence d'autocorrélation spatiale, cette statistique permet de tester l'hypothèse nulle selon laquelle il n'y a pas de corrélation spatiale entre régions voisines.\n\nBien que nous ne verrons pas d'exemple dans ce cours-ci, l'indice de Moran peut aussi être appliqué aux données ponctuelles. Dans ce cas, on divise les paires de points en classes de distance et on calcule $I$ pour chaque classe de distance; le poids $w_{ij} = 1$ si la distance entre $i$ et $j$ se trouve dans la classe de distance voulue, 0 autrement.\n\n# Modèles d'autorégression spatiale {#spatial-autoreg-fr}\n\nRappelons-nous la formule pour une régression linéaire avec dépendance spatiale:\n\n$$v = \\beta_0 + \\sum_i \\beta_i u_i + z + \\epsilon$$\n\noù $z$ est la portion de la variance résiduelle qui est spatialement corrélée.\n\nIl existe deux principaux types de modèles autorégressifs pour représenter la dépendance spatiale de $z$: l'autorégression conditionnelle (CAR) et l'autorégression simultanée (SAR).\n\n## Autorégression conditionnelle (CAR)\n\nDans le modèle d'autorégression conditionnelle, la valeur de $z_i$ pour la région $i$ suit une distribution normale: sa moyenne dépend de la valeur $z_j$ des régions voisines, multipliée par le poids $w_{ij}$ et un coefficient de corrélation $\\rho$; son écart-type $\\sigma_{z_i}$ peut varier d'une région à l'autre.\n\n$$z_i \\sim \\text{N}\\left(\\sum_j \\rho w_{ij} z_j,\\sigma_{z_i} \\right)$$\n\nDans ce modèle, si $w_{ij}$ est une matrice binaire (0 pour les non-voisins, 1 pour les voisins), alors $\\rho$ est le coefficient de corrélation partielle entre régions voisines. Cela est semblable à un modèle autorégressif d'ordre 1 dans le contexte de séries temporelles, où le coefficient d'autorégression indique la corrélation partielle.\n\n## Autorégression simultanée (SAR)\n\nDans le modèle d'autorégression simultanée, la valeur de $z_i$ est donnée directement par la somme de contributions des valeurs voisines $z_j$, multipliées par $\\rho w_{ij}$, avec un résidu indépendant $\\nu_i$ d'écart-type $\\sigma_z$.\n\n$$z_i = \\sum_j \\rho w_{ij} z_j + \\nu_i$$\n\nÀ première vue, cela ressemble à un modèle autorégressif temporel. Il existe cependant une différence conceptuelle importante. Pour les modèles temporels, l'influence causale est dirigée dans une seule direction: $v(t-2)$ affecte $v(t-1)$ qui affecte ensuite $v(t)$. Pour un modèle spatial, chaque $z_j$ qui affecte $z_i$ dépend à son tour de $z_i$. Ainsi, pour déterminer la distribution conjointe des $z$, il faut résoudre simultanément (d'où le nom du modèle) un système d'équations. \n\nPour cette raison, même si ce modèle ressemble à la formule du modèle conditionnel (CAR), les solutions des deux modèles diffèrent et dans le cas du SAR, le coefficient $\\rho$ n'est pas directement égal à la corrélation partielle due à chaque région voisine.\n\nPour plus de détails sur les aspects mathématiques de ces modèles, vous pouvez consulter l'article de Ver Hoef et al. (2018) suggéré en référence. \n\nPour l'instant, nous considérerons les SAR et les CAR comme deux types de modèles possibles pour représenter une corrélation spatiale sur un réseau. Nous pouvons toujours ajuster plusieurs modèles et les comparer avec l'AIC pour choisir la meilleure forme de la corrélation ou la meilleure matrice de poids.\n\nLes modèles CAR et SAR partagent un avantage sur les modèles géostatistiques au niveau de l'efficacité. Dans un modèle géostatistique, les corrélations spatiales sont définies entre chaque paire de points, même si elles deviennent négligeables lorsque la distance augmente. Pour un modèle CAR ou SAR, seules les régions voisines contribuent et la plupart des poids sont égaux à 0, ce qui rend ces modèles plus rapides à ajuster qu'un modèle géostatistique lorsque les données sont massives.\n\n# Analyse des données aréales dans R {#analysis-areal-fr}\n\nPour illustrer l'analyse de données aréales dans R, nous chargeons les packages *sf* (pour lire des données géospatiales), *spdep* (pour définir des réseaux spatiaux et calculer l'indice de Moran) et *spatialreg* (pour les modèles SAR et CAR).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-141_8c941e8bafdfac85f5eb2821d17ab03b'}\n\n```{.r .cell-code}\nlibrary(sf)\nlibrary(spdep)\nlibrary(spatialreg)\n```\n:::\n\n\nNous utiliserons comme exemple un jeu de données qui présente une partie des résultats de l'élection provinciale de 2018 au Québec, avec des caractéristiques de la population de chaque circonscription. Ces données sont inclues dans un fichier de type *shapefile* (.shp), que nous pouvons lire avec la fonction `read_sf` du package *sf*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-142_f24372ba1482109fbffa68f052fd7dfb'}\n\n```{.r .cell-code}\nelect2018 <- read_sf(\"data/elect2018.shp\")\nhead(elect2018)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nSimple feature collection with 6 features and 9 fields\nGeometry type: MULTIPOLYGON\nDimension: XY\nBounding box: xmin: 97879.03 ymin: 174515.3 xmax: 694261.1 ymax: 599757.1\nProjected CRS: LambertAQ\n# A tibble: 6 × 10\n circ age_moy pct_frn pct_prp rev_med propCAQ propPQ propPLQ propQS\n \n1 Abitibi-Est 40.8 0.963 0.644 34518 42.7 19.5 18.8 15.7\n2 Abitibi-Ouest 42.2 0.987 0.735 33234 34.1 33.3 11.3 16.6\n3 Acadie 40.3 0.573 0.403 25391 16.5 9 53.8 13.8\n4 Anjou-Louis-Riel 43.5 0.821 0.416 31275 28.9 14.7 39.1 14.5\n5 Argenteuil 43.3 0.858 0.766 31097 38.9 21.1 17.4 12.2\n6 Arthabaska 43.4 0.989 0.679 30082 61.8 9.4 11.4 12.6\n# … with 1 more variable: geometry \n```\n:::\n:::\n\n\n*Note*: Le jeu de données est en fait composé de 4 fichiers avec les extensions .dbf, .prj, .shp et .shx, mais il suffit d'inscrire le nom du fichier .shp dans `read_sf`.\n\nLes colonnes du jeu de données sont dans l'ordre:\n\n- le nom de la circonscription électorale;\n- quatre caractéristiques de la population (âge moyen, fraction de la population qui parle principalement français à la maison, fraction des ménages qui sont propriétaires de leur logement, revenu médian);\n- quatre colonnes montrant la fraction des votes obtenues par les principaux partis (CAQ, PQ, PLQ, QS);\n- une colonne `geometry` qui contient l'objet géométrique (multipolygone) correspondant à la circonscription.\n\nPour illustrer une des variables sur une carte, nous appelons la fonction `plot` avec le nom de la colonne entre crochets et guillemets. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-143_118d70deac183e230a7c64b3208cd1a7'}\n\n```{.r .cell-code}\nplot(elect2018[\"rev_med\"])\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nDans cet exemple, nous voulons modéliser la fraction des votes obtenue par la CAQ en fonction des caractéristiques de la population dans chaque circonscription et en tenant compte des corrélations spatiales entre circonscriptions voisines.\n\n## Définition du réseau de voisinage\n\nLa fonction `poly2nb` du package *spdep* définit un réseau de voisinage à partir de polygones. Le résultat `vois` est une liste de 125 éléments où chaque élément contient les indices des polygones voisins (limitrophes) d'un polygone donné.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-144_e6285b834db05d427f22b7669e5dbee2'}\n\n```{.r .cell-code}\nvois <- poly2nb(elect2018)\nvois[[1]]\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 2 37 63 88 101 117\n```\n:::\n:::\n\n\nAinsi, la première circonscription (Abitibi-Est) a 6 circonscriptions voisines, dont on peut trouver les noms ainsi:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-145_2fc04a4a3fbb352f0ae58db913423a12'}\n\n```{.r .cell-code}\nelect2018$circ[vois[[1]]]\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] \"Abitibi-Ouest\" \"Gatineau\" \n[3] \"Laviolette-Saint-Maurice\" \"Pontiac\" \n[5] \"Rouyn-Noranda-Témiscamingue\" \"Ungava\" \n```\n:::\n:::\n\n\nNous pouvons illustrer ce réseau en faisant l'extraction des coordonnées du centre de chaque circonscription, en créant une carte muette avec `plot(elect2018[\"geometry\"])`, puis en ajoutant le réseau comme couche additionnelle avec `plot(vois, add = TRUE, coords = coords)`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-146_56fcb69c11c78b9880373ab1b16efb12'}\n\n```{.r .cell-code}\ncoords <- st_centroid(elect2018) %>%\n st_coordinates()\nplot(elect2018[\"geometry\"])\nplot(vois, add = TRUE, col = \"red\", coords = coords)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nOn peut faire un \"zoom\" sur le sud du Québec en choisissant les limites `xlim` et `ylim` appropriées.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-147_b0a05b92ad9c5bc6e15ecbc77d7fd239'}\n\n```{.r .cell-code}\nplot(elect2018[\"geometry\"], \n xlim = c(400000, 800000), ylim = c(100000, 500000))\nplot(vois, add = TRUE, col = \"red\", coords = coords)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIl nous reste à ajouter des poids à chaque lien du réseau avec la fonction `nb2listw`. Le style de poids \"B\" correspond aux poids binaires, soit 1 pour la présence de lien et 0 pour l'absence de lien entre deux circonscriptions.\n\nUne fois ces poids définis, nous pouvons vérifier avec le test de Moran s'il y a une autocorrélation significative des votes obtenus par la CAQ entre circonscriptions voisines.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-148_59eb24f4ba758ea6399bc94ea1c419ba'}\n\n```{.r .cell-code}\npoids <- nb2listw(vois, style = \"B\")\n\nmoran.test(elect2018$propCAQ, poids)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\n\tMoran I test under randomisation\n\ndata: elect2018$propCAQ \nweights: poids \n\nMoran I statistic standard deviate = 13.148, p-value < 2.2e-16\nalternative hypothesis: greater\nsample estimates:\nMoran I statistic Expectation Variance \n 0.680607768 -0.008064516 0.002743472 \n```\n:::\n:::\n\n\nLa valeur de $I = 0.68$ est très significative à en juger par la valeur $p$ du test.\n\nVérifions si la corrélation spatiale persiste après avoir tenu compte des quatre caractéristiques de la population, donc en inspectant les résidus d'un modèle linéaire incluant ces quatre prédicteurs.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-149_7d8643515ed0e408c5e5163ec8e3740c'}\n\n```{.r .cell-code}\nelect_lm <- lm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, data = elect2018)\nsummary(elect_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall:\nlm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018)\n\nResiduals:\n Min 1Q Median 3Q Max \n-30.9890 -4.4878 0.0562 6.2653 25.8146 \n\nCoefficients:\n Estimate Std. Error t value Pr(>|t|) \n(Intercept) 1.354e+01 1.836e+01 0.737 0.463 \nage_moy -9.170e-01 3.855e-01 -2.378 0.019 * \npct_frn 4.588e+01 5.202e+00 8.820 1.09e-14 ***\npct_prp 3.582e+01 6.527e+00 5.488 2.31e-07 ***\nrev_med -2.624e-05 2.465e-04 -0.106 0.915 \n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nResidual standard error: 9.409 on 120 degrees of freedom\nMultiple R-squared: 0.6096,\tAdjusted R-squared: 0.5965 \nF-statistic: 46.84 on 4 and 120 DF, p-value: < 2.2e-16\n```\n:::\n\n```{.r .cell-code}\nmoran.test(residuals(elect_lm), poids)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\n\tMoran I test under randomisation\n\ndata: residuals(elect_lm) \nweights: poids \n\nMoran I statistic standard deviate = 6.7047, p-value = 1.009e-11\nalternative hypothesis: greater\nsample estimates:\nMoran I statistic Expectation Variance \n 0.340083290 -0.008064516 0.002696300 \n```\n:::\n:::\n\n\nL'indice de Moran a diminué mais demeure significatif, donc une partie de la corrélation précédente était induite par ces prédicteurs, mais il reste une corrélation spatiale due à d'autres facteurs. \n\n## Modèles d'autorégression spatiale\n\nFinalement, nous ajustons des modèles SAR et CAR à ces données avec la fonction `spautolm` (*spatial autoregressive linear model*) de *spatialreg*. Voici le code pour un modèle SAR incluant l'effet des même quatre prédicteurs. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-150_34bc73005b64f5a3ee73549b2cbc9b5e'}\n\n```{.r .cell-code}\nelect_sar <- spautolm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids)\nsummary(elect_sar)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids)\n\nResiduals:\n Min 1Q Median 3Q Max \n-23.08342 -4.10573 0.24274 4.29941 23.08245 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 15.09421119 16.52357745 0.9135 0.36098\nage_moy -0.70481703 0.32204139 -2.1886 0.02863\npct_frn 39.09375061 5.43653962 7.1909 6.435e-13\npct_prp 14.32329345 6.96492611 2.0565 0.03974\nrev_med 0.00016730 0.00023209 0.7208 0.47101\n\nLambda: 0.12887 LR test value: 42.274 p-value: 7.9339e-11 \nNumerical Hessian standard error of lambda: 0.012069 \n\nLog likelihood: -433.8862 \nML residual variance (sigma squared): 53.028, (sigma: 7.282)\nNumber of observations: 125 \nNumber of parameters estimated: 7 \nAIC: 881.77\n```\n:::\n:::\n\n\nLa valeur donnée par `Lambda` dans le sommaire correspond au coefficient $\\rho$ dans notre description du modèle. Le test du rapport de vraisemblance (`LR test`) confirme que cette corrélation spatiale résiduelle (après avoir tenu compte de l'effet des prédicteurs) est significative.\n\nLes effets estimés pour les prédicteurs sont semblables à ceux du modèle linéaire sans corrélation spatiale. Les effets de l'âge moyen, de la fraction de francophones et la fraction de propriétaires demeurent significatifs, bien que leur magnitude ait un peu diminué.\n\nPour évaluer un modèle CAR plutôt que SAR, nous devons spécifier `family = \"CAR\"`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-151_7ba6f7fcd4cc33a20eb6848945d3cce4'}\n\n```{.r .cell-code}\nelect_car <- spautolm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids, family = \"CAR\")\nsummary(elect_car)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids, family = \"CAR\")\n\nResiduals:\n Min 1Q Median 3Q Max \n-21.73315 -4.24623 -0.24369 3.44228 23.43749 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 16.57164696 16.84155327 0.9840 0.325128\nage_moy -0.79072151 0.32972225 -2.3981 0.016478\npct_frn 38.99116707 5.43667482 7.1719 7.399e-13\npct_prp 17.98557474 6.80333470 2.6436 0.008202\nrev_med 0.00012639 0.00023106 0.5470 0.584364\n\nLambda: 0.15517 LR test value: 40.532 p-value: 1.9344e-10 \nNumerical Hessian standard error of lambda: 0.0026868 \n\nLog likelihood: -434.7573 \nML residual variance (sigma squared): 53.9, (sigma: 7.3416)\nNumber of observations: 125 \nNumber of parameters estimated: 7 \nAIC: 883.51\n```\n:::\n:::\n\n\nPour un modèle CAR avec des poids binaires, la valeur de `Lambda` (que nous avions appelé $\\rho$) donne directement le coefficient de corrélation partielle entre circonscriptions voisines. Notez que l'AIC ici est légèrement supérieur au modèle SAR, donc ce dernier donnait un meilleur ajustement.\n\n## Exercice\n\nLe jeu de données `rls_covid`, en format *shapefile*, contient des données sur les cas de COVID-19 détectés, le nombre de cas par 1000 personnes (`taux_1k`) et la densité de population (`dens_pop`) dans chacun des réseaux locaux de service de santé (RLS) du Québec. (Source: Données téléchargées de l'Institut national de santé publique du Québec en date du 17 janvier 2021.)\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-152_117a49f704cd9751636b707b593f6428'}\n\n```{.r .cell-code}\nrls_covid <- read_sf(\"data/rls_covid.shp\")\nhead(rls_covid)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nSimple feature collection with 6 features and 5 fields\nGeometry type: MULTIPOLYGON\nDimension: XY\nBounding box: xmin: 785111.2 ymin: 341057.8 xmax: 979941.5 ymax: 541112.7\nProjected CRS: Conique_conforme_de_Lambert_du_MTQ_utilis_e_pour_Adresse_Qu_be\n# A tibble: 6 × 6\n RLS_code RLS_nom cas taux_1k dens_…¹ geometry\n \n1 0111 RLS de Kamouraska 152 7.34 6.76 (((827028.3 412772.4, 82…\n2 0112 RLS de Rivière-du-Lo… 256 7.34 19.6 (((855905 452116.9, 8557…\n3 0113 RLS de Témiscouata 81 4.26 4.69 (((911829.4 441311.2, 91…\n4 0114 RLS des Basques 28 3.3 5.35 (((879249.6 471975.6, 87…\n5 0115 RLS de Rimouski 576 9.96 15.5 (((917748.1 503148.7, 91…\n6 0116 RLS de La Mitis 76 4.24 5.53 (((951316 523499.3, 9525…\n# … with abbreviated variable name ¹dens_pop\n```\n:::\n:::\n\n\nAjustez un modèle linéaire du nombre de cas par 1000 en fonction de la densité de population (il est suggéré d'appliquer une transformation logarithmique à cette dernière). Vérifiez si les résidus du modèle sont corrélés entre RLS limitrophes avec un test de Moran, puis modélisez les mêmes données avec un modèle autorégressif conditionnel.\n\n## Référence\n\nVer Hoef, J.M., Peterson, E.E., Hooten, M.B., Hanks, E.M. et Fortin, M.-J. (2018) Spatial autoregressive models for statistical inference from ecological data. *Ecological Monographs* 88: 36-59.\n\n\n# GLMM avec processus spatial gaussien {#glmm-spatial-gaussian-fr}\n\nDans les parties précédentes, nous avons vu comment tenir compte de la dépendance spatiale dans les modèles de régression linéaire avec des modèles géostatistiques (également appelés processus gaussiens) ou des modèles d'autocorrélation spatiale (CAR/SAR). Dans cette dernière partie, nous verrons comment combiner ces caractéristiques avec des modèles de régression plus complexes, en particulier les modèles linéaires généralisés à effets mixtes (GLMM).\n\n## Données\n\nLe jeu de données `gambia` inclus avec le package *geoR* présente les résultats d'une étude sur la prévalence du paludisme chez les enfants de 65 villages en Gambie. Nous utiliserons une version légèrement transformée des données contenues dans le fichier [gambia.csv](data/gambia.csv).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-153_94be0528ee530f4b0d9120a3e4a412d9'}\n\n```{.r .cell-code}\nlibrary(geoR)\n\ngambia <- read.csv(\"data/gambia.csv\")\nhead(gambia)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n id_village x y pos age netuse treated green phc\n1 1 349.6313 1458.055 1 1783 0 0 40.85 1\n2 1 349.6313 1458.055 0 404 1 0 40.85 1\n3 1 349.6313 1458.055 0 452 1 0 40.85 1\n4 1 349.6313 1458.055 1 566 1 0 40.85 1\n5 1 349.6313 1458.055 0 598 1 0 40.85 1\n6 1 349.6313 1458.055 1 590 1 0 40.85 1\n```\n:::\n:::\n\n\nVoici les champs de ce jeu de données:\n\n- *id_village*: Identifiant du village.\n- *x* and *y*: Coordonnées spatiales du village (en km, basé sur les coordonnées UTM).\n- *pos*: Réponse binaire, si l'enfant a eu un test positif du paludisme.\n- *age*: Âge de l'enfant en jours.\n- *netuse*: Si l'enfant dort sous un moustiquaire ou non.\n- *treated*: Si le moustiquaire est traité ou non.\n- *green*: Mesure de la végétation basée sur les données de télédétection (disponible à l'échelle du village).\n- *phc*: Présence ou absence d'un centre de santé publique pour le village.\n\nNous pouvons compter le nombre de cas positifs et le nombre total d'enfants testés par village pour cartographier la fraction des cas positifs (ou prévalence, *prev*).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-154_f2e9fe8cc46d29ee6147236d160f6a1a'}\n\n```{.r .cell-code}\n# Jeu de données à l'échelle du village\ngambia_agg <- group_by(gambia, id_village, x, y, green, phc) %>%\n summarize(pos = sum(pos), total = n()) %>%\n mutate(prev = pos / total) %>%\n ungroup()\n```\n\n::: {.cell-output .cell-output-stderr}\n```\n`summarise()` has grouped output by 'id_village', 'x', 'y', 'green'. You can\noverride using the `.groups` argument.\n```\n:::\n\n```{.r .cell-code}\nhead(gambia_agg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n# A tibble: 6 × 8\n id_village x y green phc pos total prev\n \n1 1 350. 1458. 40.8 1 17 33 0.515\n2 2 359. 1460. 40.8 1 19 63 0.302\n3 3 360. 1460. 40.1 0 7 17 0.412\n4 4 364. 1497. 40.8 0 8 24 0.333\n5 5 366. 1460. 40.8 0 10 26 0.385\n6 6 367. 1463. 40.8 0 7 18 0.389\n```\n:::\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-155_b02463961b3424baa4da82ed27a5ca7e'}\n\n```{.r .cell-code}\nggplot(gambia_agg, aes(x = x, y = y)) +\n geom_point(aes(color = prev)) +\n geom_path(data = gambia.borders, aes(x = x / 1000, y = y / 1000)) +\n coord_fixed() +\n theme_minimal() +\n scale_color_viridis_c()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNous utilisons le jeu de données `gambia.borders` du package *geoR* pour tracer les frontières des pays avec `geom_path`. Comme ces frontières sont en mètres, nous les divisons par 1000 pour obtenir la même échelle que nos points. Nous utilisons également `coord_fixed` pour assurer un rapport d'aspect de 1:1 entre les axes et utilisons la palette de couleur `viridis`, qui permet de visualiser plus facilement une variable continue par rapport à la palette par défaut dans *ggplot2*.\n\nSur la base de cette carte, il semble y avoir une corrélation spatiale dans la prévalence du paludisme, le groupe de villages de l'est montrant des valeurs de prévalence plus élevées (jaune-vert) et le groupe du milieu montrant des valeurs de prévalence plus faibles (violet).\n\n## GLMM non spatial\n\nPour ce premier exemple, nous allons ignorer l'aspect spatial des données et modéliser la présence du paludisme (*pos*) en fonction de l'utilisation d'une moustiquaire (*netuse*) et de la présence d'un centre de santé publique (*phc*). Comme nous avons une réponse binaire, nous devons utiliser un modèle de régression logistique (un GLM). Comme nous avons des prédicteurs au niveau individuel et au niveau du village et que nous nous attendons à ce que les enfants d'un même village aient une probabilité plus similaire d'avoir le paludisme même après avoir pris en compte ces prédicteurs, nous devons ajouter un effet aléatoire du village. Le résultat est un GLMM que nous ajustons en utilisant la fonction `glmer` du package *lme4*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-156_7c91bce3c832a01ae8f8b3f26d71b9fa'}\n\n```{.r .cell-code}\nlibrary(lme4)\n\nmod_glmm <- glmer(pos ~ netuse + phc + (1 | id_village), \n data = gambia, family = binomial)\nsummary(mod_glmm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized linear mixed model fit by maximum likelihood (Laplace\n Approximation) [glmerMod]\n Family: binomial ( logit )\nFormula: pos ~ netuse + phc + (1 | id_village)\n Data: gambia\n\n AIC BIC logLik deviance df.resid \n 2428.0 2450.5 -1210.0 2420.0 2031 \n\nScaled residuals: \n Min 1Q Median 3Q Max \n-2.1286 -0.7120 -0.4142 0.8474 3.3434 \n\nRandom effects:\n Groups Name Variance Std.Dev.\n id_village (Intercept) 0.8149 0.9027 \nNumber of obs: 2035, groups: id_village, 65\n\nFixed effects:\n Estimate Std. Error z value Pr(>|z|) \n(Intercept) 0.1491 0.2297 0.649 0.5164 \nnetuse -0.6044 0.1442 -4.190 2.79e-05 ***\nphc -0.4985 0.2604 -1.914 0.0556 . \n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nCorrelation of Fixed Effects:\n (Intr) netuse\nnetuse -0.422 \nphc -0.715 -0.025\n```\n:::\n:::\n\n\nD'après ces résultats, les variables *netuse* et *phc* sont toutes deux associées à une diminution de la prévalence du paludisme, bien que l'effet de *phc* ne soit pas significatif à un seuil $\\alpha = 0.05$. L'ordonnée à l'origine (0.149) est le logit de la probabilité de présence du paludisme pour un enfant sans moustiquaire et sans centre de santé publique, mais c'est l'ordonnée à l'origine moyenne pour tous les villages. Il y a beaucoup de variation entre les villages selon l'écart-type de l'effet aléatoire (0.90). Nous pouvons obtenir l'ordonnée à l'origine estimée pour chaque village avec la fonction `coef`:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-157_63042bdf37fbb1a41197653e4f00698a'}\n\n```{.r .cell-code}\nhead(coef(mod_glmm)$id_village)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n (Intercept) netuse phc\n1 0.93727515 -0.6043602 -0.4984835\n2 0.09204843 -0.6043602 -0.4984835\n3 0.22500620 -0.6043602 -0.4984835\n4 -0.46271089 -0.6043602 -0.4984835\n5 0.13680037 -0.6043602 -0.4984835\n6 -0.03723346 -0.6043602 -0.4984835\n```\n:::\n:::\n\n\nPar exemple, l'ordonnée à l'origine pour le village 1 est environ 0.94, équivalente à une probabilité de 72%:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-158_4a79548bf948a9a1dd6b953821a54623'}\n\n```{.r .cell-code}\nplogis(0.937)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 0.7184933\n```\n:::\n:::\n\n\ntandis que celle pour le village 2 est équivalente à une probabilité de 52%:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-159_4c5678258eaea6caef0b0f87f03a5423'}\n\n```{.r .cell-code}\nplogis(0.092)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 0.5229838\n```\n:::\n:::\n\n\nLe [package DHARMa](https://cran.r-project.org/web/packages/DHARMa/vignettes/DHARMa.html) fournit une méthode générale pour vérifier si les résidus d'un GLMM sont distribués selon le modèle spécifié et s'il existe une tendance résiduelle. Il simule des réplicats de chaque observation selon le modèle ajusté et détermine ensuite un \"résidu standardisé\", qui est la position relative de la valeur observée par rapport aux valeurs simulées, par exemple 0 si l'observation est plus petite que toutes les simulations, 0.5 si elle se trouve au milieu, etc. Si le modèle représente bien les données, chaque valeur du résidu standardisé entre 0 et 1 doit avoir la même probabilité, de sorte que les résidus standardisés doivent produire une distribution uniforme entre 0 et 1.\n\nLa fonction `simulateResiduals` effectue le calcul des résidus standardisés, puis la fonction `plot` trace les graphiques de diagnostic avec les résultats de certains tests.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-160_9f18e83c75ae6d568f2e7722da9a3235'}\n\n```{.r .cell-code}\nlibrary(DHARMa)\nres_glmm <- simulateResiduals(mod_glmm)\nplot(res_glmm)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLe graphique de gauche est un graphique quantile-quantile des résidus standardisés. Les résultats de trois tests statistiques sont également présentés: un test de Kolmogorov-Smirnov (*KS*) qui vérifie s'il y a un écart par rapport à la distribution théorique, un test de dispersion qui vérifie s'il y a une sous-dispersion ou une surdispersion et un test de valeurs aberrantes (*outlier*) basé sur le nombre de résidus qui sont plus extrêmes que toutes les simulations. Ici, nous obtenons un résultat significatif pour les valeurs aberrantes, bien que le message indique que ce résultat pourrait avoir un taux d'erreur de type I plus grand que prévu dans ce cas.\n\nÀ droite, nous obtenons généralement un graphique des résidus standardisés (en *y*) en fonction du rang des valeurs prédites, afin de vérifier l'absence de tendance résiduelle. Ici, les prédictions sont regroupées par quartile, il serait donc préférable d'agréger les prédictions et les résidus par village, ce que nous pouvons faire avec la fonction `recalculateResiduals`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-161_24ccd295095906cee82b1b1c09edfb05'}\n\n```{.r .cell-code}\nplot(recalculateResiduals(res_glmm, group = gambia$id_village))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLe graphique de droite montre les points individuels, ainsi qu'une régression quantile pour le 1er quartile, la médiane et le 3e quartile. En théorie, ces trois courbes devraient être des lignes droites horizontales (pas de tendance des résidus par rapport aux prévisions). La courbe pour le 3e quartile (en rouge) est significativement différente d'une ligne horizontale, ce qui pourrait indiquer un effet systématique manquant dans le modèle.\n\n## GLMM spatial avec spaMM\n\nLe package *spaMM* (modèles mixtes spatiaux) est un package R relativement récent qui permet d'effectuer une estimation approximative du maximum de vraisemblance des paramètres pour les GLM avec dépendance spatiale, modélisés soit comme un processus gaussien, soit avec un CAR (nous verrons ce dernier dans la dernière section). Le package implémente différents algorithmes, mais il existe une fonction unique `fitme` qui choisit l'algorithme approprié pour chaque type de modèle. Par exemple, voici le même modèle (non spatial) que nous avons vu ci-dessus, ajusté avec *spaMM*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-162_54461b112807b785cded2a0cabf936b4'}\n\n```{.r .cell-code}\nlibrary(spaMM)\n\nmod_spamm_glmm <- fitme(pos ~ netuse + phc + (1 | id_village),\n data = gambia, family = binomial)\nsummary(mod_spamm_glmm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + (1 | id_village)\nEstimation of lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.1491 0.2287 0.6519\nnetuse -0.6045 0.1420 -4.2567\nphc -0.4986 0.2593 -1.9231\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n id_village : 0.8151 \n --- Coefficients for log(lambda):\n Group Term Estimate Cond.SE\n id_village (Intercept) -0.2045 0.2008\n# of obs: 2035; # of groups: id_village, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1210.016\n```\n:::\n:::\n\n\nNotez que les estimés des effets fixes ainsi que la variance des effets aléatoires sont presque identiques à ceeux obtenues par `glmer` ci-dessus.\n\nNous pouvons maintenant utiliser *spaMM* pour ajuster le même modèle avec l'ajout de corrélations spatiales entre les villages. Dans la formule du modèle, ceci est représenté comme un effet aléatoire `Matern(1 | x + y)`, ce qui signifie que les ordonnées à l'origine sont spatialement corrélées entre les villages suivant une fonction de corrélation de Matérn des coordonnées (*x, y*). La fonction de Matérn est une fonction flexible de corrélation spatiale qui comprend un paramètre de forme $\\nu$ (`nu`), de sorte que lorsque $\\nu = 0,5$, elle est équivalente à la corrélation exponentielle, mais quand $\\nu$ prend de grandes valeurs, elle se rapproche d'une corrélation gaussienne. Nous pourrions laisser la fonction estimer $\\nu$, mais ici nous le fixons à 0.5 avec l'argument `fixed` de `fitme`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-163_94f8693a9a4ea45698056ea7d175adbc'}\n\n```{.r .cell-code}\nmod_spamm <- fitme(pos ~ netuse + phc + Matern(1 | x + y) + (1 | id_village),\n data = gambia, family = binomial, fixed = list(nu = 0.5))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nIncrease spaMM.options(separation_max=<.>) to at least 21 if you want to check separation (see 'help(separation)').\n```\n:::\n\n```{.r .cell-code}\nsummary(mod_spamm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + Matern(1 | x + y) + (1 | id_village)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.06861 0.3352 0.2047\nnetuse -0.51719 0.1407 -3.6757\nphc -0.44416 0.2052 -2.1648\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.nu 1.rho \n0.50000000 0.05128692 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n x + y : 0.6421 \n id_village : 0.1978 \n# of obs: 2035; # of groups: x + y, 65; id_village, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1197.968\n```\n:::\n:::\n\n\nCommençons par vérifier les effets aléatoires du modèle. La fonction de corrélation spatiale a un paramètre `rho` égal à 0.0513. Ce paramètre dans *spaMM* est l'inverse de la portée, donc ici la portée de la corrélation exponentielle est de 1/0.0513 ou environ 19.5 km. Il y a maintenant deux pramètres de variance, celui identifié comme `x + y` est la variance à longue distance (i.e. le palier) pour le modèle de corrélation exponentielle alors que celui identifié comme `id_village` montre la portion non corrélée de la variation entre les villages.\n\nSi nous avions ici laissé les effets aléatoires `(1 | id_village)` dans la formule pour représenter la partie non spatiale de la variation entre les villages, nous pourrions également représenter ceci avec un effet de pépite dans le modèle géostatistique. Dans les deux cas, cela représenterait l'idée que même deux villages très proches l'un de l'autre auraient des prévalences de base différentes dans le modèle.\n\nPar défaut, la fonction `Matern` n'a pas d'effet de pépite, mais nous pouvons en ajouter un en spécifiant une `pépite` non nulle dans la liste initiale des paramètres `init`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-164_7807f13fbd48e4a433573a5160e106f1'}\n\n```{.r .cell-code}\nmod_spamm2 <- fitme(pos ~ netuse + phc + Matern(1 | x + y),\n data = gambia, family = binomial, fixed = list(nu = 0.5),\n init = list(Nugget = 0.1))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nIncrease spaMM.options(separation_max=<.>) to at least 21 if you want to check separation (see 'help(separation)').\n```\n:::\n\n```{.r .cell-code}\nsummary(mod_spamm2)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + Matern(1 | x + y)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.06861 0.3352 0.2047\nnetuse -0.51719 0.1407 -3.6757\nphc -0.44416 0.2052 -2.1648\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.nu 1.Nugget 1.rho \n0.50000000 0.23551027 0.05128692 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n x + y : 0.8399 \n# of obs: 2035; # of groups: x + y, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1197.968\n```\n:::\n:::\n\n\nComme vous pouvez le voir, toutes les estimations sont les mêmes, sauf que la variance de la portion spatiale (palier) est maintenant de 0.84 et que la pépite est égale à une fraction 0.235 de ce palier, soit une variance de 0.197, ce qui est identique à l'effet aléatoire `id_village` dans la version ci-dessus. Les deux formulations sont donc équivalentes.\n\nMaintenant, rappelons les coefficients que nous avions obtenus pour le GLMM non spatial :\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-165_d9e37edd6e102c7e0e32c00182b4c98d'}\n\n```{.r .cell-code}\nsummary(mod_glmm)$coefficients\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 0.1490596 0.2296971 0.6489399 5.163772e-01\nnetuse -0.6043602 0.1442448 -4.1898243 2.791706e-05\nphc -0.4984835 0.2604083 -1.9142382 5.558973e-02\n```\n:::\n:::\n\n\nDans la version spatiale, les deux effets fixes se sont légèrement rapprochés de zéro, mais l'erreur-type de l'effet de `phc` a diminué. Il est intéressant de noter que l'inclusion de la dépendance spatiale nous a permis d'estimer plus précisément l'effet de la présence d'un centre de santé publique dans le village. Ce ne serait pas toujours le cas: pour un prédicteur qui est également fortement corrélé dans l'espace, la corrélation spatiale dans la réponse rend plus difficile l'estimation de l'effet de ce prédicteur, puisqu'il est confondu avec l'effet spatial. Cependant, pour un prédicteur qui n'est pas corrélé dans l'espace, l'inclusion de l'effet spatial réduit la variance résiduelle (non spatiale) et peut donc augmenter la précision de l'effet du prédicteur.\n\nLe package *spaMM* est également compatible avec *DHARMa* pour les diagnostics résiduels. (Vous pouvez ignorer l'avertissement selon lequel il ne fait pas partie de la classe des modèles pris en charge, cela est dû à l'utilisation de la fonction `fitme` plutôt que d'une fonction d'algorithme spécifique dans *spaMM*).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-166_482f0fc040c81b2f1de2f8ee99aed0d1'}\n\n```{.r .cell-code}\nres_spamm <- simulateResiduals(mod_spamm2)\nplot(res_spamm)\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nplot(recalculateResiduals(res_spamm, group = gambia$id_village))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEnfin, bien que nous allons montrer comment calculer et visualiser des prédictions spatiales ci-dessous, nous pouvons produire une carte rapide des effets spatiaux estimés dans un modèle *spaMM* avec la fonction `filled.mapMM`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-167_e868e1e85e43353fb2484a914c5ac95b'}\n\n```{.r .cell-code}\nfilled.mapMM(mod_spamm2)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n## Processus gaussiens vs. splines de lissage\n\nSi vous connaissez bien les modèles additifs généralisés (GAM), vous avez peut-être pensé à représenter la variation spatiale de la prévalence du paludisme (comme le montre la carte ci-dessus) par une spline de lissage en 2D (en fonction de $x$ et $y$) dans un GAM.\n\nLe code ci-dessous correspond à l'équivalent GAM de notre GLMM avec processus gaussien ci-dessus, ajusté avec la fonction `gam` du package *mgcv*. L'effet spatial est représenté par la spline 2D `s(x, y)` alors que l'effet aléatoire non spatial de village est représenté par `s(id_village, bs = \"re\")`, qui est équivalent à `(1 | id_village)` dans les modèles précédents. Notez que pour la fonction `gam`, les variables catégorielles doivent être explicitement converties en facteurs.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-168_5bc46e857407589375ab5b89e189742e'}\n\n```{.r .cell-code}\nlibrary(mgcv)\ngambia$id_village <- as.factor(gambia$id_village)\nmod_gam <- gam(pos ~ netuse + phc + s(id_village, bs = \"re\") + s(x, y), \n data = gambia, family = binomial)\n```\n:::\n\n\nPour visualiser la spline en 2D, nous utiliserons le package [*gratia*](https://fromthebottomoftheheap.net/2018/10/23/introducing-gratia/).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-169_07227aba979cb7fed1f2b23e7e58bfaa'}\n\n```{.r .cell-code}\nlibrary(gratia)\ndraw(mod_gam)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNotez que le graphique de la spline `s(x, y)` (en haut à droite) ne s'étend pas trop loin des emplacements des données (les autres zones sont vides). Dans ce graphique, on peut également voir que les effets aléatoires des villages suivent la distribution gaussienne attendue (en haut à gauche).\n\nEnsuite, nous utiliserons à la fois le GLMM spatial de la section précédente et ce GAMM pour prédire la prévalence moyenne sur une grille spatiale de points contenue dans le fichier [gambia_pred.csv](data/gambia_pred.csv). Le graphique ci-dessous ajoute ces points de prédiction (en noir) sur la carte précédente des points de données.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-170_a944ccbc8f583a47e766a152bff9062f'}\n\n```{.r .cell-code}\ngambia_pred <- read.csv(\"data/gambia_pred.csv\")\n\nggplot(gambia_agg, aes(x = x, y = y)) +\n geom_point(data = gambia_pred) +\n geom_point(aes(color = prev)) +\n geom_path(data = gambia.borders, aes(x = x / 1000, y = y / 1000)) +\n coord_fixed() +\n theme_minimal() +\n scale_color_viridis_c()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nPour faire des prédictions à partir du modèle GAMM à ces endroits, le code ci-dessous effectue les étapes suivantes:\n\n- Tous les prédicteurs du modèle doivent se trouver dans le tableau de données de prédiction, nous ajoutons donc des valeurs constantes de *netuse* et *phc* (toutes deux égales à 1) pour tous les points. Ainsi, nous ferons des prédictions sur la prévalence du paludisme dans le cas où un moustiquaire est utilisée et où un centre de santé publique est présent. Nous ajoutons également un *id_village* constant, bien qu'il ne soit pas utilisé dans les prédictions (voir ci-dessous).\n\n- Nous appelons la fonction `predict` à la sortie de `gam` pour produire des prédictions aux nouveaux points de données (argument `newdata`), en incluant les erreurs-types (`se.fit = TRUE`) et en excluant les effets aléatoires du village, donc la prédiction est faite pour un \"village moyen\". L'objet résultant `gam_pred` aura des colonnes `fit` (prédiction moyenne) et `se.fit` (erreur-type). Ces prédictions et erreurs-types sont sur l'échelle du lien (logit).\n\n- Nous rattachons le jeu de données de prédiction original à `gam_pred` avec `cbind`. \n\n- Nous ajoutons des colonnes pour la prédiction moyenne et les limites de l'intervalle de confiance à 50% (moyenne $\\pm$ 0.674 erreur-type), converties de l'échelle logit à l'échelle de probabilité avec `plogis`. Nous choisissons un intervalle de 50% car un intervalle de 95% peut être trop large ici pour contraster les différentes prédictions sur la carte à la fin de cette section.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-171_357ffbfea872595db79ace469d64440a'}\n\n```{.r .cell-code}\ngambia_pred <- mutate(gambia_pred, netuse = 1, phc = 1, id_village = 1)\n\ngam_pred <- predict(mod_gam, newdata = gambia_pred, se.fit = TRUE, \n exclude = \"s(id_village)\")\ngam_pred <- cbind(gambia_pred, as.data.frame(gam_pred))\ngam_pred <- mutate(gam_pred, pred = plogis(fit), \n lo = plogis(fit - 0.674 * se.fit), # 50% CI\n hi = plogis(fit + 0.674 * se.fit))\n```\n:::\n\n\n*Note* : La raison pour laquelle nous ne faisons pas de prédictions directement sur l'échelle de probabilité (réponse) est que la formule normale des intervalles de confiance s'applique plus précisément sur l'échelle logit. L'ajout d'un certain nombre d'erreurs-types autour de la moyenne sur l'échelle de probabilité conduirait à des intervalles moins précis et peut-être même à des intervalles de confiance en dehors de la plage de valeurs possible (0, 1) pour une probabilité.\n\nNous appliquons la même stratégie pour faire des prédictions à partir du GLMM spatial avec *spaMM*. Il y a quelques différences dans la méthode `predict` par rapport au cas du GAMM.\n\n- L'argument `binding = \"fit\"` signifie que les prédictions moyennes (colonne `fit`) seront attachées à l'ensemble de données de prédiction et retournées sous forme de tableau de données `spamm_pred`.\n\n- L'argument `variances = list(linPred = TRUE)` indique à `predict` de calculer la variance du prédicteur linéaire (donc le carré de l'erreur-type). Cependant, il apparaît comme un attribut `predVar` dans le tableau de données de sortie plutôt que dans une colonne `se.fit`, donc nous le déplaçons vers une colonne sur la ligne suivante. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-172_4419491a3882f147cdc904a6d1ed9d9c'}\n\n```{.r .cell-code}\nspamm_pred <- predict(mod_spamm, newdata = gambia_pred, type = \"link\",\n binding = \"fit\", variances = list(linPred = TRUE))\nspamm_pred$se.fit <- sqrt(attr(spamm_pred, \"predVar\"))\nspamm_pred <- mutate(spamm_pred, pred = plogis(fit), \n lo = plogis(fit - 0.674 * se.fit),\n hi = plogis(fit + 0.674 * se.fit))\n```\n:::\n\n\nEnfin, nous combinons les deux ensembles de prédictions sous la forme de différentes rangées d'un tableau de données `pred_all` avec `bind_rows`. Le nom du tableau de données d'où provient chaque prédiction (`gam` ou `spamm`) apparaîtra dans la colonne \"model\" (argument `.id`). Pour simplifier la production du prochain graphique, nous utilisons ensuite `pivot_longer` dans le package *tidyr* pour changer les trois colonnes \"pred\", \"lo\" et \"hi\" en deux colonnes, \"stat\" et \"value\" (`pred_tall` a donc trois rangées pour chaque rangée dans `pred_all`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-173_1fc1b4f68f5b10a718d8d768a968469c'}\n\n```{.r .cell-code}\npred_all <- bind_rows(gam = gam_pred, spamm = spamm_pred, .id = \"model\")\n\nlibrary(tidyr)\npred_tall <- pivot_longer(pred_all, c(pred, lo, hi), names_to = \"stat\",\n values_to = \"value\")\n```\n:::\n\n\nUne fois ces étapes franchies, nous pouvons enfin examiner les cartes de prédiction (moyenne, limites inférieure et supérieure de l'intervalle de confiance à 50 %) à l'aide d'un graphique `ggplot`. Les points de données originaux sont indiqués en rouge.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-174_f5e1618501cf8d5cc8fb3b12843ae8e2'}\n\n```{.r .cell-code}\nggplot(pred_tall, aes(x = x, y = y)) +\n geom_point(aes(color = value)) +\n geom_point(data = gambia_agg, color = \"red\", size = 0) +\n coord_fixed() +\n facet_grid(stat~model) +\n scale_color_viridis_c() +\n theme_minimal()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nBien que les deux modèles s'accordent à dire que la prévalence est plus élevée près du groupe de villages de l'est, le GAMM estime également une prévalence plus élevée en quelques points (bord ouest et autour du centre) où il n'y a pas de données. Il s'agit d'un artefact de la forme de la spline autour des points de données, puisqu'une spline est censée correspondre à une tendance globale, bien que non linéaire. En revanche, le modèle géostatistique représente l'effet spatial sous forme de corrélations locales et revient à la prévalence moyenne globale lorsqu'il est éloigné de tout point de données, ce qui est une supposition plus sûre. C'est l'une des raisons pour lesquelles il est préférable de choisir un modèle géostatistique / processus gaussien dans ce cas.\n\n## Méthodes bayésiennes pour les GLMM avec processus gaussiens\n\nLes modèles bayésiens fournissent un cadre flexible pour exprimer des modèles avec une structure de dépendance complexe entre les données, y compris la dépendance spatiale. Cependant, l'ajustement d'un modèle de processus gaussien avec une approche entièrement bayésienne peut être lent, en raison de la nécessité de calculer une matrice de covariance spatiale entre toutes les paires de points à chaque itération. \n\nLa méthode INLA (pour *integrated nested Laplace approximation*) effectue un calcul approximatif de la distribution postérieure bayésienne, ce qui la rend adaptée aux problèmes de régression spatiale. Nous ne l'abordons pas dans ce cours, mais je recommande le manuel de Paula Moraga (dans la section des références ci-dessous) qui fournit des exemples concrets d'utilisation de la méthode INLA pour divers modèles de données géostatistiques et aréales, dans le contexte de l'épidémiologie, y compris des modèles avec une dépendance à la fois spatiale et temporelle. Le livre présente les mêmes données sur le paludisme en Gambie comme exemple d'un ensemble de données géostatistiques, ce qui a inspiré son utilisation dans ce cours.\n\n# GLMM avec autorégression spatiale {#glmm-spatial-autoreg-fr}\n\nNous revenons au dernier exemple de la partie précédente, où nous avions modélisé le taux de cas de COVID-19 (cas / 1000) pour les divisions administratives du réseau de la santé (RLS) au Québec en fonction de leur densité de population. Le taux est donné par la colonne \"taux_1k\" dans le *shapefile* `rls_covid`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-175_d979460e37556b83e05dc8fb16e15b65'}\n\n```{.r .cell-code}\nlibrary(sf)\nrls_covid <- read_sf(\"data/rls_covid.shp\")\nrls_covid <- rls_covid[!is.na(rls_covid$dens_pop), ]\nplot(rls_covid[\"taux_1k\"])\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nAuparavant, nous avions modélisé le logarithme de ce taux comme une fonction linéaire du logarithme de la densité de population, la variance résiduelle étant corrélée entre les unités voisines via une structure CAR (autorégression conditionnelle), comme le montre le code ci-dessous.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-176_eabbd635c0d88a1a771574c50afa7c53'}\n\n```{.r .cell-code}\nlibrary(spdep)\nlibrary(spatialreg)\n\nrls_nb <- poly2nb(rls_covid)\nrls_w <- nb2listw(rls_nb, style = \"B\")\n\ncar_lm <- spautolm(log(taux_1k) ~ log(dens_pop), data = rls_covid,\n listw = rls_w, family = \"CAR\")\nsummary(car_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = log(taux_1k) ~ log(dens_pop), data = rls_covid, \n listw = rls_w, family = \"CAR\")\n\nResiduals:\n Min 1Q Median 3Q Max \n-1.201858 -0.254084 -0.053348 0.281482 1.427053 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 1.702068 0.168463 10.1035 < 2.2e-16\nlog(dens_pop) 0.206623 0.032848 6.2903 3.169e-10\n\nLambda: 0.15762 LR test value: 23.991 p-value: 9.6771e-07 \nNumerical Hessian standard error of lambda: 0.0050486 \n\nLog likelihood: -80.68953 \nML residual variance (sigma squared): 0.2814, (sigma: 0.53048)\nNumber of observations: 95 \nNumber of parameters estimated: 4 \nAIC: 169.38\n```\n:::\n:::\n\n\n*Rappel*: La fonction `poly2nb` du package *spdep* crée une liste de voisins basée sur les polygones limitrophes dans un *shapefile*, puis `nb2listw` la convertit en une liste de poids, ici des poids binaires (`style = \"B\"`) de sorte que chaque région limitrophe reçoive le même poids de 1 dans le modèle autorégressif.\n\nAu lieu d'utiliser les taux, il serait possible de modéliser directement les cas avec une régression de Poisson, qui est appropriée pour les données de comptage. Pour tenir compte du fait que si le risque par personne était égal, les cas seraient proportionnels à la population, nous pouvons ajouter la population de l'unité `pop` comme *offset* dans la régression de Poisson. Par conséquent, le modèle ressemblerait à : `cas ~ log(dens_pop) + offset(log(pop))`. Notez que puisque la régression de Poisson utilise un lien logarithmique, ce modèle avec `log(pop)` comme *offset* suppose que `log(cas / pop)` (donc le taux logarithmique) est proportionnel à `log(dens_pop)`, tout comme le modèle linéaire ci-dessus, mais il a l'avantage de modéliser la variabilité des données brutes (le nombre de cas) directement avec une distribution de Poisson.\n\nNous n'avons pas la population dans ces données, mais nous pouvons l'estimer à partir des cas et du taux (cas / 1000) comme suit:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-177_6dfaa30fb79c49e08cda1647cb0cd013'}\n\n```{.r .cell-code}\nrls_covid$pop <- rls_covid$cas / rls_covid$taux_1k * 1000\n```\n:::\n\n\nPour définir un modèle CAR dans *spaMM*, nous avons besoin d'une matrice de poids plutôt que d'une liste de poids comme dans le package *spatialreg*. Heureusement, le package *spdep* comprend également une fonction `nb2mat` pour convertir la liste des voisins en une matrice de poids, là encore en utilisant des poids binaires. Pour éviter un avertissement dans R, nous spécifions que les noms des lignes et des colonnes de cette matrice doivent être égaux aux identifiants associés à chaque unité (`RLS_code`). Ensuite, nous ajoutons un terme `adjacency(1 | RLS_code)` au modèle pour spécifier que la variation résiduelle entre les différents groupes définis par `RLS_code` est spatialement corrélée avec une structure CAR (ici, chaque groupe n'a qu'une observation puisque nous avons un point de données par unité RLS).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-178_c3221c2defe378081625dfcfb8bdbe89'}\n\n```{.r .cell-code}\nlibrary(spaMM)\n\nrls_mat <- nb2mat(rls_nb, style = \"B\")\nrownames(rls_mat) <- rls_covid$RLS_code\ncolnames(rls_mat) <- rls_covid$RLS_code\n\nrls_spamm <- fitme(cas ~ log(dens_pop) + offset(log(pop)) + adjacency(1 | RLS_code),\n data = rls_covid, adjMatrix = rls_mat, family = poisson)\nsummary(rls_spamm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: cas ~ log(dens_pop) + offset(log(pop)) + adjacency(1 | RLS_code)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: poisson( link = log ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) -5.1618 0.16855 -30.625\nlog(dens_pop) 0.1999 0.03267 6.119\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.rho \n0.1576605 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n RLS_code : 0.266 \n# of obs: 95; # of groups: RLS_code, 95 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -709.3234\n```\n:::\n:::\n\n\nNotez que le coefficient de corrélation spatiale `rho` (0.158) est similaire à la quantité équivalente dans le modèle `spautolm` ci-dessus, où il était appelé `Lambda`. L'effet de `log(dens_pop)` est également d'environ 0.2 dans les deux modèles.\n\n\n## Référence\n\nMoraga, Paula (2019) Geospatial Health Data: Modeling and Visualization with R-INLA and Shiny. Chapman & Hall/CRC Biostatistics Series. Disponible en ligne: [https://www.paulamoraga.com/book-geospatial/](https://www.paulamoraga.com/book-geospatial/). \n",
+ "markdown": "---\ntitle: \"4-Day Training in Spatial Statistics with Philippe Marchand\"\ndescription: |\n Training session about statistical analysis of spatial data in ecology, hosted by Philippe Marchand (UQAT). | \n Session de formation sur l’analyse statistique des données spatiales en écologie, animée par Pr. Philippe Marchand (UQAT).\nauthor: Philippe Marchand\ncategories: [FR, EN, Technical]\ndate: \"2021-01-12\"\nimage: image.jpg\ntoc: true\nnumber-sections: true\nnumber-depth: 1\nexecute:\n freeze: true\n cache: true\n---\n\n\nVersion en français [à la suite](#statistiques-spatiales-en-écologie).\n\n# Spatial statistics in ecology\n\nBIOS² hosted an online training session about statistical analysis of spatial data in ecology, led by Pr. Philippe Marchand (UQAT). This 12-hour training was conducted in 4 sessions: January 12, 14, 19 & 21 (2021) from 1:00 to 4:00 pm EST.\n\nThe content included three types of spatial statistical analyses and their applications to ecology: (1) point pattern analysis to study the distribution of individuals or events in space; (2) geostatistical models to represent the spatial correlation of variables sampled at geolocated points; and (3) areal data models, which apply to measurements taken on areas in space and model spatial relationships as networks of neighbouring regions. The training also included practical exercises using the R statistical programming environment.\n\n[Philippe Marchand](https://github.com/pmarchand1) is a professor in ecology and biostatistics at Institut de recherche sur les forêts, Université du Québec en Abitibi-Témiscamingue (UQAT) and BIOS² academic member. His research focuses on modeling processes that influence the spatial distribution of populations, including: seed dispersal and seedling establishment, animal movement, and the spread of forest diseases.\n\n**If you wish to consult the lesson materials and follow the exercises at your own pace, you can access them through [this link](https://bios2.github.io/Marchand.html#category:EN). Basic knowledge of linear regression models and experience fitting them in R is recommended. Original repository can be found [here](https://github.com/pmarchand1/BIOS2-spatial-stats).**\n\n## Course outline\n\n| Day | Topics (EN) |\n|-----------------|:--------------------------|\n| 1 | • [Introduction to spatial statistics](#introduction) • [Point pattern analysis](#point-pattern) |\n| 2 | • [Spatial correlation](#spatial-correlation) • [Geostatistical models](#geostat-models) |\n| 3 | • [Areal data](#areal-data) • [Moran's I](#moran-i) • [Spatial autoregression models](#spatial-autoreg) • [Analysis of areal data in R](#analysis-areal) |\n| 4 | • [GLMM with spatial Gaussian process](#glmm-spatial-gaussian) • [GLMM with spatial autoregression](#glmm-spatial-autoreg) |\n\n\n# Introduction to spatial statistics {#introduction}\n\n## Types of spatial analyses\n\nIn this training, we will discuss three types of spatial analyses: point pattern analysis, geostatistical models and models for areal data.\n\nIn **point pattern analysis**, we have point data representing the position of individuals or events in a study area and we assume that all individuals or events have been identified in that area. That analysis focuses on the distribution of the positions of the points themselves. Here are some typical questions for the analysis of point patterns:\n\n- Are the points randomly arranged or clustered?\n\n- Are two types of points arranged independently?\n\n**Geostatistical models** represent the spatial distribution of continuous variables that are measured at certain sampling points. They assume that measurements of those variables at different points are correlated as a function of the distance between the points. Applications of geostatistical models include the smoothing of spatial data (e.g., producing a map of a variable over an entire region based on point measurements) and the prediction of those variables for non-sampled points.\n\n**Areal data** are measurements taken not at points, but for regions of space represented by polygons (e.g. administrative divisions, grid cells). Models representing these types of data define a network linking each region to its neighbours and include correlations in the variable of interest between neighbouring regions.\n\n## Stationarity and isotropy\n\nSeveral spatial analyses assume that the variables are **stationary** in space. As with stationarity in the time domain, this property means that summary statistics (mean, variance and correlations between measures of a variable) do not vary with translation in space. For example, the spatial correlation between two points may depend on the distance between them, but not on their absolute position.\n\nIn particular, there cannot be a large-scale trend (often called *gradient* in a spatial context), or this trend must be taken into account before modelling the spatial correlation of residuals.\n\nIn the case of point pattern analysis, stationarity (also called homogeneity) means that point density does not follow a large-scale trend.\n\nIn a **isotropic** statistical model, the spatial correlations between measurements at two points depend only on the distance between the points, not on the direction. In this case, the summary statistics do not change under a spatial rotation of the data.\n\n## Georeferenced data\n\nEnvironmental studies increasingly use data from geospatial data sources, i.e. variables measured over a large part of the globe (e.g. climate, remote sensing). The processing of these data requires concepts related to Geographic Information Systems (GIS), which are not covered in this workshop, where we focus on the statistical aspects of spatially varying data.\n\nThe use of geospatial data does not necessarily mean that spatial statistics are required. For example, we will often extract values of geographic variables at study points to explain a biological response observed in the field. In this case, the use of spatial statistics is only necessary when there is a spatial correlation in the residuals, after controlling for the effect of the predictors.\n\n# Point pattern analysis {#point-pattern}\n\n## Point pattern and point process\n\nA *point pattern* describes the spatial position (most often in 2D) of individuals or events, represented by points, in a given study area, often called the observation \"window\".\n\nIt is assumed that each point has a negligible spatial extent relative to the distances between the points. More complex methods exist to deal with spatial patterns of objects that have a non-negligible width, but this topic is beyond the scope of this workshop.\n\nA *point process* is a statistical model that can be used to simulate point patterns or explain an observed point pattern.\n\n## Complete spatial randomness\n\nComplete spatial randomness (CSR) is one of the simplest point patterns, which serves as a null model for evaluating the characteristics of real point patterns. In this pattern, the presence of a point at a given position is independent of the presence of points in a neighbourhood.\n\nThe process creating this pattern is a homogeneous Poisson process. According to this model, the number of points in any area $A$ follows a Poisson distribution: $N(A) \\sim \\text{Pois}(\\lambda A)$, where $\\lambda$ is the *intensity* of the process (i.e. the density of points per unit area). $N$ is independent between two disjoint regions, no matter how those regions are defined.\n\nIn the graph below, only the pattern on the right is completely random. The pattern on the left shows point aggregation (higher probability of observing a point close to another point), while the pattern in the center shows repulsion (low probability of observing a point very close to another).\n\n\n\n\n::: {.cell fig.dim='[9,3]' hash='index_cache/html/unnamed-chunk-2_c019229dfeb24b4b22a136e6b038583d'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\n## Exploratory or inferential analysis for a point pattern\n\nSeveral summary statistics are used to describe the characteristics of a point pattern. The simplest is the intensity $\\lambda$, which as mentioned above represents the density of points per unit area. If the point pattern is heterogeneous, the intensity is not constant, but depends on the position: $\\lambda(x, y)$.\n\nCompared to intensity, which is a first-order statistic, second-order statistics describe how the probability of the presence of a point in a region depends on the presence of other points. The Ripley's $K$ function presented in the next section is an example of a second-order summary statistic.\n\nStatistical inferences on point patterns usually consist of testing the hypothesis that the point pattern corresponds to a given null model, such as CSR or a more complex null model. Even for the simplest null models, we rarely know the theoretical distribution for a summary statistic of the point pattern under the null model. Hypothesis tests on point patterns are therefore performed by simulation: a large number of point patterns are simulated from the null model and the distribution of the summary statistics of interest for these simulations is compared to their values for the observed point pattern.\n\n## Ripley's K function\n\nRipley's K function $K(r)$ is defined as the mean number of points within a circle of radius $r$ around a point in the pattern, standardized by the intensity $\\lambda$.\n\nUnder the CSR null model, the mean number of points in any circle of radius $r$ is $\\lambda \\pi r^2$, thus in theory $K(r) = \\pi r^2$ for that model. A higher value of $K(r)$ means that there is an aggregation of points at the scale $r$, whereas a lower value means that there is repulsion.\n\nIn practice, $K(r)$ is estimated for a specific point pattern by the equation:\n\n$$ K(r) = \\frac{A}{n(n-1)} \\sum_i \\sum_{j > i} I \\left( d_{ij} \\le r \\right) w_{ij}$$\n\nwhere $A$ is the area of the observation window and $n$ is the number of points in the pattern, so $n(n-1)$ is the number of distinct pairs of points. We take the sum for all pairs of points of the indicator function $I$, which takes a value of 1 if the distance between points $i$ and $j$ is less than or equal to $r$. Finally, the term $w_{ij}$ is used to give extra weight to certain pairs of points to account for edge effects, as discussed in the next section.\n\nFor example, the graphs below show the estimated $K(r)$ function for the patterns shown above, for values of $r$ up to 1/4 of the window width. The red dashed curve shows the theoretical value for CSR and the gray area is an \"envelope\" produced by 99 simulations of that null pattern. The aggregated pattern shows an excess of neighbours up to $r = 0.25$ and the pattern with repulsion shows a significant deficit of neighbours for small values of $r$.\n\n\n\n\n::: {.cell fig.dim='[9,3]' hash='index_cache/html/unnamed-chunk-4_93b9963febba16ed4365408bd10b6c70'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\nIn addition to $K$, there are other statistics to describe the second-order properties of point patterns, such as the mean distance between a point and its nearest $N$ neighbours. You can refer to the Wiegand and Moloney (2013) textbook in the references to learn more about different summary statistics for point patterns.\n\n## Edge effects\n\nIn the context of point pattern analysis, edge effects are due to the fact that we have incomplete knowledge of the neighbourhood of points near the edge of the observation window, which can induce a bias in the calculation of statistics such as Ripley's $K$.\n\nDifferent methods have been developed to correct the bias due to edge effects. In Ripley's edge correction method, the contribution of a neighbour $j$ located at a distance $r$ from a point $i$ receives a weight $w_{ij} = 1/\\phi_i(r)$, where $\\phi_i(r)$ is the fraction of the circle of radius $r$ around $i$ contained in the observation window. For example, if 2/3 of the circle is in the window, this neighbour counts as 3/2 neighbours in the calculation of a statistic like $K$.\n\n\n\nRipley's method is one of the simplest to correct for edge effects, but is not necessarily the most efficient; in particular, larger weights given to certain pairs of points tend to increase the variance of the calculated statistic. Other correction methods are presented in specialized textbooks, such as Wiegand and Moloney (2013).\n\n## Example\n\nFor this example, we use the dataset [semis_xy.csv](data/semis_xy.csv), which represents the $(x, y)$ coordinates for seedlings of two species (*sp*, B = birch and P = poplar) in a 15 x 15 m plot.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-5_0f8146040b7a6a70fa3c497cc0385db2'}\n\n```{.r .cell-code}\nsemis <- read.csv(\"data/semis_xy.csv\")\nhead(semis)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n x y sp\n1 14.73 0.05 P\n2 14.72 1.71 P\n3 14.31 2.06 P\n4 14.16 2.64 P\n5 14.12 4.15 B\n6 9.88 4.08 B\n```\n:::\n:::\n\n\nThe *spatstat* package provides tools for point pattern analysis in R. The first step consists in transforming our data frame into a `ppp` object (point pattern) with the function of the same name. In this function, we specify which columns contain the coordinates *x* and *y* as well as the *marks*, which here will be the species codes. We also need to specify an observation window (`window`) using the `owin` function, where we provide the plot limits in *x* and *y*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-6_57149b36e4a5be5442a99b8f45b2dbdd'}\n\n```{.r .cell-code}\nlibrary(spatstat)\n\nsemis <- ppp(x = semis$x, y = semis$y, marks = as.factor(semis$sp),\n window = owin(xrange = c(0, 15), yrange = c(0, 15)))\nsemis\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nMarked planar point pattern: 281 points\nMultitype, with levels = B, P \nwindow: rectangle = [0, 15] x [0, 15] units\n```\n:::\n:::\n\n\nMarks can be numeric or categorical. Note that for categorical marks as is the case here, the variable must be explicitly converted to a factor.\n\nThe `plot` function applied to a point pattern shows a diagram of the pattern.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-7_ba656f4aa5befb58b9e9845ae787d99d'}\n\n```{.r .cell-code}\nplot(semis)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe `intensity` function calculates the density of points of each species by unit area (here, by $m^2$).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-8_0b22d4b3b39bd4dc862f8c161efb9330'}\n\n```{.r .cell-code}\nintensity(semis)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n B P \n0.6666667 0.5822222 \n```\n:::\n:::\n\n\nTo first analyze the distribution of each species separately, we split the pattern with `split`. Since the pattern contains categorical marks, it is automatically split according to the values of those marks. The result is a list of two point patterns.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-9_5ff3f6384afcf7ed706bbf891accd2fa'}\n\n```{.r .cell-code}\nsemis_split <- split(semis)\nplot(semis_split)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe `Kest` function calculates Ripley's $K$ for a series of distances up to (by default) 1/4 of the width of the window. Here we apply it to the first pattern (birch) by choosing `semis_split[[1]]`. Note that double square brackets are necessary to choose an item from a list in R.\n\nThe argument `correction = \"iso\"` tells the function to apply Ripley's correction for edge effects.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-10_67e4bd9ed190d1af69a48250adb1bc3d'}\n\n```{.r .cell-code}\nk <- Kest(semis_split[[1]], correction = \"iso\")\nplot(k)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nAccording to this graph, there seems to be an excess of neighbours for distances of 1 m and above. To check if this is a significant difference, we produce a simulation envelope with the `envelope` function. The first argument of `envelope` is a point pattern to which the simulations will be compared, the second one is a function to be computed (here, `Kest`) for each simulated pattern, then we add the arguments of the `Kest` function (here, only `correction`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-11_ebe814599d9537b0a51121b965182658'}\n\n```{.r .cell-code}\nplot(envelope(semis_split[[1]], Kest, correction = \"iso\"))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 99 simulations of CSR ...\n1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,\n41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,\n81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nAs indicated by the message, by default the function performs 99 simulations of the null model corresponding to complete spatial randomness (CSR).\n\nThe observed curve falls outside the envelope of the 99 simulations near $r = 2$. We must be careful not to interpret too quickly a result that is outside the envelope. Although there is about a 1% probability of obtaining a more extreme result under the null hypothesis at a given distance, the envelope is calculated for a large number of values of $r$ and is not corrected for multiple comparisons. Thus, a significant difference for a very small range of values of $r$ may be simply due to chance.\n\n### Exercise 1\n\nLooking at the graph of the second point pattern (poplar seedlings), can you predict where Ripley's $K$ will be in relation to the null hypothesis of complete spatial randomness? Verify your prediction by calculating Ripley's $K$ for this point pattern in R.\n\n## Effect of heterogeneity\n\nThe graph below illustrates a *heterogeneous* point pattern, i.e. it shows an density gradient (more points on the left than on the right).\n\n\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-13_36849871c75ced31ddf5bd09edb7ace9'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nA density gradient can be confused with an aggregation of points, as can be seen on the graph of the corresponding Ripley's $K$. In theory, these are two different processes:\n\n- Heterogeneity: The density of points varies in the study area, for example due to the fact that certain local conditions are more favorable to the presence of the species of interest.\n\n- Aggregation: The mean density of points is homogeneous, but the presence of one point increases the presence of other points in its vicinity, for example due to positive interactions between individuals.\n\nHowever, it may be difficult to differentiate between the two in practice, especially since some patterns may be both heterogeneous and aggregated.\n\nLet's take the example of the poplar seedlings from the previous exercise. The `density` function applied to a point pattern performs a kernel density estimation of the density of the seedlings across the plot. By default, this function uses a Gaussian kernel with a standard deviation `sigma` specified in the function, which determines the scale at which density fluctuations are \"smoothed\". Here, we use a value of 2 m for `sigma` and we first represent the estimated density with `plot`, before overlaying the points (`add = TRUE` means that the points are added to the existing plot rather than creating a new plot).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-14_3332987af85b2014bbebfa360ce15a9b'}\n\n```{.r .cell-code}\ndens_p <- density(semis_split[[2]], sigma = 2)\nplot(dens_p)\nplot(semis_split[[2]], add = TRUE)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nTo measure the aggregation or repulsion of points in a heterogeneous pattern, we must use the inhomogeneous version of the $K$ statistic (`Kinhom` in *spatstat*). This statistic is still equal to the mean number of neighbours within a radius $r$ of a point in the pattern, but rather than standardizing this number by the overall intensity of the pattern, it is standardized by the local estimated density. As above, we specify `sigma = 2` to control the level of smoothing for the varying density estimate.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-15_f82857163481aaf3f03a5dd201df8615'}\n\n```{.r .cell-code}\nplot(Kinhom(semis_split[[2]], sigma = 2, correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nTaking into account the heterogeneity of the pattern at a scale `sigma` of 2 m, there seems to be a deficit of neighbours starting at a radius of about 1.5 m. We can now check whether this deviation is significant.\n\nAs before, we use `envelope` to simulate the `Kinhom` statistic under the null model. However, the null model here is not a homogeneous Poisson process (CSR). It is instead a heterogeneous Poisson process simulated by the function `rpoispp(dens_p)`, i.e. the points are independent of each other, but their density is heterogeneous and given by `dens_p`. The `simulate` argument of the `envelope` function specifies the function used for simulations under the null model; this function must have one argument, here `x`, even if it is not used.\n\nFinally, in addition to the arguments needed for `Kinhom`, i.e. `sigma` and `correction`, we also specify `nsim = 199` to perform 199 simulations and `nrank = 5` to eliminate the 5 most extreme results on each side of the envelope, i.e. the 10 most extreme results out of 199, to achieve an interval containing about 95% of the probability under the null hypothesis.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-16_7119c82106369cf2aa8fe32fff918b5e'}\n\n```{.r .cell-code}\nkhet_p <- envelope(semis_split[[2]], Kinhom, sigma = 2, correction = \"iso\",\n nsim = 199, nrank = 5, simulate = function(x) rpoispp(dens_p))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(khet_p)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n*Note*: For a hypothesis test based on simulations of a null hypothesis, the $p$-value is estimated by $(m + 1)/(n + 1)$, where $n$ is the number of simulations and $m$ is the number of simulations where the value of the statistic is more extreme than that of the observed data. This is why the number of simulations is often chosen to be 99, 199, etc.\n\n### Exercise 2\n\nRepeat the heterogeneous density estimation and `Kinhom` calculation with a standard deviation `sigma` of 5 rather than 2. How does the smoothing level for the density estimation influence the conclusions?\n\nTo differentiate between a variation in the density of points from an interaction (aggregation or repulsion) between these points with this type of analysis, it is generally assumed that the two processes operate at different scales. Typically, we can test whether the points are aggregated at a small scale after accounting for a variation in density at a larger scale.\n\n## Relationship between two point patterns\n\nLet's consider a case where we have two point patterns, for example the position of trees of two species in a plot (orange and green points in the graph below). Each of the two patterns may or may not present an aggregation of points.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-17_b4289a87928bcb641b5e8e2bd2b6abf1'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nRegardless of whether points are aggregated at the species level, we want to determine whether the two species are arranged independently. In other words, does the probability of observing a tree of one species depend on the presence of a tree of the other species at a given distance?\n\nThe bivariate version of Ripley's $K$ allows us to answer this question. For two patterns noted 1 and 2, the function $K_{12}(r)$ calculates the mean number of points in pattern 2 within a radius $r$ from a point in pattern 1, standardized by the density of pattern 2.\n\nIn theory, this function is symmetrical, so $K_{12}(r) = K_{21}(r)$ and the result would be the same whether the points of pattern 1 or 2 are chosen as \"focal\" points for the analysis. However, the estimation of the two quantities for an observed pattern may differ, in particular because of edge effects. The variance of $K_{12}$ and $K_{21}$ between simulations of a null model may also differ, so the null hypothesis test may have more or less power depending on the choice of the focal species.\n\nThe choice of an appropriate null model is important here. In order to determine whether there is a significant attraction or repulsion between the two patterns, the position of one of the patterns must be randomly moved relative to that of the other pattern, while keeping the spatial structure of each pattern taken in isolation.\n\nOne way to do this randomization is to shift one of the two patterns horizontally and/or vertically by a random distance. The part of the pattern that \"comes out\" on one side of the window is attached to the other side. This method is called a toroidal shift, because by connecting the top and bottom as well as the left and right of a rectangular surface, we obtain the shape of a torus (a three-dimensional \"donut\").\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-18_2719c0934b27fb43697dae326b9542d1'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe graph above shows a translation of the green pattern to the right, while the orange pattern remains in the same place. The green points in the shaded area are brought back on the other side. Note that while this method generally preserves the structure of each pattern while randomizing their relative position, it can have some drawbacks, such as dividing point clusters that are near the cutoff point.\n\nLet's now check whether the position of the two species (birch and poplar) is independent in our plot. The function `Kcross` calculates the bivariate $K_{ij}$, we must specify which type of point (mark) is considered as the focal species $i$ and the neighbouring species $j$.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-19_4dcee95d46a21e9800bad80559da1926'}\n\n```{.r .cell-code}\nplot(Kcross(semis, i = \"P\", j = \"B\", correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nHere, the observed $K$ is lower than the theoretical value, indicating a possible repulsion between the two patterns.\n\nTo determine the envelope of the $K$ under the null hypothesis of independence of the two patterns, we must specify that the simulations are based on a translation of the patterns. We indicate that the simulations use the function `rshift` (random translation) with the argument `simulate = function(x) rshift(x, which = \"B\")`; here, the `x` argument in `simulate` corresponds to the original point pattern and the `which` argument indicates which of the patterns is translated. As in the previous case, the arguments needed for `Kcross`, i.e. `i`, `j` and `correction`, must be repeated in the `envelope` function.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-20_0ac003a9d3ff5047aa7ab53d990626d2'}\n\n```{.r .cell-code}\nplot(envelope(semis, Kcross, i = \"P\", j = \"B\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = function(x) rshift(x, which = \"B\")))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nHere, the observed curve is totally within the envelope, so we do not reject the null hypothesis of independence of the two patterns.\n\n### Questions\n\n1. What would be one reason for our choice to translate the points of the birch rather than poplar?\n\n2. Would the simulations generated by random translation be a good null model if the two patterns were heterogeneous?\n\n## Marked point patterns\n\nThe [fir.csv](data/fir.csv) dataset contains the $(x, y)$ coordinates of 822 fir trees in a 1 hectare plot and their status (A = alive, D = dead) following a spruce budworm outbreak.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-21_facfc5f20aa18027ead60eade7d1f3e8'}\n\n```{.r .cell-code}\nfir <- read.csv(\"data/fir.csv\")\nhead(fir)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n x y status\n1 31.50 1.00 A\n2 85.25 30.75 D\n3 83.50 38.50 A\n4 84.00 37.75 A\n5 83.00 33.25 A\n6 33.25 0.25 A\n```\n:::\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-22_8ca66569ad633346ebe5c4d72856947e'}\n\n```{.r .cell-code}\nfir <- ppp(x = fir$x, y = fir$y, marks = as.factor(fir$status),\n window = owin(xrange = c(0, 100), yrange = c(0, 100)))\nplot(fir)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nSuppose that we want to check whether fir mortality is independent or correlated between neighbouring trees. How does this question differ from the previous example, where we wanted to know if the position of the points of two species was independent?\n\nIn the previous example, the independence or interaction between the species referred to the formation of the pattern itself (whether or not seedlings of one species establish near those of the other species). Here, the characteristic of interest (survival) occurs after the establishment of the pattern, assuming that all those trees were alive at first and that some died as a result of the outbreak. So we take the position of the trees as fixed and we want to know whether the distribution of status (dead, alive) among those trees is random or shows a spatial pattern.\n\nIn Wiegand and Moloney's textbook, the first situation (establishment of seedlings of two species) is called a bivariate pattern, so it is really two interacting patterns, while the second is a single pattern with a qualitative *mark*. The *spatstat* package in R does not differentiate between the two in terms of pattern definition (types of points are always represented by the `marks` argument), but the analysis methods applied to the two questions differ.\n\nIn the case of a pattern with a qualitative mark, we can define a *mark connection function* $p_{ij}(r)$. For two points separated by a distance $r$, this function gives the probability that the first point has the mark $i$ and the second the mark $j$. Under the null hypothesis where the marks are independent, this probability is equal to the product of the proportions of each mark in the entire pattern, $p_{ij}(r) = p_i p_j$ independently of $r$.\n\nIn *spatstat*, the mark connection function is computed with the `markconnect` function, where the marks $i$ and $j$ and the type of edge correction must be specified. In our example, we see that two closely spaced points are less likely to have a different status (A and D) than expected under the assumption of random and independent distribution of marks (red dotted line).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-23_ea3bee43b75cb2228264e2bba732134d'}\n\n```{.r .cell-code}\nplot(markconnect(fir, i = \"A\", j = \"D\", correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIn this graph, the fluctuations in the function are due to the estimation error of a continuous $r$ function from a limited number of discrete point pairs.\n\nTo simulate the null model in this case, we use the `rlabel` function, which randomly reassigns the marks among the points of the pattern, keeping the points' positions fixed.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-24_b5961fa24a7b5816b3a04f809a6a674c'}\n\n```{.r .cell-code}\nplot(envelope(fir, markconnect, i = \"A\", j = \"D\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNote that since the `rlabel` function has only one required argument corresponding to the original point pattern, it was not necessary to specify: `simulate = function(x) rlabel(x)`.\n\nHere are the results for tree pairs of the same status A or D:\n\n\n::: {.cell fig.dim='[10,5]' hash='index_cache/html/unnamed-chunk-25_b52d50f419fba628767a4e51fec12988'}\n\n```{.r .cell-code}\npar(mfrow = c(1, 2))\nplot(envelope(fir, markconnect, i = \"A\", j = \"A\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(envelope(fir, markconnect, i = \"D\", j = \"D\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=960}\n:::\n:::\n\n\nIt therefore appears that fir mortality due to this outbreak is spatially aggregated, since trees located in close proximity to each other have a greater probability of sharing the same status than predicted by the null hypothesis.\n\n## References\n\nFortin, M.-J. and Dale, M.R.T. (2005) *Spatial Analysis: A Guide for Ecologists*. Cambridge University Press: Cambridge, UK.\n\nWiegand, T. and Moloney, K.A. (2013) *Handbook of Spatial Point-Pattern Analysis in Ecology*, CRC Press.\n\nThe dataset in the last example is a subet of the Lake Duparquet Research and Teaching Forest (LDRTF) data, available on Dryad [here](https://doi.org/10.5061/dryad.tqjq2bvwz).\n\n# Solutions\n\n### Exercise 1\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-26_b3fd18c8b6c242843edf3836d1967112'}\n\n```{.r .cell-code}\nplot(envelope(semis_split[[2]], Kest, correction = \"iso\"))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 99 simulations of CSR ...\n1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,\n41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,\n81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nPoplar seedlings seem to be significantly aggregated according to the $K$ function.\n\n### Exercise 2\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-27_acce28ca3e937720b0224ba60b6c233b'}\n\n```{.r .cell-code}\ndens_p <- density(semis_split[[2]], sigma = 5)\nplot(dens_p)\nplot(semis_split[[2]], add = TRUE)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nkhet_p <- envelope(semis_split[[2]], Kinhom, sigma = 5, correction = \"iso\",\n nsim = 199, nrank = 5, simulate = function(x) rpoispp(dens_p))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(khet_p)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nHere, as we estimate density variations at a larger scale, even after accounting for this variation, the poplar seedlings seem to be aggregated at a small scale.\n\n# Spatial correlation of a variable {#spatial-correlation}\n\n\n\n\n\nCorrelation between measurements of a variable taken at nearby points often occurs in environmental data. This principle is sometimes referred to as the \"first law of geography\" and is expressed in the following quote from Waldo Tobler: \"Everything is related to everything else, but near things are more related than distant things\".\n\nIn statistics, we often refer to *autocorrelation* as the correlation between measurements of the same variable taken at different times (temporal autocorrelation) or places (spatial autocorrelation).\n\n## Intrinsic or induced dependence\n\nThere are two basic types of spatial dependence on a measured variable $y$: an *intrinsic* dependence on $y$, or a dependence *induced* by external variables influencing $y$, which are themselves spatially correlated.\n\nFor example, suppose that the abundance of a species is correlated between two sites located near each other:\n\n- this spatial dependence can be induced if it is due to a spatial correlation of habitat factors that are favorable or unfavorable to the species;\n\n- or it can be intrinsic if it is due to the dispersion of individuals to nearby sites.\n\nIn many cases, both types of dependence affect a given variable.\n\nIf the dependence is simply induced and the external variables that cause it are included in the model explaining $y$, then the model residuals will be independent and we can use all the methods already seen that ignore spatial correlation.\n\nHowever, if the dependence is intrinsic or due to unmeasured external factors, then the spatial correlation of the residuals in the model will have to be taken into account.\n\n## Different ways to model spatial effects\n\nIn this training, we will directly model the spatial correlations of our data. It is useful to compare this approach to other ways of including spatial aspects in a statistical model.\n\nFirst, we could include predictors in the model that represent position (e.g., longitude, latitude). Such predictors may be useful for detecting a systematic large-scale trend or gradient, whether or not the trend is linear (e.g., with a generalized additive model).\n\nIn contrast to this approach, the models we will see now serve to model a spatial correlation in the random fluctuations of a variable (i.e., in the residuals after removing any systematic effect).\n\nMixed models use random effects to represent the non-independence of data on the basis of their grouping, i.e., after accounting for systematic fixed effects, data from the same group are more similar (their residual variation is correlated) than data from different groups. These groups were sometimes defined according to spatial criteria (observations grouped into sites).\n\nHowever, in the context of a random group effect, all groups are as different from each other, e.g., two sites within 100 km of each other are no more or less similar than two sites 2 km apart.\n\nThe methods we will see here and in the next parts of the training therefore allow us to model non-independence on a continuous scale (closer = more correlated) rather than just discrete (hierarchy of groups).\n\n# Geostatistical models {#geostat-models}\n\nGeostatistics refers to a group of techniques that originated in the earth sciences. Geostatistics is concerned with variables that are continuously distributed in space and where a number of points are sampled to estimate this distribution. A classic example of these techniques comes from the mining field, where the aim was to create a map of the concentration of ore at a site from samples taken at different points on the site.\n\nFor these models, we will assume that $z(x, y)$ is a stationary spatial variable measured at points with coordinates $x$ and $y$.\n\n## Variogram\n\nA central aspect of geostatistics is the estimation of the variogram $\\gamma_z$ . The variogram is equal to half the mean square difference between the values of $z$ for two points $(x_i, y_i)$ and $(x_j, y_j)$ separated by a distance $h$.\n\n$$\\gamma_z(h) = \\frac{1}{2} \\text{E} \\left[ \\left( z(x_i, y_i) - z(x_j, y_j) \\right)^2 \\right]_{d_{ij} = h}$$\n\nIn this equation, the $\\text{E}$ function with the index $d_{ij}=h$ designates the statistical expectation (i.e., the mean) of the squared deviation between the values of $z$ for points separated by a distance $h$.\n\nIf we want instead to express the autocorrelation $\\rho_z(h)$ between measures of $z$ separated by a distance $h$, it is related to the variogram by the equation:\n\n$$\\gamma_z = \\sigma_z^2(1 - \\rho_z)$$ ,\n\nwhere $\\sigma_z^2$ is the global variance of $z$.\n\nNote that $\\gamma_z = \\sigma_z^2$ when we reach a distance where the measurements of $z$ are independent, so $\\rho_z = 0$. In this case, we can see that $\\gamma_z$ is similar to a variance, although it is sometimes called \"semivariogram\" or \"semivariance\" because of the 1/2 factor in the above equation.\n\n## Theoretical models for the variogram\n\nSeveral parametric models have been proposed to represent the spatial correlation as a function of the distance between sampling points. Let us first consider a correlation that decreases exponentially:\n\n$$\\rho_z(h) = e^{-h/r}$$\n\nHere, $\\rho_z = 1$ for $h = 0$ and the correlation is multiplied by $1/e \\approx 0.37$ each time the distance increases by $r$. In this context, $r$ is called the *range* of the correlation.\n\nFrom the above equation, we can calculate the corresponding variogram.\n\n$$\\gamma_z(h) = \\sigma_z^2 (1 - e^{-h/r})$$\n\nHere is a graphical representation of this variogram.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-28_db8b05730133a816cb7d6c558cbd7757'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nBecause of the exponential function, the value of $\\gamma$ at large distances approaches the global variance $\\sigma_z^2$ without exactly reaching it. This asymptote is called a *sill* in the geostatistical context and is represented by the symbol $s$.\n\nFinally, it is sometimes unrealistic to assume a perfect correlation when the distance tends towards 0, because of a possible variation of $z$ at a very small scale. A *nugget* effect, denoted $n$, can be added to the model so that $\\gamma$ approaches $n$ (rather than 0) if $h$ tends towards 0. The term nugget comes from the mining origin of these techniques, where a nugget could be the source of a sudden small-scale variation in the concentration of a mineral.\n\nBy adding the nugget effect, the remainder of the variogram is \"compressed\" to keep the same sill, resulting in the following equation.\n\n$$\\gamma_z(h) = n + (s - n) (1 - e^{-h/r})$$\n\nIn the *gstat* package that we use below, the term $(s-n)$ is called a *partial sill* or `psill` for the exponential portion of the variogram.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-29_76ce196068f7afb370f9fcd84ff0bf2d'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIn addition to the exponential model, two other common theoretical models for the variogram are the Gaussian model (where the correlation follows a half-normal curve), and the spherical model (where the variogram increases linearly at the start and then curves and reaches the plateau at a distance equal to its range $r$). The spherical model thus allows the correlation to be exactly 0 at large distances, rather than gradually approaching zero in the case of the other models.\n\n| Model | $\\rho(h)$ | $\\gamma(h)$ |\n|------------------|-------------------------|-----------------------------|\n| Exponential | $\\exp\\left(-\\frac{h}{r}\\right)$ | $s \\left(1 - \\exp\\left(-\\frac{h}{r}\\right)\\right)$ |\n| Gaussian | $\\exp\\left(-\\frac{h^2}{r^2}\\right)$ | $s \\left(1 - \\exp\\left(-\\frac{h^2}{r^2}\\right)\\right)$ |\n| Spherical $(h < r)$ \\* | $1 - \\frac{3}{2}\\frac{h}{r} + \\frac{1}{2}\\frac{h^3}{r^3}$ | $s \\left(\\frac{3}{2}\\frac{h}{r} - \\frac{1}{2}\\frac{h^3}{r^3} \\right)$ |\n\n\\* For the spherical model, $\\rho = 0$ and $\\gamma = s$ if $h \\ge r$.\n\n\n::: {.cell fig.dim='[9,4]' hash='index_cache/html/unnamed-chunk-30_36d08077ec0b54caf8dbcbb8751648be'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\n## Empirical variogram\n\nTo estimate $\\gamma_z(h)$ from empirical data, we need to define distance classes, thus grouping different distances within a margin of $\\pm \\delta$ around a distance $h$, then calculating the mean square deviation for the pairs of points in that distance class.\n\n$$\\hat{\\gamma_z}(h) = \\frac{1}{2 N_{\\text{paires}}} \\sum \\left[ \\left( z(x_i, y_i) - z(x_j, y_j) \\right)^2 \\right]_{d_{ij} = h \\pm \\delta}$$\n\nWe will see in the next section how to estimate a variogram in R.\n\n## Regression model with spatial correlation\n\nThe following equation represents a multiple linear regression including residual spatial correlation:\n\n$$v = \\beta_0 + \\sum_i \\beta_i u_i + z + \\epsilon$$\n\nHere, $v$ designates the response variable and $u$ the predictors, to avoid confusion with the spatial coordinates $x$ and $y$.\n\nIn addition to the residual $\\epsilon$ that is independent between observations, the model includes a term $z$ that represents the spatially correlated portion of the residual variance.\n\nHere are suggested steps to apply this type of model:\n\n1. Fit the regression model without spatial correlation.\n\n2. Verify the presence of spatial correlation from the empirical variogram of the residuals.\n\n3. Fit one or more regression models with spatial correlation and select the one that shows the best fit to the data.\n\n# Geostatistical models in R\n\nThe *gstat* package contains functions related to geostatistics. For this example, we will use the `oxford` dataset from this package, which contains measurements of physical and chemical properties for 126 soil samples from a site, along with their coordinates `XCOORD` and `YCOORD`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-31_d42a00ecb66d27e6d127659ed2dfd66c'}\n\n```{.r .cell-code}\nlibrary(gstat)\n\ndata(oxford)\nstr(oxford)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n'data.frame':\t126 obs. of 22 variables:\n $ PROFILE : num 1 2 3 4 5 6 7 8 9 10 ...\n $ XCOORD : num 100 100 100 100 100 100 100 100 100 100 ...\n $ YCOORD : num 2100 2000 1900 1800 1700 1600 1500 1400 1300 1200 ...\n $ ELEV : num 598 597 610 615 610 595 580 590 598 588 ...\n $ PROFCLASS: Factor w/ 3 levels \"Cr\",\"Ct\",\"Ia\": 2 2 2 3 3 2 3 2 3 3 ...\n $ MAPCLASS : Factor w/ 3 levels \"Cr\",\"Ct\",\"Ia\": 2 3 3 3 3 2 2 3 3 3 ...\n $ VAL1 : num 3 3 4 4 3 3 4 4 4 3 ...\n $ CHR1 : num 3 3 3 3 3 2 2 3 3 3 ...\n $ LIME1 : num 4 4 4 4 4 0 2 1 0 4 ...\n $ VAL2 : num 4 4 5 8 8 4 8 4 8 8 ...\n $ CHR2 : num 4 4 4 2 2 4 2 4 2 2 ...\n $ LIME2 : num 4 4 4 5 5 4 5 4 5 5 ...\n $ DEPTHCM : num 61 91 46 20 20 91 30 61 38 25 ...\n $ DEP2LIME : num 20 20 20 20 20 20 20 20 40 20 ...\n $ PCLAY1 : num 15 25 20 20 18 25 25 35 35 12 ...\n $ PCLAY2 : num 10 10 20 10 10 20 10 20 10 10 ...\n $ MG1 : num 63 58 55 60 88 168 99 59 233 87 ...\n $ OM1 : num 5.7 5.6 5.8 6.2 8.4 6.4 7.1 3.8 5 9.2 ...\n $ CEC1 : num 20 22 17 23 27 27 21 14 27 20 ...\n $ PH1 : num 7.7 7.7 7.5 7.6 7.6 7 7.5 7.6 6.6 7.5 ...\n $ PHOS1 : num 13 9.2 10.5 8.8 13 9.3 10 9 15 12.6 ...\n $ POT1 : num 196 157 115 172 238 164 312 184 123 282 ...\n```\n:::\n:::\n\n\nSuppose that we want to model the magnesium concentration (`MG1`), represented as a function of the spatial position in the following graph.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-32_cf223f9501bba263c237e06328f21358'}\n\n```{.r .cell-code}\nlibrary(ggplot2)\nggplot(oxford, aes(x = YCOORD, y = XCOORD, size = MG1)) +\n geom_point() +\n coord_fixed()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNote that the $x$ and $y$ axes have been inverted to save space. The `coord_fixed()` function of *ggplot2* ensures that the scale is the same on both axes, which is useful for representing spatial data.\n\nWe can immediately see that these measurements were taken on a 100 m grid. It seems that the magnesium concentration is spatially correlated, although it may be a correlation induced by another variable. In particular, we know that the concentration of magnesium is negatively related to the soil pH (`PH1`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-33_a9ec8bcf320a9e52d1252e4725f81bf7'}\n\n```{.r .cell-code}\nggplot(oxford, aes(x = PH1, y = MG1)) +\n geom_point()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe `variogram` function of *gstat* is used to estimate a variogram from empirical data. Here is the result obtained for the variable `MG1`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-34_c3f828164d93cc2b3d38500281fe87b9'}\n\n```{.r .cell-code}\nvar_mg <- variogram(MG1 ~ 1, locations = ~ XCOORD + YCOORD, data = oxford)\nvar_mg\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n np dist gamma dir.hor dir.ver id\n1 225 100.0000 1601.404 0 0 var1\n2 200 141.4214 1950.805 0 0 var1\n3 548 215.0773 2171.231 0 0 var1\n4 623 303.6283 2422.245 0 0 var1\n5 258 360.5551 2704.366 0 0 var1\n6 144 400.0000 2948.774 0 0 var1\n7 570 427.5569 2994.621 0 0 var1\n8 291 500.0000 3402.058 0 0 var1\n9 366 522.8801 3844.165 0 0 var1\n10 200 577.1759 3603.060 0 0 var1\n11 458 619.8400 3816.595 0 0 var1\n12 90 670.8204 3345.739 0 0 var1\n```\n:::\n:::\n\n\nThe formula `MG1 ~ 1` indicates that no linear predictor is included in this model, while the argument `locations` indicates which variables in the data frame correspond to the spatial coordinates.\n\nIn the resulting table, `gamma` is the value of the variogram for the distance class centered on `dist`, while `np` is the number of pairs of points in that class. Here, since the points are located on a grid, we obtain regular distance classes (e.g.: 100 m for neighboring points on the grid, 141 m for diagonal neighbors, etc.).\n\nHere, we limit ourselves to the estimation of isotropic variograms, i.e. the variogram depends only on the distance between the two points and not on the direction. Although we do not have time to see it today, it is possible with *gstat* to estimate the variogram separately in different directions.\n\nWe can illustrate the variogram with `plot`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-35_dced0e607669b721d5ef7df8faa51cb2'}\n\n```{.r .cell-code}\nplot(var_mg, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIf we want to estimate the residual spatial correlation of `MG1` after including the effect of `PH1`, we can add that predictor to the formula.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-36_41f230bd5a30f1cb7752e89e361c338a'}\n\n```{.r .cell-code}\nvar_mg <- variogram(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford)\nplot(var_mg, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIncluding the effect of pH, the range of the spatial correlation seems to decrease, while the plateau is reached around 300 m. It even seems that the variogram decreases beyond 400 m. In general, we assume that the variance between two points does not decrease with distance, unless there is a periodic spatial pattern.\n\nThe function `fit.variogram` accepts as arguments a variogram estimated from the data, as well as a theoretical model described in a `vgm` function, and then estimates the parameters of that model according to the data. The fitting is done by the method of least squares.\n\nFor example, `vgm(\"Exp\")` means we want to fit an exponential model.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-37_b852e100bd05bd7def030586576b386c'}\n\n```{.r .cell-code}\nvfit <- fit.variogram(var_mg, vgm(\"Exp\"))\nvfit\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n model psill range\n1 Nug 0.000 0.00000\n2 Exp 1951.496 95.11235\n```\n:::\n:::\n\n\nThere is no nugget effect, because `psill = 0` for the `Nug` (nugget) part of the model. The exponential part has a sill at 1951 and a range of 95 m.\n\nTo compare different models, a vector of model names can be given to `vgm`. In the following example, we include the exponential, gaussian (\"Gau\") and spherical (\"Sph\") models.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-38_5af5359b8627d50d97bf2175f4728362'}\n\n```{.r .cell-code}\nvfit <- fit.variogram(var_mg, vgm(c(\"Exp\", \"Gau\", \"Sph\")))\nvfit\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n model psill range\n1 Nug 0.000 0.00000\n2 Exp 1951.496 95.11235\n```\n:::\n:::\n\n\nThe function gives us the result of the model with the best fit (lowest sum of squared deviations), which here is the same exponential model.\n\nFinally, we can superimpose the theoretical model and the empirical variogram on the same graph.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-39_acab997244a63895e5eaedd7b9e62465'}\n\n```{.r .cell-code}\nplot(var_mg, vfit, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n## Regression with spatial correlation\n\nWe have seen above that the *gstat* package allows us to estimate the variogram of the residuals of a linear model. In our example, the magnesium concentration was modeled as a function of pH, with spatially correlated residuals.\n\nAnother tool to fit this same type of model is the `gls` function of the *nlme* package, which is included with the installation of R.\n\nThis function applies the *generalized least squares* method to fit linear regression models when the residuals are not independent or when the residual variance is not the same for all observations. Since the estimates of the coefficients depend on the estimated correlations between the residuals and the residuals themselves depend on the coefficients, the model is fitted by an iterative algorithm:\n\n1. A classical linear regression model (without correlation) is fitted to obtain residuals.\n\n2. The spatial correlation model (variogram) is fitted with those residuals.\n\n3. The regression coefficients are re-estimated, now taking into account the correlations.\n\nSteps 2 and 3 are repeated until the estimates are stable at a desired precision.\n\nHere is the application of this method to the same model for the magnesium concentration in the `oxford` dataset. In the `correlation` argument of `gls`, we specify an exponential correlation model as a function of our spatial coordinates and we include a possible nugget effect.\n\nIn addition to the exponential correlation `corExp`, the `gls` function can also estimate a Gaussian (`corGaus`) or spherical (`corSpher`) model.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-40_0b3199847595fbf9b39d87618cbffc8f'}\n\n```{.r .cell-code}\nlibrary(nlme)\ngls_mg <- gls(MG1 ~ PH1, oxford, \n correlation = corExp(form = ~ XCOORD + YCOORD, nugget = TRUE))\nsummary(gls_mg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized least squares fit by REML\n Model: MG1 ~ PH1 \n Data: oxford \n AIC BIC logLik\n 1278.65 1292.751 -634.325\n\nCorrelation Structure: Exponential spatial correlation\n Formula: ~XCOORD + YCOORD \n Parameter estimate(s):\n range nugget \n478.0322964 0.2944753 \n\nCoefficients:\n Value Std.Error t-value p-value\n(Intercept) 391.1387 50.42343 7.757084 0\nPH1 -41.0836 6.15662 -6.673079 0\n\n Correlation: \n (Intr)\nPH1 -0.891\n\nStandardized residuals:\n Min Q1 Med Q3 Max \n-2.1846957 -0.6684520 -0.3687813 0.4627580 3.1918604 \n\nResidual standard error: 53.8233 \nDegrees of freedom: 126 total; 124 residual\n```\n:::\n:::\n\n\nTo compare this result with the adjusted variogram above, the parameters given by `gls` must be transformed. The range has the same meaning in both cases and corresponds to 478 m for the result of `gls`. The global variance of the residuals is the square of `Residual standard error`. The nugget effect here (0.294) is expressed as a fraction of that variance. Finally, to obtain the partial sill of the exponential part, the nugget effect must be subtracted from the total variance.\n\nAfter performing these calculations, we can give these parameters to the `vgm` function of *gstat* to superimpose this variogram estimated by `gls` on our variogram of the residuals of the classical linear model.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-41_bdace2c5570a84ab706e3cc520568742'}\n\n```{.r .cell-code}\ngls_range <- 478\ngls_var <- 53.823^2\ngls_nugget <- 0.294 * gls_var\ngls_psill <- gls_var - gls_nugget\n\ngls_vgm <- vgm(\"Exp\", psill = gls_psill, range = gls_range, nugget = gls_nugget)\n\nplot(var_mg, gls_vgm, col = \"black\", ylim = c(0, 4000))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nDoes the model fit the data less well here? In fact, this empirical variogram represented by the points was obtained from the residuals of the linear model ignoring the spatial correlation, so it is a biased estimate of the actual spatial correlations. The method is still adequate to quickly check if spatial correlations are present. However, to simultaneously fit the regression coefficients and the spatial correlation parameters, the generalized least squares (GLS) approach is preferable and will produce more accurate estimates.\n\nFinally, note that the result of the `gls` model also gives the AIC, which we can use to compare the fit of different models (with different predictors or different forms of spatial correlation).\n\n## Exercise\n\nThe [bryo_belg.csv](data/bryo_belg.csv) dataset is adapted from the data of this study:\n\n> Neyens, T., Diggle, P.J., Faes, C., Beenaerts, N., Artois, T. et Giorgi, E. (2019) Mapping species richness using opportunistic samples: a case study on ground-floor bryophyte species richness in the Belgian province of Limburg. *Scientific Reports* 9, 19122. https://doi.org/10.1038/s41598-019-55593-x\n\nThis data frame shows the specific richness of ground bryophytes (*richness*) for different sampling points in the Belgian province of Limburg, with their position *(x, y)* in km, in addition to information on the proportion of forest (*forest*) and wetlands (*wetland*) in a 1 km\\^2\\$ cell containing the sampling point.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-42_c25ae6f03a62752dff743e2d40b205a0'}\n\n```{.r .cell-code}\nbryo_belg <- read.csv(\"data/bryo_belg.csv\")\nhead(bryo_belg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n richness forest wetland x y\n1 9 0.2556721 0.5036614 228.9516 220.8869\n2 6 0.6449114 0.1172068 227.6714 219.8613\n3 5 0.5039905 0.6327003 228.8252 220.1073\n4 3 0.5987329 0.2432942 229.2775 218.9035\n5 2 0.7600775 0.1163538 209.2435 215.2414\n6 10 0.6865434 0.0000000 210.4142 216.5579\n```\n:::\n:::\n\n\nFor this exercise, we will use the square root of the specific richness as the response variable. The square root transformation often allows to homogenize the variance of the count data in order to apply a linear regression.\n\na) Fit a linear model of the transformed species richness to the proportion of forest and wetlands, without taking into account spatial correlations. What is the effect of the two predictors in this model?\n\nb) Calculate the empirical variogram of the model residuals in (a). Does there appear to be a spatial correlation between the points?\n\n*Note*: The `cutoff` argument to the `variogram` function specifies the maximum distance at which the variogram is calculated. You can manually adjust this value to get a good view of the sill.\n\nc) Re-fit the linear model in (a) with the `gls` function in the *nlme* package, trying different types of spatial correlations (exponential, Gaussian, spherical). Compare the models (including the one without spatial correlation) with the AIC.\n\nd) What is the effect of the proportion of forests and wetlands according to the model in (c)? Explain the differences between the conclusions of this model and the model in (a).\n\n# Kriging\n\nAs mentioned before, a common application of geostatistical models is to predict the value of the response variable at unsampled locations, a form of spatial interpolation called kriging (pronounced with a hard \"g\").\n\nThere are three basic types of kriging based on the assumptions made about the response variable:\n\n- Ordinary kriging: Stationary variable with an unknown mean.\n\n- Simple kriging: Stationary variable with a known mean.\n\n- Universal kriging: Variable with a trend given by a linear or non-linear model.\n\nFor all kriging methods, the predictions at a new point are a weighted mean of the values at known points. These weights are chosen so that kriging provides the best linear unbiased prediction of the response variable, if the model assumptions (in particular the variogram) are correct. That is, among all possible unbiased predictions, the weights are chosen to give the minimum mean square error. Kriging also provides an estimate of the uncertainty of each prediction.\n\nWhile we will not present the detailed kriging equations here, the weights depend on both the correlations (estimated by the variogram) between the sampled points and the new point, as well of the correlations between the sampled points themselves. In other words, sampled points near the new point are given more weight, but isolated sampled points are also given more weight, because sample points close to each other provide redundant information.\n\nKriging is an interpolation method, so the prediction at a sampled point will always be equal to the measured value (the measurement is supposed to have no error, just spatial variation). However, in the presence of a nugget effect, any small displacement from the sampled location will show variability according to the nugget.\n\nIn the example below, we generate a new dataset composed of randomly-generated (x, y) coordinates within the study area as well as randomly-generated pH values based on the `oxford` data. We then apply the function `krige` to predict the magnesium values at these new points. Note that we specify the variogram derived from the GLS results in the `model` argument to `krige`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-43_f81acecbca5eefa202e114614faebc54'}\n\n```{.r .cell-code}\nset.seed(14)\nnew_points <- data.frame(\n XCOORD = runif(100, min(oxford$XCOORD), max(oxford$XCOORD)),\n YCOORD = runif(100, min(oxford$YCOORD), max(oxford$YCOORD)),\n PH1 = rnorm(100, mean(oxford$PH1), sd(oxford$PH1))\n)\n\npred <- krige(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford,\n newdata = new_points, model = gls_vgm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[using universal kriging]\n```\n:::\n\n```{.r .cell-code}\nhead(pred)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n XCOORD YCOORD var1.pred var1.var\n1 227.0169 162.1185 47.13065 1269.002\n2 418.9136 465.9013 79.68437 1427.269\n3 578.5943 2032.7477 60.30539 1264.471\n4 376.2734 1530.7193 127.22366 1412.875\n5 591.5336 421.6290 105.88124 1375.485\n6 355.7369 404.3378 127.73055 1250.114\n```\n:::\n:::\n\n\nThe result of `krige` includes the new point coordinates, the prediction of the variable `var1.pred` along with its estimated variance `var1.var`. In the graph below, we show the mean MG1 predictions from kriging (triangles) along with the measurements (circles).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-44_8a46f7bb0f5137f5dae6fef418b6b61e'}\n\n```{.r .cell-code}\npred$MG1 <- pred$var1.pred\n\nggplot(oxford, aes(x = YCOORD, y = XCOORD, color = MG1)) +\n geom_point() +\n geom_point(data = pred, shape = 17, size = 2) +\n coord_fixed()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe estimated mean and variance from kriging can be used to simulate possible values of the variable at each new point, conditional on the sampled values. In the example below, we performed 4 conditional simulations by adding the argument `nsim = 4` to the same `krige` instruction.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-45_15e6975ae8f74fb12acd4b9d15610303'}\n\n```{.r .cell-code}\nsim_mg <- krige(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford,\n newdata = new_points, model = gls_vgm, nsim = 4)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\ndrawing 4 GLS realisations of beta...\n[using conditional Gaussian simulation]\n```\n:::\n\n```{.r .cell-code}\nhead(sim_mg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n XCOORD YCOORD sim1 sim2 sim3 sim4\n1 227.0169 162.1185 9.638739 34.53159 46.08685 77.86376\n2 418.9136 465.9013 60.029144 20.17179 76.46333 59.57924\n3 578.5943 2032.7477 100.791412 77.47887 73.50058 59.40279\n4 376.2734 1530.7193 112.615730 150.96664 78.76125 146.83928\n5 591.5336 421.6290 70.925240 72.85522 153.90610 126.63758\n6 355.7369 404.3378 161.608032 118.93640 134.45695 142.20074\n```\n:::\n:::\n\n::: {.cell fig.dim='[10,5]' hash='index_cache/html/unnamed-chunk-46_dc67747871861d460645cc2d898c2797'}\n\n```{.r .cell-code}\nlibrary(tidyr)\nsim_mg <- pivot_longer(sim_mg, cols = c(sim1, sim2, sim3, sim4), \n names_to = \"sim\", values_to = \"MG1\")\nggplot(sim_mg, aes(x = YCOORD, y = XCOORD, color = MG1)) +\n geom_point() +\n coord_fixed() +\n facet_wrap(~ sim)\n```\n\n::: {.cell-output-display}\n{width=960}\n:::\n:::\n\n\n# Solutions\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-47_46625f4b0eb7a89df12358298784d779'}\n\n```{.r .cell-code}\nbryo_lm <- lm(sqrt(richness) ~ forest + wetland, data = bryo_belg)\nsummary(bryo_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall:\nlm(formula = sqrt(richness) ~ forest + wetland, data = bryo_belg)\n\nResiduals:\n Min 1Q Median 3Q Max \n-1.8847 -0.4622 0.0545 0.4974 2.3116 \n\nCoefficients:\n Estimate Std. Error t value Pr(>|t|) \n(Intercept) 2.34159 0.08369 27.981 < 2e-16 ***\nforest 1.11883 0.13925 8.034 9.74e-15 ***\nwetland -0.59264 0.17216 -3.442 0.000635 ***\n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nResidual standard error: 0.7095 on 417 degrees of freedom\nMultiple R-squared: 0.2231,\tAdjusted R-squared: 0.2193 \nF-statistic: 59.86 on 2 and 417 DF, p-value: < 2.2e-16\n```\n:::\n:::\n\n\nThe proportion of forest has a significant positive effect and the proportion of wetlands has a significant negative effect on bryophyte richness.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-48_9f1b47ee10d87121e3853375afbb8273'}\n\n```{.r .cell-code}\nplot(variogram(sqrt(richness) ~ forest + wetland, locations = ~ x + y,\n data = bryo_belg, cutoff = 50), col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe variogram is increasing from 0 to at least 40 km, so there appears to be spatial correlations in the model residuals.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-49_2a94f7a8b64ea0bb9127648e255fcbd3'}\n\n```{.r .cell-code}\nbryo_exp <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corExp(form = ~ x + y, nugget = TRUE))\nbryo_gaus <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corGaus(form = ~ x + y, nugget = TRUE))\nbryo_spher <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corSpher(form = ~ x + y, nugget = TRUE))\n```\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-50_9d306abf18fdbd164c34d87f9f9832d8'}\n\n```{.r .cell-code}\nAIC(bryo_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 908.6358\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_exp)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 867.822\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_gaus)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 870.9592\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_spher)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 866.9117\n```\n:::\n:::\n\n\nThe spherical model has the smallest AIC.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-51_5c26da31bc0b2db751ce60929eb7b8be'}\n\n```{.r .cell-code}\nsummary(bryo_spher)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized least squares fit by REML\n Model: sqrt(richness) ~ forest + wetland \n Data: bryo_belg \n AIC BIC logLik\n 866.9117 891.1102 -427.4558\n\nCorrelation Structure: Spherical spatial correlation\n Formula: ~x + y \n Parameter estimate(s):\n range nugget \n43.1727664 0.6063187 \n\nCoefficients:\n Value Std.Error t-value p-value\n(Intercept) 2.0368769 0.2481636 8.207800 0.000\nforest 0.6989844 0.1481690 4.717481 0.000\nwetland -0.2441130 0.1809118 -1.349348 0.178\n\n Correlation: \n (Intr) forest\nforest -0.251 \nwetland -0.235 0.241\n\nStandardized residuals:\n Min Q1 Med Q3 Max \n-1.75204183 -0.06568688 0.61415597 1.15240370 3.23322743 \n\nResidual standard error: 0.7998264 \nDegrees of freedom: 420 total; 417 residual\n```\n:::\n:::\n\n\nBoth effects are less important in magnitude and the effect of wetlands is not significant anymore. As is the case for other types of non-independent residuals, the \"effective sample size\" here is less than the number of points, since points close to each other provide redundant information. Therefore, the relationship between predictors and response is less clear than given by the model assuming all these points were independent.\n\nNote that the results for all three `gls` models are quite similar, so the choice to include spatial correlations was more important than the exact shape assumed for the variogram.\n\n\n# Areal data {#areal-data}\n\nAreal data are variables measured for regions of space, defined by polygons. This type of data is more common in the social sciences, human geography and epidemiology, where data is often available at the scale of administrative divisions.\n\nThis type of data also appears frequently in natural resource management. For example, the following map shows the forest management units of the Ministère de la Forêt, de la Faune et des Parcs du Québec.\n\n\n\nSuppose that a variable is available at the level of these management units. How can we model the spatial correlation between units that are spatially close together?\n\nOne option would be to apply the geostatistical methods seen before, for example by calculating the distance between the centers of the polygons.\n\nAnother option, which is more adapted for areal data, is to define a network where each region is connected to neighbouring regions by a link. It is then assumed that the variables are directly correlated between neighbouring regions only. (Note, however, that direct correlations between immediate neighbours also generate indirect correlations for a chain of neighbours).\n\nIn this type of model, the correlation is not necessarily the same from one link to another. In this case, each link in the network can be associated with a *weight* representing its importance for the spatial correlation. We represent these weights by a matrix $W$ where $w_{ij}$ is the weight of the link between regions $i$ and $j$. A region has no link with itself, so $w_{ii} = 0$.\n\nA simple choice for $W$ is to assign a weight equal to 1 if the regions are neighbours, otherwise 0 (binary weight).\n\nIn addition to land divisions represented by polygons, another example of areal data consists of a grid where the variable is calculated for each cell of the grid. In this case, a cell generally has 4 or 8 neighbouring cells, depending on whether diagonals are included or not.\n\n# Moran's I {#moran-i}\n\nBefore discussing spatial autocorrelation models, we present Moran's $I$ statistic, which allows us to test whether a significant correlation is present between neighbouring regions.\n\nMoran's $I$ is a spatial autocorrelation coefficient of $z$, weighted by the $w_{ij}$. It therefore takes values between -1 and 1.\n\n$$I = \\frac{N}{\\sum_i \\sum_j w_{ij}} \\frac{\\sum_i \\sum_j w_{ij} (z_i - \\bar{z}) (z_j - \\bar{z})}{\\sum_i (z_i - \\bar{z})^2}$$\n\nIn this equation, we recognize the expression of a correlation, which is the product of the deviations from the mean for two variables $z_i$ and $z_j$, divided by the product of their standard deviations (it is the same variable here, so we get the variance). The contribution of each pair $(i, j)$ is multiplied by its weight $w_{ij}$ and the term on the left (the number of regions $N$ divided by the sum of the weights) ensures that the result is bounded between -1 and 1.\n\nSince the distribution of $I$ is known in the absence of spatial autocorrelation, this statistic serves to test the null hypothesis that there is no spatial correlation between neighbouring regions.\n\nAlthough we will not see an example in this course, Moran's $I$ can also be applied to point data. In this case, we divide the pairs of points into distance classes and calculate $I$ for each distance class; the weight $w_{ij} = 1$ if the distance between $i$ and $j$ is in the desired distance class, otherwise 0.\n\n# Spatial autoregression models {#spatial-autoreg}\n\nLet us recall the formula for a linear regression with spatial dependence:\n\n$$v = \\beta_0 + \\sum_i \\beta_i u_i + z + \\epsilon$$\n\nwhere $z$ is the portion of the residual variance that is spatially correlated.\n\nThere are two main types of autoregressive models to represent the spatial dependence of $z$: conditional autoregression (CAR) and simultaneous autoregressive (SAR).\n\n## Conditional autoregressive (CAR) model\n\nIn the conditional autoregressive model, the value of $z_i$ for the region $i$ follows a normal distribution: its mean depends on the value $z_j$ of neighbouring regions, multiplied by the weight $w_{ij}$ and a correlation coefficient $\\rho$; its standard deviation $\\sigma_{z_i}$ may vary from one region to another.\n\n$$z_i \\sim \\text{N}\\left(\\sum_j \\rho w_{ij} z_j,\\sigma_{z_i} \\right)$$\n\nIn this model, if $w_{ij}$ is a binary matrix (0 for non-neighbours, 1 for neighbours), then $\\rho$ is the coefficient of partial correlation between neighbouring regions. This is similar to a first-order autoregressive model in the context of time series, where the autoregression coefficient indicates the partial correlation.\n\n## Simultaneous autoregressive (SAR) model\n\nIn the simultaneous autoregressive model, the value of $z_i$ is given directly by the sum of contributions from neighbouring values $z_j$, multiplied by $\\rho w_{ij}$, with an independent residual $\\nu_i$ of standard deviation $\\sigma_z$.\n\n$$z_i = \\sum_j \\rho w_{ij} z_j + \\nu_i$$\n\nAt first glance, this looks like a temporal autoregressive model. However, there is an important conceptual difference. For temporal models, the causal influence is directed in only one direction: $v(t-2)$ affects $v(t-1)$ which then affects $v(t)$. For a spatial model, each $z_j$ that affects $z_i$ depends in turn on $z_i$. Thus, to determine the joint distribution of $z$, a system of equations must be solved simultaneously (hence the name of the model).\n\nFor this reason, although this model resembles the formula of CAR model, the solutions of the two models differ and in the case of SAR, the coefficient $\\rho$ is not directly equal to the partial correlation due to each neighbouring region.\n\nFor more details on the mathematical aspects of these models, see the article by Ver Hoef et al. (2018) suggested in reference.\n\nFor the moment, we will consider SAR and CAR as two types of possible models to represent a spatial correlation on a network. We can always fit several models and compare them with the AIC to choose the best form of correlation or the best weight matrix.\n\nThe CAR and SAR models share an advantage over geostatistical models in terms of efficiency. In a geostatistical model, spatial correlations are defined between each pair of points, although they become negligible as distance increases. For a CAR or SAR model, only neighbouring regions contribute and most weights are equal to 0, making these models faster to fit than a geostatistical model when the data are massive.\n\n# Analysis of areal data in R {#analysis-areal}\n\nTo illustrate the analysis of areal data in R, we load the packages *sf* (to read geospatial data), *spdep* (to define spatial networks and calculate Moran's $I$) and *spatialreg* (for SAR and CAR models).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-52_bbb39418b6f206ecf18ea280d1186280'}\n\n```{.r .cell-code}\nlibrary(sf)\nlibrary(spdep)\nlibrary(spatialreg)\n```\n:::\n\n\nAs an example, we will use a dataset that presents some of the results of the 2018 provincial election in Quebec, with population characteristics of each riding. This data is included in a *shapefile* (.shp) file type, which we can read with the `read_sf` function of the *sf* package.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-53_57544cb924c4156b05da2ae4a2ea020a'}\n\n```{.r .cell-code}\nelect2018 <- read_sf(\"data/elect2018.shp\")\nhead(elect2018)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nSimple feature collection with 6 features and 9 fields\nGeometry type: MULTIPOLYGON\nDimension: XY\nBounding box: xmin: 97879.03 ymin: 174515.3 xmax: 694261.1 ymax: 599757.1\nProjected CRS: LambertAQ\n# A tibble: 6 × 10\n circ age_moy pct_frn pct_prp rev_med propCAQ propPQ propPLQ propQS\n \n1 Abitibi-Est 40.8 0.963 0.644 34518 42.7 19.5 18.8 15.7\n2 Abitibi-Ouest 42.2 0.987 0.735 33234 34.1 33.3 11.3 16.6\n3 Acadie 40.3 0.573 0.403 25391 16.5 9 53.8 13.8\n4 Anjou-Louis-Riel 43.5 0.821 0.416 31275 28.9 14.7 39.1 14.5\n5 Argenteuil 43.3 0.858 0.766 31097 38.9 21.1 17.4 12.2\n6 Arthabaska 43.4 0.989 0.679 30082 61.8 9.4 11.4 12.6\n# … with 1 more variable: geometry \n```\n:::\n:::\n\n\n*Note*: The dataset is actually composed of 4 files with the extensions .dbf, .prj, .shp and .shx, but it is sufficient to write the name of the .shp file in `read_sf`.\n\nThe columns of the dataset are, in order:\n\n- the name of the electoral riding (`circ`);\n- four characteristics of the population (`age_moy` = mean age, `pct_frn` = fraction of the population that speaks mainly French at home, `pct_prp` = fraction of households that own their home, `rev_med` = median income);\n- four columns showing the fraction of votes obtained by the main parties (CAQ, PQ, PLQ, QS);\n- a `geometry` column that contains the geometric object (multipolygon) corresponding to the riding.\n\nTo illustrate one of the variables on a map, we call the `plot` function with the name of the column in square brackets and quotation marks.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-54_b911c1230b37d88999c315735187b9c4'}\n\n```{.r .cell-code}\nplot(elect2018[\"rev_med\"])\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIn this example, we want to model the fraction of votes obtained by the CAQ based on the characteristics of the population in each riding and taking into account the spatial correlations between neighbouring ridings.\n\n## Definition of the neighbourhood network\n\nThe `poly2nb` function of the *spdep* package defines a neighbourhood network from polygons. The result `vois` is a list of 125 elements where each element contains the indices of the neighbouring (bordering) polygons of a given polygon.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-55_98b699432f680855147ba1bd583f3497'}\n\n```{.r .cell-code}\nvois <- poly2nb(elect2018)\nvois[[1]]\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 2 37 63 88 101 117\n```\n:::\n:::\n\n\nThus, the first riding (Abitibi-Est) has 6 neighbouring ridings, for which the names can be found as follows:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-56_1fa15a9556e3ec5f51ffe127e1e42830'}\n\n```{.r .cell-code}\nelect2018$circ[vois[[1]]]\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] \"Abitibi-Ouest\" \"Gatineau\" \n[3] \"Laviolette-Saint-Maurice\" \"Pontiac\" \n[5] \"Rouyn-Noranda-Témiscamingue\" \"Ungava\" \n```\n:::\n:::\n\n\nWe can illustrate this network by extracting the coordinates of the center of each district, creating a blank map with `plot(elect2018[\"geometry\"])`, then adding the network as an additional layer with `plot(vois, add = TRUE, coords = coords)`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-57_f0d7bd96b26b0a6cd39daec9f4aad58b'}\n\n```{.r .cell-code}\ncoords <- st_centroid(elect2018) %>%\n st_coordinates()\nplot(elect2018[\"geometry\"])\nplot(vois, add = TRUE, col = \"red\", coords = coords)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nWe can \"zoom\" on southern Québec by choosing the limits `xlim` and `ylim`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-58_1fa7ea9cbb36326317c26af33b739d1c'}\n\n```{.r .cell-code}\nplot(elect2018[\"geometry\"], \n xlim = c(400000, 800000), ylim = c(100000, 500000))\nplot(vois, add = TRUE, col = \"red\", coords = coords)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nWe still have to add weights to each network link with the `nb2listw` function. The style of weights \"B\" corresponds to binary weights, i.e. 1 for the presence of link and 0 for the absence of link between two ridings.\n\nOnce these weights are defined, we can verify with Moran's test whether there is a significant autocorrelation of votes obtained by the CAQ between neighbouring ridings.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-59_94da4f87bfc6fa6486cce26e9c1ed239'}\n\n```{.r .cell-code}\npoids <- nb2listw(vois, style = \"B\")\n\nmoran.test(elect2018$propCAQ, poids)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\n\tMoran I test under randomisation\n\ndata: elect2018$propCAQ \nweights: poids \n\nMoran I statistic standard deviate = 13.148, p-value < 2.2e-16\nalternative hypothesis: greater\nsample estimates:\nMoran I statistic Expectation Variance \n 0.680607768 -0.008064516 0.002743472 \n```\n:::\n:::\n\n\nThe value $I = 0.68$ is very significant judging by the $p$-value of the test.\n\nLet's verify if the spatial correlation persists after taking into account the four characteristics of the population, therefore by inspecting the residuals of a linear model including these four predictors.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-60_48eb067e5cfdccfc3e81ace94767cddc'}\n\n```{.r .cell-code}\nelect_lm <- lm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, data = elect2018)\nsummary(elect_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall:\nlm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018)\n\nResiduals:\n Min 1Q Median 3Q Max \n-30.9890 -4.4878 0.0562 6.2653 25.8146 \n\nCoefficients:\n Estimate Std. Error t value Pr(>|t|) \n(Intercept) 1.354e+01 1.836e+01 0.737 0.463 \nage_moy -9.170e-01 3.855e-01 -2.378 0.019 * \npct_frn 4.588e+01 5.202e+00 8.820 1.09e-14 ***\npct_prp 3.582e+01 6.527e+00 5.488 2.31e-07 ***\nrev_med -2.624e-05 2.465e-04 -0.106 0.915 \n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nResidual standard error: 9.409 on 120 degrees of freedom\nMultiple R-squared: 0.6096,\tAdjusted R-squared: 0.5965 \nF-statistic: 46.84 on 4 and 120 DF, p-value: < 2.2e-16\n```\n:::\n\n```{.r .cell-code}\nmoran.test(residuals(elect_lm), poids)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\n\tMoran I test under randomisation\n\ndata: residuals(elect_lm) \nweights: poids \n\nMoran I statistic standard deviate = 6.7047, p-value = 1.009e-11\nalternative hypothesis: greater\nsample estimates:\nMoran I statistic Expectation Variance \n 0.340083290 -0.008064516 0.002696300 \n```\n:::\n:::\n\n\nMoran's $I$ has decreased but remains significant, so some of the previous correlation was induced by these predictors, but there remains a spatial correlation due to other factors.\n\n## Spatial autoregression models\n\nFinally, we fit SAR and CAR models to these data with the `spautolm` (*spatial autoregressive linear model*) function of *spatialreg*. Here is the code for a SAR model including the effect of the same four predictors.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-61_13bb8dc5c63cce02c362b41c905f9de5'}\n\n```{.r .cell-code}\nelect_sar <- spautolm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids)\nsummary(elect_sar)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids)\n\nResiduals:\n Min 1Q Median 3Q Max \n-23.08342 -4.10573 0.24274 4.29941 23.08245 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 15.09421119 16.52357745 0.9135 0.36098\nage_moy -0.70481703 0.32204139 -2.1886 0.02863\npct_frn 39.09375061 5.43653962 7.1909 6.435e-13\npct_prp 14.32329345 6.96492611 2.0565 0.03974\nrev_med 0.00016730 0.00023209 0.7208 0.47101\n\nLambda: 0.12887 LR test value: 42.274 p-value: 7.9339e-11 \nNumerical Hessian standard error of lambda: 0.012069 \n\nLog likelihood: -433.8862 \nML residual variance (sigma squared): 53.028, (sigma: 7.282)\nNumber of observations: 125 \nNumber of parameters estimated: 7 \nAIC: 881.77\n```\n:::\n:::\n\n\nThe value given by `Lambda` in the summary corresponds to the coefficient $\\rho$ in our description of the model. The likelihood-ratio test (`LR test`) confirms that this residual spatial correlation (after controlling for the effect of predictors) is significant.\n\nThe estimated effects for the predictors are similar to those of the linear model without spatial correlation. The effects of mean age, fraction of francophones and fraction of homeowners remain significant, although their magnitude has decreased somewhat.\n\nTo fit a CAR rather than SAR model, we must specify `family = \"CAR\"`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-62_29349c4a3573934d0da78be8a806d927'}\n\n```{.r .cell-code}\nelect_car <- spautolm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids, family = \"CAR\")\nsummary(elect_car)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids, family = \"CAR\")\n\nResiduals:\n Min 1Q Median 3Q Max \n-21.73315 -4.24623 -0.24369 3.44228 23.43749 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 16.57164696 16.84155327 0.9840 0.325128\nage_moy -0.79072151 0.32972225 -2.3981 0.016478\npct_frn 38.99116707 5.43667482 7.1719 7.399e-13\npct_prp 17.98557474 6.80333470 2.6436 0.008202\nrev_med 0.00012639 0.00023106 0.5470 0.584364\n\nLambda: 0.15517 LR test value: 40.532 p-value: 1.9344e-10 \nNumerical Hessian standard error of lambda: 0.0026868 \n\nLog likelihood: -434.7573 \nML residual variance (sigma squared): 53.9, (sigma: 7.3416)\nNumber of observations: 125 \nNumber of parameters estimated: 7 \nAIC: 883.51\n```\n:::\n:::\n\n\nFor a CAR model with binary weights, the value of `Lambda` (which we called $\\rho$) directly gives the partial correlation coefficient between neighbouring districts. Note that the AIC here is slightly higher than the SAR model, so the latter gave a better fit.\n\n## Exercise\n\nThe `rls_covid` dataset, in *shapefile* format, contains data on detected COVID-19 cases (`cas`), number of cases per 1000 people (`taux_1k`) and the population density (`dens_pop`) in each of Quebec's local health service networks (RLS) (Source: Data downloaded from the Institut national de santé publique du Québec as of January 17, 2021).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-63_93fde0bc2a6d31114d1cad8dee5f0aa1'}\n\n```{.r .cell-code}\nrls_covid <- read_sf(\"data/rls_covid.shp\")\nhead(rls_covid)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nSimple feature collection with 6 features and 5 fields\nGeometry type: MULTIPOLYGON\nDimension: XY\nBounding box: xmin: 785111.2 ymin: 341057.8 xmax: 979941.5 ymax: 541112.7\nProjected CRS: Conique_conforme_de_Lambert_du_MTQ_utilis_e_pour_Adresse_Qu_be\n# A tibble: 6 × 6\n RLS_code RLS_nom cas taux_1k dens_…¹ geometry\n \n1 0111 RLS de Kamouraska 152 7.34 6.76 (((827028.3 412772.4, 82…\n2 0112 RLS de Rivière-du-Lo… 256 7.34 19.6 (((855905 452116.9, 8557…\n3 0113 RLS de Témiscouata 81 4.26 4.69 (((911829.4 441311.2, 91…\n4 0114 RLS des Basques 28 3.3 5.35 (((879249.6 471975.6, 87…\n5 0115 RLS de Rimouski 576 9.96 15.5 (((917748.1 503148.7, 91…\n6 0116 RLS de La Mitis 76 4.24 5.53 (((951316 523499.3, 9525…\n# … with abbreviated variable name ¹dens_pop\n```\n:::\n:::\n\n\nFit a linear model of the number of cases per 1000 as a function of population density (it is suggested to apply a logarithmic transform to the latter). Check whether the model residuals are correlated between bordering RLS with a Moran's test and then model the same data with a conditional autoregressive model.\n\n## Reference\n\nVer Hoef, J.M., Peterson, E.E., Hooten, M.B., Hanks, E.M. and Fortin, M.-J. (2018) Spatial autoregressive models for statistical inference from ecological data. *Ecological Monographs* 88: 36-59.\n\n\n\n\n\n# GLMM with spatial Gaussian process {#glmm-spatial-gaussian}\n\n## Data\n\nThe `gambia` dataset found in the *geoR* package presents the results of a study of malaria prevalence among children of 65 villages in The Gambia. We will use a slightly transformed version of the data found in the file [gambia.csv](data/gambia.csv).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-64_c90dcebc741300cf593af262129c15ab'}\n\n```{.r .cell-code}\nlibrary(geoR)\n\ngambia <- read.csv(\"data/gambia.csv\")\nhead(gambia)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n id_village x y pos age netuse treated green phc\n1 1 349.6313 1458.055 1 1783 0 0 40.85 1\n2 1 349.6313 1458.055 0 404 1 0 40.85 1\n3 1 349.6313 1458.055 0 452 1 0 40.85 1\n4 1 349.6313 1458.055 1 566 1 0 40.85 1\n5 1 349.6313 1458.055 0 598 1 0 40.85 1\n6 1 349.6313 1458.055 1 590 1 0 40.85 1\n```\n:::\n:::\n\n\nHere are the fields in that dataset:\n\n- *id_village*: Identifier of the village.\n- *x* and *y*: Spatial coordinates of the village (in kilometers, based on UTM coordinates).\n- *pos*: Binary response, whether the child tested positive for malaria.\n- *age*: Age of the child in days.\n- *netuse*: Whether or not the child sleeps under a bed net.\n- *treated*: Whether or not the bed net is treated.\n- *green*: Remote sensing based measure of greenness of vegetation (measured at the village level).\n- *phc*: Presence or absence of a public health centre for the village.\n\nWe can count the number of positive cases and total children tested by village to map the fraction of positive cases (or prevalence, *prev*).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-65_8c814c1bf1c630ff765172316c6e438a'}\n\n```{.r .cell-code}\n# Create village-level dataset\ngambia_agg <- group_by(gambia, id_village, x, y, green, phc) %>%\n summarize(pos = sum(pos), total = n()) %>%\n mutate(prev = pos / total) %>%\n ungroup()\n```\n\n::: {.cell-output .cell-output-stderr}\n```\n`summarise()` has grouped output by 'id_village', 'x', 'y', 'green'. You can\noverride using the `.groups` argument.\n```\n:::\n\n```{.r .cell-code}\nhead(gambia_agg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n# A tibble: 6 × 8\n id_village x y green phc pos total prev\n \n1 1 350. 1458. 40.8 1 17 33 0.515\n2 2 359. 1460. 40.8 1 19 63 0.302\n3 3 360. 1460. 40.1 0 7 17 0.412\n4 4 364. 1497. 40.8 0 8 24 0.333\n5 5 366. 1460. 40.8 0 10 26 0.385\n6 6 367. 1463. 40.8 0 7 18 0.389\n```\n:::\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-66_ae2eb69bc71b443b86ab8b607284711a'}\n\n```{.r .cell-code}\nggplot(gambia_agg, aes(x = x, y = y)) +\n geom_point(aes(color = prev)) +\n geom_path(data = gambia.borders, aes(x = x / 1000, y = y / 1000)) +\n coord_fixed() +\n theme_minimal() +\n scale_color_viridis_c()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nWe use the `gambia.borders` dataset from the *geoR* package to trace the country boundaries with `geom_path`. Since those boundaries are in meters, we divide by 1000 to get the same scale as our points. We also use `coord_fixed` to ensure a 1:1 aspect ratio between the axes and use the `viridis` color scale, which makes it easier to visualize a continuous variable compared with the default gradient scale in *ggplot2*.\n\nBased on this map, there seems to be spatial correlation in malaria prevalence, with the eastern cluster of villages showing more high prevalence values (yellow-green) and the middle cluster showing more low prevalence values (purple).\n\n## Non-spatial GLMM\n\nFor this first example, we will ignore the spatial aspect of the data and model the presence of malaria (*pos*) as a function of the use of a bed net (*netuse*) and the presence of a public health centre (*phc*). Since we have a binary response, we need to use a logistic regression model (a GLM). Since we have predictors at both the individual and village level, and we expect that children of the same village have more similar probabilities of having malaria even after accounting for those predictors, we need to add a random effect of the village. The result is a GLMM that we fit using the `glmer` function in the *lme4* package.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-67_5c5fd662cb4ced05e844aabdfdb7a676'}\n\n```{.r .cell-code}\nlibrary(lme4)\n\nmod_glmm <- glmer(pos ~ netuse + phc + (1 | id_village), \n data = gambia, family = binomial)\nsummary(mod_glmm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized linear mixed model fit by maximum likelihood (Laplace\n Approximation) [glmerMod]\n Family: binomial ( logit )\nFormula: pos ~ netuse + phc + (1 | id_village)\n Data: gambia\n\n AIC BIC logLik deviance df.resid \n 2428.0 2450.5 -1210.0 2420.0 2031 \n\nScaled residuals: \n Min 1Q Median 3Q Max \n-2.1286 -0.7120 -0.4142 0.8474 3.3434 \n\nRandom effects:\n Groups Name Variance Std.Dev.\n id_village (Intercept) 0.8149 0.9027 \nNumber of obs: 2035, groups: id_village, 65\n\nFixed effects:\n Estimate Std. Error z value Pr(>|z|) \n(Intercept) 0.1491 0.2297 0.649 0.5164 \nnetuse -0.6044 0.1442 -4.190 2.79e-05 ***\nphc -0.4985 0.2604 -1.914 0.0556 . \n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nCorrelation of Fixed Effects:\n (Intr) netuse\nnetuse -0.422 \nphc -0.715 -0.025\n```\n:::\n:::\n\n\nAccording to these results, both *netuse* and *phc* result in a decrease of malaria prevalence, although the effect of *phc* is not significant at a threshold $\\alpha = 0.05$. The intercept (0.149) is the logit of the probability of malaria presence for a child with no bednet and no public health centre, but it is the mean intercept across all villages, and there is a lot of variation between villages, based on the random effect standard deviation of 0.90. We can get the estimated intercept for each village with the function `coef`:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-68_3720c229ebd5b2262ea78c97fa323bc0'}\n\n```{.r .cell-code}\nhead(coef(mod_glmm)$id_village)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n (Intercept) netuse phc\n1 0.93727515 -0.6043602 -0.4984835\n2 0.09204843 -0.6043602 -0.4984835\n3 0.22500620 -0.6043602 -0.4984835\n4 -0.46271089 -0.6043602 -0.4984835\n5 0.13680037 -0.6043602 -0.4984835\n6 -0.03723346 -0.6043602 -0.4984835\n```\n:::\n:::\n\n\nSo for example, the intercept for village 1 is around 0.94, equivalent to a probability of 72%:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-69_5db6d43ef9ff435eae9aedd3aebe48f9'}\n\n```{.r .cell-code}\nplogis(0.937)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 0.7184933\n```\n:::\n:::\n\n\nwhile the intercept in village 2 is equivalent to a probability of 52%:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-70_8c98817d65db7e2319175c4f3cba494c'}\n\n```{.r .cell-code}\nplogis(0.092)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 0.5229838\n```\n:::\n:::\n\n\nThe [DHARMa package](https://cran.r-project.org/web/packages/DHARMa/vignettes/DHARMa.html) provides a general method for checking whether the residuals of a GLMM are distributed according to the specified model and whether there is any residual trend. The package works by simulating replicates of each observation according to the fitted model and then determining a \"standardized residual\", which is the relative position of the observed value with respect to the simulated values, e.g. 0 if the observation is smaller than all the simulations, 0.5 if it is in the middle, etc. If the model represents the data well, each value of the standardized residual between 0 and 1 should be equally likely, so the standardized residuals should produce a uniform distribution between 0 and 1.\n\nThe `simulateResiduals` function performs the calculation of the standardized residuals, then the `plot` function plots the diagnostic graphs with the results of certain tests.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-71_7045ff49e2f9776387a59c78b53a1341'}\n\n```{.r .cell-code}\nlibrary(DHARMa)\nres_glmm <- simulateResiduals(mod_glmm)\nplot(res_glmm)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe graph on the left is a quantile-quantile plot of standardized residuals. The results of three statistical tests also also shown: a Kolmogorov-Smirnov (*KS*) test which checks whether there is a deviation from the theoretical distribution, a dispersion test that checks whether there is underdispersion or overdispersion, and an outlier test based on the number of residuals that are more extreme than all the simulations. Here, we get a significant result for the outliers, though the message indicates that this result might have an inflated type I error rate in this case.\n\nOn the right, we generally get a graph of standardized residuals (in *y*) as a function of the rank of the predicted values, in order to check for any leftover trend in the residual. Here, the predictions are binned by quartile, so it might be better to instead aggregate the predictions and residuals by village, which we can do with the `recalculateResiduals` function.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-72_65a9d2bb93c9d14f4d7fcc7b40b03c87'}\n\n```{.r .cell-code}\nplot(recalculateResiduals(res_glmm, group = gambia$id_village))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nThe plot to the right now shows individual points, along with a quantile regression for the 1st quartile, the median and the 3rd quartile. In theory, these three curves should be horizontal straight lines (no leftover trend in the residuals vs. predictions). The curve for the 3rd quartile (in red) is significantly different from a horizontal line, which could indicate some systematic effect that is missing from the model.\n\n## Spatial GLMM with spaMM\n\nThe *spaMM* (spatial mixed models) package is a relatively new R package that can perform approximate maximum likelihood estimation of parameters for GLMM with spatial dependence, modelled either as a Gaussian process or with a CAR (we will see the latter in the last section). The package implements different algorithms, but there is a single `fitme` function that chooses the appropriate algorithm for each model type. For example, here is the same (non-spatial) model as above fit with *spaMM*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-73_4095dfb1a2890efd12578324ce9cfb41'}\n\n```{.r .cell-code}\nlibrary(spaMM)\n\nmod_spamm_glmm <- fitme(pos ~ netuse + phc + (1 | id_village),\n data = gambia, family = binomial)\nsummary(mod_spamm_glmm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + (1 | id_village)\nEstimation of lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.1491 0.2287 0.6519\nnetuse -0.6045 0.1420 -4.2567\nphc -0.4986 0.2593 -1.9231\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n id_village : 0.8151 \n --- Coefficients for log(lambda):\n Group Term Estimate Cond.SE\n id_village (Intercept) -0.2045 0.2008\n# of obs: 2035; # of groups: id_village, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1210.016\n```\n:::\n:::\n\n\nNote that the estimates of the fixed effects as well as the variance of random effects are nearly identical to those obtained by `glmer` above.\n\nWe can now use *spaMM* to fit the same model with the addition of spatial correlations between villages. In the formula of the model, this is represented as a random effect `Matern(1 | x + y)`, which means that the intercepts are spatially correlated between villages following a Matérn correlation function of coordinates (*x, y*). The Matérn function is a flexible function for spatial correlation that includes a shape parameter $\\nu$ (`nu`), so that when $\\nu = 0.5$ it is equivalent to the exponential correlation but as $\\nu$ grows to large values, it approaches a Gaussian correlation. We could let the function estimate $\\nu$, but here we will fix it to 0.5 with the `fixed` argument of `fitme`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-74_d3aef70cffd85f41f037e30922c132c2'}\n\n```{.r .cell-code}\nmod_spamm <- fitme(pos ~ netuse + phc + Matern(1 | x + y) + (1 | id_village),\n data = gambia, family = binomial, fixed = list(nu = 0.5))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nIncrease spaMM.options(separation_max=<.>) to at least 21 if you want to check separation (see 'help(separation)').\n```\n:::\n\n```{.r .cell-code}\nsummary(mod_spamm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + Matern(1 | x + y) + (1 | id_village)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.06861 0.3352 0.2047\nnetuse -0.51719 0.1407 -3.6757\nphc -0.44416 0.2052 -2.1648\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.nu 1.rho \n0.50000000 0.05128692 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n x + y : 0.6421 \n id_village : 0.1978 \n# of obs: 2035; # of groups: x + y, 65; id_village, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1197.968\n```\n:::\n:::\n\n\nLet's first check the random effects of the model. The spatial correlation function has a parameter `rho` equal to 0.0513. This parameter in *spaMM* is the inverse of the range, so here the range of exponential correlation is 1/0.0513 or around 19.5 km. There are now two variance prameters, the one identified as `x + y` is the long-range variance (i.e. sill) for the exponential correlation model whereas the one identified as `id_village` shows the non-spatially correlated portion of the variation between villages.\n\nIn fact, while we left the random effects `(1 | id_village)` in the formula to represent the non-spatial portion of variation between villages, we could also represent this with a nugget effect in the geostatistical model. In both cases, it would represent the idea that even two villages very close to each other would have different baseline prevalences in the model.\n\nBy default, the `Matern` function has no nugget effect, but we can add one by specifying a non-zero `Nugget` in the initial parameter list `init`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-75_dbd5d25ae78a3c934126be892144af99'}\n\n```{.r .cell-code}\nmod_spamm2 <- fitme(pos ~ netuse + phc + Matern(1 | x + y),\n data = gambia, family = binomial, fixed = list(nu = 0.5),\n init = list(Nugget = 0.1))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nIncrease spaMM.options(separation_max=<.>) to at least 21 if you want to check separation (see 'help(separation)').\n```\n:::\n\n```{.r .cell-code}\nsummary(mod_spamm2)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + Matern(1 | x + y)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.06861 0.3352 0.2047\nnetuse -0.51719 0.1407 -3.6757\nphc -0.44416 0.2052 -2.1648\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.nu 1.Nugget 1.rho \n0.50000000 0.23551027 0.05128692 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n x + y : 0.8399 \n# of obs: 2035; # of groups: x + y, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1197.968\n```\n:::\n:::\n\n\nAs you can see, all estimates are the same, except that the variance of the spatial portion (sill) is now 0.84 and the nugget is equal to a fraction 0.235 of that sill, so a variance of 0.197, which is the same as the `id_village` random effect in the version above. Thus the two formulations are equivalent.\n\nNow, recall the coefficients we obtained for the non-spatial GLMM:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-76_2ff7323dca01a1d9207ef38489d6b664'}\n\n```{.r .cell-code}\nsummary(mod_glmm)$coefficients\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 0.1490596 0.2296971 0.6489399 5.163772e-01\nnetuse -0.6043602 0.1442448 -4.1898243 2.791706e-05\nphc -0.4984835 0.2604083 -1.9142382 5.558973e-02\n```\n:::\n:::\n\n\nIn the spatial version, both fixed effects have moved slightly towards zero, but the standard error of the effect of `phc` has decreased. It is interesting that the inclusion of spatial dependence has allowed us to estimate more precisely the effect of having a public health centre in the village. This would not always be the case: for a predictor that is also strongly correlated in space, spatial correlation in the response makes it harder to estimate the effect of this predictor, since it is confounded with the spatial effect. However, for a predictor that is not correlated in space, including the spatial effect reduces the residual (non-spatial) variance and may thus increase the precision of the predictor's effect.\n\nThe *spaMM* package is also compatible with *DHARMa* for residual diagnostics. (You can in fact ignore the warning that it is not in the class of supported models, this is due to using the `fitme` function rather than a specific algorithm function in *spaMM*.)\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-77_435151fa87f7c6c10fa17fe4778779f0'}\n\n```{.r .cell-code}\nres_spamm <- simulateResiduals(mod_spamm2)\nplot(res_spamm)\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nplot(recalculateResiduals(res_spamm, group = gambia$id_village))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nFinally, while we will show how to make and visualize spatial predictions below, we can produce a quick map of the estimated spatial effects in a *spaMM* model with the `filled.mapMM` function.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-78_9aa73f93f8884bdd0fab5e2e18929e73'}\n\n```{.r .cell-code}\nfilled.mapMM(mod_spamm2)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n## Gaussian process models vs. smoothing splines\n\nIf you are familiar with generalized additive models (GAM), you might think that the spatial variation in malaria prevalence (as shown in the map above) could be represented by a 2D smoothing spline (as a function of $x$ and $y$) within a GAM.\n\nThe code below fits the GAM equivalent of our Gaussian process GLMM above with the `gam` function in the *mgcv* package. The spatial effect is represented by the 2D spline `s(x, y)` whereas the non-spatial random effect of village is represented by `s(id_village, bs = \"re\")`, which is the same as `(1 | id_village)` in the previous models. Note that for the `gam` function, categorical variables must be explicitly converted to factors.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-79_ae40737239f2e38abf88e2861e3870b5'}\n\n```{.r .cell-code}\nlibrary(mgcv)\ngambia$id_village <- as.factor(gambia$id_village)\nmod_gam <- gam(pos ~ netuse + phc + s(id_village, bs = \"re\") + s(x, y), \n data = gambia, family = binomial)\n```\n:::\n\n\nTo visualize the 2D spline, we will use the [*gratia* package](https://fromthebottomoftheheap.net/2018/10/23/introducing-gratia/).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-80_d5c74c6f14896719f6bab59691ffa563'}\n\n```{.r .cell-code}\nlibrary(gratia)\ndraw(mod_gam)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNote that the plot of the spline `s(x, y)` (top right) does not extend too far from the locations of the data (other areas are blank). In this graph, we can also see that the village random effects follow the expected Gaussian distribution (top left).\n\nNext, we will use both the spatial GLMM from the previous section and this GAMM to predict the mean prevalence on a spatial grid of points contained in the file [gambia_pred.csv](data/gambia_pred.csv). The graph below adds those prediction points (in black) on the previous map of the data points.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-81_29ad1d87f053e7c4195d592da7d54ff1'}\n\n```{.r .cell-code}\ngambia_pred <- read.csv(\"data/gambia_pred.csv\")\n\nggplot(gambia_agg, aes(x = x, y = y)) +\n geom_point(data = gambia_pred) +\n geom_point(aes(color = prev)) +\n geom_path(data = gambia.borders, aes(x = x / 1000, y = y / 1000)) +\n coord_fixed() +\n theme_minimal() +\n scale_color_viridis_c()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nTo make predictions from the GAMM model at those points, the code below goes through the following steps:\n\n- All predictors in the model must be in the prediction data frame, so we add constant values of *netuse* and *phc* (both equal to 1) for all points. Thus, we will make predictions of malaria prevalence in the case where a net is used and a public health centre is present. We also add a constant *id_village*, although it will not be used in predictions (see below).\n\n- We call the `predict` function on the output of `gam` to produce predictions at the new data points (argument `newdata`), including standard errors (`se.fit = TRUE`) and excluding the village random effects, so the prediction is made for an \"average village\". The resulting object `gam_pred` will have columns `fit` (mean prediction) and `se.fit` (standard error). Those predictions and standard errors are on the link (logit) scale.\n\n- We add the original prediction data frame to `gam_pred` with `cbind`.\n\n- We add columns for the mean prediction and 50% confidence interval boundaries (mean $\\pm$ 0.674 standard error), converted from the logit scale to the probability scale with `plogis`. We choose a 50% interval since a 95% interval may be too wide here to contrast the different predictions on the map at the end of this section.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-82_a655e5eb759da0f74f34c89ed61d58a2'}\n\n```{.r .cell-code}\ngambia_pred <- mutate(gambia_pred, netuse = 1, phc = 1, id_village = 1)\n\ngam_pred <- predict(mod_gam, newdata = gambia_pred, se.fit = TRUE, \n exclude = \"s(id_village)\")\ngam_pred <- cbind(gambia_pred, as.data.frame(gam_pred))\ngam_pred <- mutate(gam_pred, pred = plogis(fit), \n lo = plogis(fit - 0.674 * se.fit), # 50% CI\n hi = plogis(fit + 0.674 * se.fit))\n```\n:::\n\n\n*Note*: The reason we do not make predictions directly on the probability (response) scale is that the normal formula for confidence intervals applies more accurately on the logit scale. Adding a certain number of standard errors around the mean on the probability scale would lead to less accurate intervals and maybe even confidence intervals outside the possible range (0, 1) for a probability.\n\nWe apply the same strategy to make predictions from the *spaMM* spatial GLMM model. There are a few differences in the `predict` method compared with the GAMM case.\n\n- The argument `binding = \"fit\"` means that mean predictions (`fit` column) will be attached to the prediction dataset and returned as `spamm_pred`.\n\n- The `variances = list(linPred = TRUE)` tells `predict` to calculate the variance of the linear predictor (so the square of the standard error). However, it appears as an attribute `predVar` in the output data frame rather than a `se.fit` column, so we move it to a column on the next line.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-83_8466cc239c165bb619c3ec38ce8db16a'}\n\n```{.r .cell-code}\nspamm_pred <- predict(mod_spamm, newdata = gambia_pred, type = \"link\",\n binding = \"fit\", variances = list(linPred = TRUE))\nspamm_pred$se.fit <- sqrt(attr(spamm_pred, \"predVar\"))\nspamm_pred <- mutate(spamm_pred, pred = plogis(fit), \n lo = plogis(fit - 0.674 * se.fit),\n hi = plogis(fit + 0.674 * se.fit))\n```\n:::\n\n\nFinally, we combine both sets of predictions as different rows of a `pred_all` dataset with `bind_rows`. The name of the dataset each prediction originates from (`gam` or `spamm`) will appear in the \"model\" column (argument `.id`). To simplify production of the next plot, we then use `pivot_longer` in the *tidyr* package to change the three columns \"pred\", \"lo\" and \"hi\" to two columns, \"stat\" and \"value\" (`pred_tall` has thus three rows for every row in `pred_all`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-84_7a8a967d3486a1ba90686ccd4eede914'}\n\n```{.r .cell-code}\npred_all <- bind_rows(gam = gam_pred, spamm = spamm_pred, .id = \"model\")\n\nlibrary(tidyr)\npred_tall <- pivot_longer(pred_all, c(pred, lo, hi), names_to = \"stat\",\n values_to = \"value\")\n```\n:::\n\n\nHaving done these steps, we can finally look at the prediction maps (mean, lower and upper bounds of the 50% confidence interval) with `ggplot`. The original data points are shown in red.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-85_31003401bd646a7f13b4009bc478ce83'}\n\n```{.r .cell-code}\nggplot(pred_tall, aes(x = x, y = y)) +\n geom_point(aes(color = value)) +\n geom_point(data = gambia_agg, color = \"red\", size = 0) +\n coord_fixed() +\n facet_grid(stat~model) +\n scale_color_viridis_c() +\n theme_minimal()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nWhile both models agree that there is a higher prevalence near the eastern cluster of villages, the GAMM also estimates a higher prevalence at a few points (western edge and around the center) where there is no data. This is an artifact of the shape of the spline fit around the data points, since a spline is meant to fit a global, although nonlinear, trend. In contrast, the geostatistical model represents the spatial effect as local correlations and reverts to the overall mean prevalence when far from any data points, which is a safer assumption. This is one reason to choose a geostatistical / Gaussian process model in this case.\n\n## Bayesian methods for GLMMs with Gaussian processes\n\nBayesian models provide a flexible framework to express models with complex dependence structure among the data, including spatial dependence. However, fitting a Gaussian process model with a fully Bayesian approach can be slow, due the need to compute a spatial covariance matrix between all point pairs at each iteration.\n\nThe INLA (integrated nested Laplace approximation) method performs an approximate calculation of the Bayesian posterior distribution, which makes it suitable for spatial regression problems. We do not cover it in this course, but I recommend the textbook by Paula Moraga (in the references section below) that provides worked examples of using INLA for various geostatistical and areal data models, in the context of epidemiology, including models with both space and time dependence. The book presents the same Gambia malaria data as an example of a geostatistical dataset, which inspired its use in this course.\n\n# GLMM with spatial autoregression {#glmm-spatial-autoreg}\n\nWe return to the last example of the previous part, where we modelled the rate of COVID-19 cases (cases / 1000) for administrative health network divisions (RLS) in Quebec as a function of their population density. The rate is given by the \"taux_1k\" column in the `rls_covid` shapefile.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-86_dee7e0520a18d70a7e5f70f91e7f0d0a'}\n\n```{.r .cell-code}\nlibrary(sf)\nrls_covid <- read_sf(\"data/rls_covid.shp\")\nrls_covid <- rls_covid[!is.na(rls_covid$dens_pop), ]\nplot(rls_covid[\"taux_1k\"])\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nPreviously, we modelled the logarithm of this rate as a linear function of the logarithm of population density, with the residual variance correlated among neighbouring units via a CAR (conditional autoregression) structure, as shown in the code below.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-87_51a48c9cba07b64df6887bc1c93140b3'}\n\n```{.r .cell-code}\nlibrary(spdep)\nlibrary(spatialreg)\n\nrls_nb <- poly2nb(rls_covid)\nrls_w <- nb2listw(rls_nb, style = \"B\")\n\ncar_lm <- spautolm(log(taux_1k) ~ log(dens_pop), data = rls_covid,\n listw = rls_w, family = \"CAR\")\nsummary(car_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = log(taux_1k) ~ log(dens_pop), data = rls_covid, \n listw = rls_w, family = \"CAR\")\n\nResiduals:\n Min 1Q Median 3Q Max \n-1.201858 -0.254084 -0.053348 0.281482 1.427053 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 1.702068 0.168463 10.1035 < 2.2e-16\nlog(dens_pop) 0.206623 0.032848 6.2903 3.169e-10\n\nLambda: 0.15762 LR test value: 23.991 p-value: 9.6771e-07 \nNumerical Hessian standard error of lambda: 0.0050486 \n\nLog likelihood: -80.68953 \nML residual variance (sigma squared): 0.2814, (sigma: 0.53048)\nNumber of observations: 95 \nNumber of parameters estimated: 4 \nAIC: 169.38\n```\n:::\n:::\n\n\nAs a reminder, the `poly2nb` function in the *spdep* package creates a list of neighbours based on bordering polygons in a shapefile, then the `nb2listw` converts it to a list of weights, here binary weights (`style = \"B\"`) so that each bordering region receives the same weight of 1 in the autoregressive model.\n\nInstead of using the rates, it would be possible to model the cases directly (column \"cas\" in the dataset) with a Poisson regression, which is appropriate for count data. To account for the fact that if the risk per person were equal, cases would be proportional to population, we can add the unit's population `pop` as an *offset* in the Poisson regression. Therefore, the model would look like: `cas ~ log(dens_pop) + offset(log(pop))`. Note that since the Poisson regression uses a logarithmic link, that model with `log(pop)` as an offset assumes that `log(cas / pop)` (so the log rate) is proportional to `log(dens_pop)`, just like the linear model above, but it has the advantage of modelling the stochasticity of the raw data (the number of cases) directly with a Poisson distribution.\n\nWe do not have the population in this data, but we can estimate it from the cases and the rate (cases / 1000) as follows:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-88_dd571339361d6d0f00653ec574a812b8'}\n\n```{.r .cell-code}\nrls_covid$pop <- rls_covid$cas / rls_covid$taux_1k * 1000\n```\n:::\n\n\nTo define a CAR model in *spaMM*, we need a weights matrix rather than a list of weights as in the *spatialreg* package. Fortunately, the *spdep* package also includes a function `nb2mat` to convert the neighbours list to a matrix of weights, here again using binary weights. To avoid a warning, we specify the row and column names of that matrix to be equal to the IDs associated with each unit (`RLS_code`). Then, we add a term `adjacency(1 | RLS_code)` to the model to specify that the residual variation between different groups defined by `RLS_code` is spatially correlated with a CAR structure (here, each group has only one observation since we have one data point by RLS unit).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-89_96e9784ebad8d38cbd211f444a330b0c'}\n\n```{.r .cell-code}\nlibrary(spaMM)\n\nrls_mat <- nb2mat(rls_nb, style = \"B\")\nrownames(rls_mat) <- rls_covid$RLS_code\ncolnames(rls_mat) <- rls_covid$RLS_code\n\nrls_spamm <- fitme(cas ~ log(dens_pop) + offset(log(pop)) + adjacency(1 | RLS_code),\n data = rls_covid, adjMatrix = rls_mat, family = poisson)\nsummary(rls_spamm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: cas ~ log(dens_pop) + offset(log(pop)) + adjacency(1 | RLS_code)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: poisson( link = log ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) -5.1618 0.16855 -30.625\nlog(dens_pop) 0.1999 0.03267 6.119\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.rho \n0.1576605 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n RLS_code : 0.266 \n# of obs: 95; # of groups: RLS_code, 95 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -709.3234\n```\n:::\n:::\n\n\nNote that the spatial correlation coefficient `rho` (0.158) is similar to the equivalent quantity in the `spautolm` model above, where it was called `Lambda`. The effect of `log(dens_pop)` is also approximately 0.2 in both models.\n\n## Reference\n\nMoraga, Paula (2019) Geospatial Health Data: Modeling and Visualization with R-INLA and Shiny. Chapman & Hall/CRC Biostatistics Series. Available online at .\n\n------------------------------------------------------------------------\n\n# Statistiques spatiales en écologie {#statistiques-spatiales-en-écologie}\n\nBIOS² a organisé une session de formation en ligne sur l'analyse statistique des données spatiales en écologie, animée par le Pr. Philippe Marchand (UQAT). Cette formation de 12 heures s'est déroulée en 4 sessions : 12, 14, 19 & 21 janvier (2021) de 13h00 à 16h00 HNE.\n\nLe contenu comprenait trois types d'analyses statistiques spatiales et leurs applications en écologie : (1) l'analyse des patrons de points qui permet d'étudier la distribution d'individus ou d'événements dans l'espace; (2) les modèles géostatistiques qui représentent la corrélation spatiale de variables échantillonnées à des points géoréférencés; et (3) les modèles de données aréales, qui s'appliquent aux mesures prises sur des régions de l'espace et qui représentent les liens spatiaux par le biais de réseaux de voisinage. La formation comprenait également des exercices pratiques utilisant l'environnement de programmation statistique R.\n\n[Philippe Marchand](https://github.com/pmarchand1) est professeur d'écologie et de biostatistique à l'Institut de recherche sur les forêts, Université du Québec en Abitibi-Témiscamingue (UQAT) et membre académique de BIOS². Ses travaux de recherche portent sur la modélisation de processus qui influencent la distribution spatiale des populations, incluant: la dispersion des graines et l'établissement des semis, le mouvement des animaux, et la propagation des épidémies forestières.\n\n**Si vous souhaitez consulter le matériel pédagogique et suivre les exercices à votre propre rythme, vous pouvez y accéder par [ce lien](https://bios2.github.io/Marchand.html#category:FR). Une connaissance de base des modèles de régression linéaire et une expérience de l'ajustement de ces modèles dans R sont recommandées. Le repositoire original se trouve [ici](https://github.com/pmarchand1/BIOS2-spatial-stats).**\n\n## Plan du cours\n\n| Jour | Sujets | \n|-----------------|:--------------------------|\n| 1 | • [Introduction aux statistiques spatiales](#introduction-fr) • [Analyse des patrons de points](#point-pattern-fr) |\n| 2 | • [Corrélation spatiale d'une variable](#spatial-correlation-fr) • [Modèles géostatistiques](#geostat-models-fr) | \n| 3 | • [Données aréales](#areal-data-fr) • [Indice de Moran](#moran-i-fr) • [Modèles d'autorégression spatiale](#spatial-autoreg-fr) • [Analyse des données aréales dans R](#analysis-areal-fr) |\n| 4 | • [GLMM avec processus spatial gaussien](#glmm-spatial-gaussian-fr) • [GLMM avec autorégression spatiale](#glmm-spatial-autoreg-fr)| \n\n# Introduction aux statistiques spatiales {#introduction-fr}\n\n## Types d'analyses spatiales\n\nDans le cadre de cette formation, nous discuterons de trois types d'analyses spatiales: l'analyse des patrons de points, les modèles géostatistiques et les modèles de données aréales.\n\nDans l'**analyse des patrons de points**, nous avons des données ponctuelles représentant la position d'individus ou d'événements dans une région d'étude et nous supposons que tous les individus ou événements ont été recensés dans cette région. Cette analyse s'intéresse à la distribution des positions des points eux-mêmes. Voici quelques questions typiques de l'analyse des patrons de points:\n\n- Les points sont-ils disposés aléatoirement ou agglomérés?\n\n- Deux types de points sont-ils disposés indépendamment?\n\nLes **modèles géostatistiques** visent à représenter la distribution spatiale de variables continues qui sont mesurés à certains points d'échantillonnage. Ils supposent que les mesures de ces variables à différents points sont corrélées en fonction de la distance entre ces points. Parmi les applications des modèles géostatistiques, notons le lissage des données spatiales (ex.: produire une carte d'une variable sur l'ensemble d'une région en fonction des mesures ponctuelles) et la prédiction de ces variables pour des points non-échantillonnés.\n\nLes **données aréales** sont des mesures prises non pas à des points, mais pour des régions de l'espace représentées par des polygones (ex.: divisions du territoire, cellules d'une grille). Les modèles représentant ces types de données définissent un réseau de voisinage reliant les régions et incluent une corrélation spatiale entre régions voisines. \n\n## Stationnarité et isotropie\n\nPlusieurs analyses spatiales supposent que les variables sont **stationnaires** dans l'espace. Comme pour la stationnarité dans le domaine temporel, cette propriété signifie que les statistiques sommaires (moyenne, variance et corrélations entre mesures d'une variable) ne varient pas avec une translation dans l'espace. Par exemple, la corrélation spatiale entre deux points peut dépendre de la distance les séparant, mais pas de leur position absolue.\n\nEn particulier, il ne peut pas y avoir de tendance à grande échelle (souvent appelée *gradient* dans un contexte spatial), ou bien cette tendance doit être prise en compte afin de modéliser la corrélation spatiale des résidus.\n\nDans le cas de l'analyse des patrons de points, la stationnarité (aussi appelée homogénéité dans ce contexte) signifie que la densité des points ne suit pas de tendance à grande échelle.\n\nDans un modèle statistique **isotropique**, les corrélations spatiales entre les mesures à deux points dépendent seulement de la distance entre ces points, pas de la direction. Dans ce cas, les statistiques sommaires ne varient pas si on effectue une rotation dans l'espace.\n\n## Données géoréférencées\n\nLes études environnementales utilisent de plus en plus de données provenant de sources de données géospatiales, c'est-à-dire des variables mesurées sur une grande partie du globe (ex.: climat, télédétection). Le traitement de ces données requiert des concepts liés aux systèmes d'information géographique (SIG), qui ne sont pas couverts dans cet atelier, alors que nous nous concentrons sur les aspects statistiques de données variant dans l'espace.\n\nL'utilisation de données géospatiales ne signifie pas nécessairement qu'il faut avoir recours à des statistiques spatiales. Par exemple, il est courant d'extraire les valeurs de ces variables géographiques à des points d'étude pour expliquer une réponse biologique observée sur le terrain. Dans ce cas, l'utilisation de statistiques spatiales est seulement nécessaire en présence d'une corrélation spatiale dans les résidus, après avoir tenu compte de l'effet des prédicteurs.\n\n\n# Analyse des patrons de points {#point-pattern-fr}\n\n## Patron de points et processus ponctuel\n\nUn patron de points (*point pattern*) décrit la position spatiale (le plus souvent en 2D) d'individus ou d'événements, représentés par des points, dans une aire d'étude donnée, souvent appelée la *fenêtre* d'observation. \n\nOn suppose que chaque point a une étendue spatiale négligeable par rapport aux distances entre les points. Des méthodes plus complexes existent pour traiter des patrons spatiaux d'objets qui ont une largeur non-néligeable, mais ce sujet dépasse la portée de cet atelier.\n\nUn processus ponctuel (*point process*) est un modèle statistique qui peut être utilisé pour simuler des patrons de points ou expliquer un patron de points observé.\n\n## Structure spatiale totalement aléatoire\n\nUne structure spatiale totalement aléatoire (*complete spatial randomness*) est un des patrons les plus simples, qui sert de modèle nul pour évaluer les caractéristiques de patrons de points réels. Dans ce patron, la présence d'un point à une position donnée est indépendante de la présence de points dans un voisinage. \n\nLe processus créant ce patron est un processus de Poisson homogène. Selon ce modèle, le nombre de points dans toute région de superficie $A$ suit une distribution de Poisson: $N(A) \\sim \\text{Pois}(\\lambda A)$, où $\\lambda$ est l'*intensité* du processus (i.e. la densité de points). $N$ est indépendant entre deux régions disjointes, peu importe comment ces régions sont définies.\n\nDans le graphique ci-dessous, seul le patron à droite est totalement aléatoire. Le patron à gauche montre une agrégation des points (probabilité plus grande d'observer un point si on est à proximité d'un autre point), tandis que le patron du centre montre une répulsion (faible probabilité d'observer un point très près d'un autre).\n\n\n\n\n::: {.cell fig.dim='[9,3]' hash='index_cache/html/unnamed-chunk-91_adc67cb15e035b62bde9aae5a2aa1217'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\n## Analyse exploratoire ou inférentielle pour un patron de points\n\nPlusieurs statistiques sommaires sont utilisées pour décrire les caractéristiques un patron de points. La plus simple est l'**intensité** $\\lambda$, qui comme mentionné plus haut représente la densité de points par unité de surface. Si le patron de points est hétérogène, l'intensité n'est pas constante, mais dépend de la position: $\\lambda(x, y)$.\n\nPar rapport à l'intensité qui est une statistique dite de premier ordre, les statistiques de second ordre décrivent comment la probabilité de présence d'un point dans une région dépend de la présence d'autres points. L'indice $K$ de Ripley présenté dans la prochaine section est un exemple de statistique sommaire de second ordre.\n\nLes inférences statistiques réalisées sur des patrons de points consistent habituellement à tester l'hypothèse que le patron de points correspond à un modèle nul donné, par exemple une structure spatiale totalement aléatoire, ou un modèle nul plus complexe. Même pour les modèles nuls les plus simples, nous connaissons rarement la distribution théorique pour une statistique sommaire du patron de points sous le modèle nul. Les tests d'hypothèses sur les patrons de points sont donc réalisés par simulation: on simule un grand nombre de patrons de points à partir du modèle nul et on compare la distribution des statistiques sommaires qui nous intéressent pour ces simulations à la valeur des statistiques pour le patron de points observé.\n\n## Indice $K$ de Ripley\n\nL'indice de Ripley $K(r)$ est défini comme le nombre moyen de points se trouvant dans un cercle de rayon $r$ donné autour d'un point du patron, normalisé par l'intensité $\\lambda$. \n\nPour un patron totalement aléatoire, le nombre moyen de points dans un cercle de rayon $r$ est $\\lambda \\pi r^2$, donc en théorie $K(r) = \\pi r^2$ pour ce modèle nul. Une valeur de $K(r)$ supérieure signifie qu'il y a agrégation des points à l'échelle $r$, tandis qu'une valeur inférieure signifie qu'il y a une répulsion.\n\nEn pratique, $K(r)$ est estimé pour un patron de points donné par l'équation:\n\n$$ K(r) = \\frac{A}{n(n-1)} \\sum_i \\sum_{j > i} I \\left( d_{ij} \\le r \\right) w_{ij}$$\n\noù $A$ est l'aire de la fenêtre d'observation et $n$ est le nombre de points du patron, donc $n(n-1)$ est le nombre de paires de points distinctes. On fait la somme pour toutes les paires de points de la fonction indicatrice $I$, qui prend une valeur de 1 si la distance entre les points $i$ et $j$ est inférieure ou égale à $r$. Finalement, le terme $w_{ij}$ permet de donner un poids supplémentaire à certaines paires de points pour tenir compte des effets de bordure, tel que discuté dans la section suivante.\n\nPar exemple, les graphiques ci-dessous présentent la fonction estimée $K(r)$ pour les patrons illustrés ci-dessus, pour des valeurs de $r$ allant jusqu'à 1/4 de la largeur de la fenêtre. La courbe pointillée rouge indique la valeur théorique pour une structure spatiale totalement aléatoire et la zone grise est une \"enveloppe\" produite par 99 simulations de ce modèle nul. Le patron agrégé montre un excès de voisins jusqu'à $r = 0.25$ et le patron avec répulsion montre un déficit significatif de voisins pour les petites valeurs de $r$. \n\n\n\n\n::: {.cell fig.dim='[9,3]' hash='index_cache/html/unnamed-chunk-93_6abeb25aeaeb61368f985f60bb26c046'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\nOutre le $K$, il existe d'autres statistiques pour décrire les propriétés de second ordre du patron, par exemple la distance moyenne entre un point et ses $N$ plus proches voisins. Vous pouvez consulter le manuel de Wiegand et Moloney (2013) suggéré en référence pour en apprendre plus sur différentes statistiques sommaires des patrons de points.\n\n## Effets de bordure\n\nDans le contexte de l'analyse de patrons de points, l'effet de bordure (\"edge effect\") est dû au fait que nous avons une connaissance incomplète du voisinage des points près du bord de la fenêtre d'observation, ce qui peut induire un biais dans le calcul des statistiques comme le $K$ de Ripley. \n\nDifférentes méthodes ont été développées pour corriger le biais dû aux effets de bordure. Selon la méthode de Ripley, la contribution d'un voisin $j$ situé à une distance $r$ d'un point $i$ reçoit un poids $w_{ij} = 1/\\phi_i(r)$, où $\\phi_i(r)$ est la fraction du cercle de rayon $r$ autour de $i$ contenu dans la fenêtre d'observation. Par exemple, si 2/3 du cercle se trouve dans la fenêtre, ce voisin compte pour 3/2 voisins dans le calcul d'une statistique comme $K$.\n\n\n\nLa méthode de Ripley est une des plus simples pour corriger les effets de bordure, mais n'est pas nécessairement la plus efficace; notamment, les poids plus grands donnés à certaines paires de points tend à accroître la variance du calcul de la statistique. D'autres méthodes de correction sont présentées dans les manuels spécialisés, comme celui de Wiegand et Moloney (2013) en référence.\n\n## Exemple\n\nPour cet exemple, nous utilisons le jeu de données [semis_xy.csv](data/semis_xy.csv), qui représente les coordonnées $(x, y)$ de semis de deux espèces (*sp*, B = bouleau et P = peuplier) dans une placette de 15 x 15 m.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-94_327e5e9e3c1899c6fc6b1fb294f06e68'}\n\n```{.r .cell-code}\nsemis <- read.csv(\"data/semis_xy.csv\")\nhead(semis)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n x y sp\n1 14.73 0.05 P\n2 14.72 1.71 P\n3 14.31 2.06 P\n4 14.16 2.64 P\n5 14.12 4.15 B\n6 9.88 4.08 B\n```\n:::\n:::\n\n\nLe package *spatstat* permet d'effectuer des analyses de patrons de point dans R. La première étape consiste à transformer notre tableau de données en objet `ppp` (patron de points) avec la fonction du même nom. Dans cette fonction, nous spécifions quelles colonnes contiennent les coordonnées *x* et *y* ainsi que les marques (`marks`), qui seront ici les codes d'espèce. Il faut aussi spécifier une fenêtre d'observation (`window`) à l'aide de la fonction `owin`, à laquelle nous indiquons les limites de la placette en *x* et *y*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-95_e246a905ab0e728b8bebd2e4c7effcef'}\n\n```{.r .cell-code}\nlibrary(spatstat)\n\nsemis <- ppp(x = semis$x, y = semis$y, marks = as.factor(semis$sp),\n window = owin(xrange = c(0, 15), yrange = c(0, 15)))\nsemis\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nMarked planar point pattern: 281 points\nMultitype, with levels = B, P \nwindow: rectangle = [0, 15] x [0, 15] units\n```\n:::\n:::\n\n\nLes marques peuvent être numériques ou catégorielles. Notez que pour des marques catégorielles comme c'est le cas ici, il faut convertir explicitement la variable en facteur.\n\nLa fonction `plot` appliquée à un patron de points montre un diagramme du patron.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-96_96d77aa12e04c69ed21ee84e297dba59'}\n\n```{.r .cell-code}\nplot(semis)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLa fonction `intensity` calcule la densité des points de chaque espèce par unité de surface, ici en $m^2$.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-97_beac65d0093c1448eec5b7873eb79e0b'}\n\n```{.r .cell-code}\nintensity(semis)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n B P \n0.6666667 0.5822222 \n```\n:::\n:::\n\n\nPour analyser d'abord séparément la distribution de chaque espèce, nous séparons le patron avec `split`. Puisque le patron contient des marques catégorielles, la séparation se fait automatiquement en fonction de la valeur des marques. Le résultat est une liste de deux patrons de points.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-98_b03959fb9ef2a14b73c3512a12d3e227'}\n\n```{.r .cell-code}\nsemis_split <- split(semis)\nplot(semis_split)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLa fonction `Kest` calcule le $K$ de Ripley pour une série de distances allant (par défaut) jusqu'à 1/4 de la largeur de la fenêtre. Ici, nous l'appliquons au premier patron (bouleau) en choisissant `semis_split[[1]]`. Notez que les doubles crochets sont nécessaires pour choisir un élément d'une liste dans R.\n\nL'argument `correction = \"iso\"` indique d'appliquer la méthode de Ripley pour corriger les effets de bordure.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-99_181444d1e19a264175dc77ad57d2d3d0'}\n\n```{.r .cell-code}\nk <- Kest(semis_split[[1]], correction = \"iso\")\nplot(k)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nSelon ce graphique, il semble y avoir une excès de voisins à partir d'un rayon de 1 m. Pour vérifier s'il s'agit d'un écart significatif, nous produisons une enveloppe de simulation avec la fonction `envelope`. Le permier argument d'`envelope` est un patron de point auquel les simulations seront comparées, le deuxième une fonction à calculer (ici, `Kest`) pour chaque patron simulé, puis on y ajoute les arguments de la fonction `Kest` (ici, seulement `correction`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-100_c8ef12d95e636626e72d894b8455cc8e'}\n\n```{.r .cell-code}\nplot(envelope(semis_split[[1]], Kest, correction = \"iso\"))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 99 simulations of CSR ...\n1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,\n41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,\n81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nTel qu'indiqué par le message, cette fonction effectue par défaut 99 simulations de l'hypothèse nulle correspondant à une structure spatiale totalement aléatoire (CSR, pour *complete spatial randomness*).\n\nLa courbe observée sort de l'enveloppe des 99 simulations près de $r = 2$. Il faut être prudent de ne pas interpréter trop rapidement un résultat sortant de l'enveloppe. Même s'il y a environ une probabilité de 1% d'obtenir un résultat plus extrême selon l'hypothèse nulle à une distance donnée, l'enveloppe est calculée pour un grand nombre de valeurs de la distance et nous n'effectuons pas de correction pour les comparaisons multiples. Ainsi, un écart significatif pour une très petite plage de valeurs de $r$ peut être simplement dû au hasard.\n\n\n### Exercice 1\n\nEn regardant le graphique du deuxième patron de points (semis de peuplier), pouvez-vous prédire où se situera le $K$ de Ripley par rapport à l'hypothèse nulle d'une structure spatiale totalement aléatoire? Vérifiez votre prédiction en calculant le $K$ de Ripley pour ce patron de points dans R.\n\n\n## Effet de l'hétérogénéité\n\nLe graphique ci-dessous illustre un patron de points *hétérogène*, c'est-à-dire qu'il présente un gradient d'intensité (plus de points à gauche qu'à droite).\n\n\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-102_4f8ece21b321a6bc37f12ea916525a4e'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nUn gradient de densité peut être confondu avec une agrégation des points, comme on peut voir sur le graphique du $K$ de Ripley correspondant. En théorie, il s'agit de deux processus différents:\n\n- Hétérogénéité: La densité de points varie dans la région d'étude, par exemple dû au fait que certaines conditions locales sont plus propices à la présence de l'espèce étudiée.\n\n- Agrégation: La densité moyenne des points est homogène, mais la présence d'un point augmente la présence d'autre points dans son voisinage, par exemple en raison d'interactions positives entre les individus.\n\nCependant, il peut être difficile de différencier les deux en pratique, surtout que certains patrons peuvent être à la fois hétérogènes et agrégés.\n\nPrenons l'exemple des semis de peuplier de l'exercice précédent. La fonction `density` appliquée à un patron de points effectue une estimation par noyau (*kernel density estimation*) de la densité des semis à travers la placette. Par défaut, cette fonction utilise un noyau gaussien avec un écart-type `sigma` spécifié dans la fonction, qui détermine l'échelle à laquelle les fluctuations de densité sont \"lissées\". Ici, nous utilisons une valeur de 2 m pour `sigma` et nous représentons d'abord la densité estimée avec `plot`, avant d'y superposer les points (`add = TRUE` signifie que les points sont ajoutés au graphique existant plutôt que de créer un nouveau graphique).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-103_293155d4d47f9be8ba5f92c275edfe33'}\n\n```{.r .cell-code}\ndens_p <- density(semis_split[[2]], sigma = 2)\nplot(dens_p)\nplot(semis_split[[2]], add = TRUE)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nPour mesurer l'agrégation ou la répulsion des points d'un patron hétérogène, nous devons utilisé la version non-homogène de la statistique $K$ (`Kinhom` dans *spatstat*). Cette statistique est toujours égale au nombre moyen de voisins dans un rayon $r$ d'un point du patron, mais plutôt que de normaliser ce nombre par l'intensité globale du patron, il est normalisé par l'estimation locale de la densité de points. Comme ci-dessus, nous spécifions `sigma = 2` pour contrôler le niveau de lissage de l'estimation de la densité variable.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-104_2e7d6e77388db4c6cf95e3825468e730'}\n\n```{.r .cell-code}\nplot(Kinhom(semis_split[[2]], sigma = 2, correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEn tenant compte de l'hétérogénéité du patron à une échelle `sigma` de 2 m, il semble donc y avoir un déficit de voisins à partir d'environ 1.5 m des points du patron. Il reste à voir si cette déviation est significative.\n\nComme précédemment, nous utilisons `envelope` pour simuler la statistique `Kinhom` sous le modèle nul. Cependant, ici le modèle nul n'est pas un processus de Poisson homogène (structure spatiale totalement aléatoire). Il s'agit plutôt d'un processus de Poisson hétérogène simulé par la fonction `rpoispp(dens_p)`, c'est-à-dire que les points sont indépendants les uns des autres, mais leur densité est hétérogène et donnée par `dens_p`. L'argument `simulate` de la fonction `envelope` permet de spécifier une fonction utilisée pour les simulations sous le modèle nul; cette fonction doit avoir un argument, ici `x`, même s'il n'est pas utilisé.\n\nFinalement, en plus des arguments nécessaires pour `Kinhom`, soit `sigma` et `correction`, nous spécifions aussi `nsim = 199` pour réaliser 199 simulations et `nrank = 5` pour éliminer les 5 résultats les plus extrêmes de chaque côté de l'enveloppe, donc les 10 plus extrêmes sur 199, pour réaliser un intervalle contenant environ 95% de la probabilité sous l'hypothèse nulle.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-105_372339d2d2e016521c3700d91cc77898'}\n\n```{.r .cell-code}\nkhet_p <- envelope(semis_split[[2]], Kinhom, sigma = 2, correction = \"iso\",\n nsim = 199, nrank = 5, simulate = function(x) rpoispp(dens_p))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(khet_p)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n*Note*: Pour un test d'hypothèse basé sur des simulations d'une hypothèse nulle, la valeur $p$ est estimée par $(m + 1)/(n + 1)$, où $n$ est le nombre de simulations et $m$ est le nombre de simulations où la valeur de la statistique est plus extrême que celle des données observées. C'est pour cette raison qu'on choisit un nombre de simulations comme 99, 199, etc.\n\n### Exercice 2\n\nRépétez l'estimation de la densité hétérogène et le calcul de `Kinhom` avec un écart-type `sigma` de 5 plutôt que 2. Comment le niveau de lissage pour la densité influence-t-il les conclusions?\n\nPour différencier une variation de densité des points et d'une interaction (agrégation ou répulsion) entre ces points avec ce type d'analyse, il faut généralement supposer que les deux processus opèrent à différentes échelles. Typiquement, nous pouvons tester si les points sont agrégés à petite échelle après avoir tenu compte d'une variation de la densité à une échelle plus grande.\n\n\n## Relation entre deux patrons de points\n\nConsidérons un cas où nous avons deux patrons de points, par exemple la position des arbres de deux espèces dans une parcelle (points oranges et verts dans le graphique ci-dessous). Chacun des deux patrons peut présenter ou non des agrégations de points. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-106_a7d54ff1bdd2b3ad9381ec359732b6e9'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nSans égard à cette agrégation au niveau de l'espèce, nous voulons déterminer si les deux espèces sont disposées indépendamment. Autrement dit, la probabilité d'observer un arbre d'une espèce dépend-elle de la présence d'un arbre de l'autre espèce à une distance donnée?\n\nLa version bivariée du $K$ de Ripley permet de répondre à cette question. Pour deux patrons désignés 1 et 2, l'indice $K_{12}(r)$ calcule le nombre moyen de points du patron 2 dans un rayon $r$ autour d'un point du patron 1, normalisé par la densité du patron 2.\n\nEn théorie, cet indice est symétrique, donc $K_{12}(r) = K_{21}(r)$ et le résultat serait le même si on choisit les points du patron 1 ou 2 comme points \"focaux\" pour l'analyse. Cependant, l'estimation des deux quantités pour un patron observé peut différer, notamment en raison des effets de bord. La variabilité peut aussi être différente pour $K_{12}$ et $K_{21}$ entre les simulations d'un modèle nul, donc le test de l'hypothèse nulle peut avoir une puissance différente selon le choix de l'espèce focale.\n\nLe choix d'un modèle nul approprié est important ici. Afin de déterminer s'il existe une attraction ou une répulsion significative entre les deux patrons, il faut déplacer aléatoirement la position d'un des patrons relative à celle de l'autre patron, tout en conservant la structure spatiale de chaque patron pris isolément.\n\nUne des façons d'effectuer cette randomisation consiste à décaler l'un des deux patrons horizontalement et/ou verticalement d'une distance aléatoire. La partie du patron qui \"sort\" d'un côté de la fenêtre est rattachée de l'autre côté. Cette méthode s'appelle une translation toroïdale (*toroidal shift*), car en connectant le haut et le bas ainsi que la gauche et la droite d'une surface rectangulaire, on obtient la forme d'un tore (un \"beigne\" en trois dimensions).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-107_1757cb541cf05d572ea82ab56ed6f90e'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLe graphique ci-dessus illustre une translation du patron vert vers la droite, tandis que le patron orange reste au même endroit. Les points verts dans la zone ombragée sont ramenés de l'autre côté. Notez que si cette méthode préserve de façon générale la structure de chaque patron tout en randomisant leur position relative, elle peut comporter certains inconvénients, comme de diviser des amas de points qui se trouvent près du point de coupure.\n\nVérifions maintenant s'il y a une dépendance entre la position des deux espèces (bouleau et peuplier) dans notre placette. La fonction `Kcross` calcule l'indice bivarié $K_{ij}$, il faut spécifier quel type de point est considéré comme l'espèce focale $i$ et l'espèce voisine $j$.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-108_e1fb67c992e6fbc5436f40af7db13109'}\n\n```{.r .cell-code}\nplot(Kcross(semis, i = \"P\", j = \"B\", correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIci, le $K$ observé est inférieur à la valeur théorique, indiquant une répulsion possible des deux patrons.\n\nPour déterminer l'enveloppe du $K$ selon l'hypothèse nulle d'indépendance des deux patrons, nous devons spécifier que les simulations doivent être basées sur une translation des patrons. Nous indiquons que les simulations doivent utiliser la fonction `rshift` (translation aléatoire) avec l'argument `simulate = function(x) rshift(x, which = \"B\")`; ici, l'argument `x` de `simulate` correspond au patron de points original et l'argument `which` indique quel type de points subit la translation. Comme pour le cas précédent, il faut répéter dans la fonction `envelope` les arguments nécessaires pour `Kcross`, soit `i`, `j` et `correction`. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-109_727b1efb5e977942d084f00027cda511'}\n\n```{.r .cell-code}\nplot(envelope(semis, Kcross, i = \"P\", j = \"B\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = function(x) rshift(x, which = \"B\")))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIci, la courbe observée se situe totalement dans l'enveloppe, donc nous ne rejetons pas l'hypothèse nulle d'indépendance des deux patrons.\n\n### Questions\n\n1. Quelle raison pourrait justifier ici notre choix d'effectuer la translation des points du bouleau plutôt que du peuplier?\n\n2. Est-ce que les simulations générées par translation aléatoire constitueraient un bon modèle nul si les deux patrons étaient hétérogènes?\n\n\n## Patrons de points marqués\n\nLe jeu de données [fir.csv](data/fir.csv) contient les coordonnées $(x, y)$ de 822 sapins dans une placette d'un hectare et leur statut (A = vivant, D = mort) suivant une épidémie de tordeuse des bourgeons de l'épinette.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-110_b43d75059cee9e8f87a67abfa290388c'}\n\n```{.r .cell-code}\nfir <- read.csv(\"data/fir.csv\")\nhead(fir)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n x y status\n1 31.50 1.00 A\n2 85.25 30.75 D\n3 83.50 38.50 A\n4 84.00 37.75 A\n5 83.00 33.25 A\n6 33.25 0.25 A\n```\n:::\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-111_2327e6a3855266c0ba92a5eed5b7ce1a'}\n\n```{.r .cell-code}\nfir <- ppp(x = fir$x, y = fir$y, marks = as.factor(fir$status),\n window = owin(xrange = c(0, 100), yrange = c(0, 100)))\nplot(fir)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nSupposons que nous voulons vérifier si la mortalité des sapins est indépendante ou corrélée entre arbres rapprochés. En quoi cette question diffère-t-elle de l'exemple précédent où nous voulions savoir si la position des points de deux espèces était indépendante?\n\nDans l'exemple précédent, l'indépendance ou l'interaction entre les espèces référait à la formation du patron lui-même (que des semis d'une espèce s'établissent ou non à proximité de ceux de l'autre espèce). Ici, la caractéristique qui nous intéresse (survie des sapins) est postérieure à l'établissement du patron, en supposant que tous ces arbres étaient vivants d'abord et que certains sont morts suite à l'épidémie. Donc nous prenons la position des arbres comme fixe et nous voulons savoir si la distribution des statuts (mort, vivant) entre ces arbres est aléatoire ou présente un patron spatial.\n\nDans le manuel de Wiegand et Moloney, la première situation (établissement de semis de deux espèces) est appelé patron bivarié, donc il s'agit vraiment de deux patrons qui interagissent, tandis que la deuxième est un seul patron avec une *marque* qualitative. Le package *spatstat* dans R ne fait pas de différences entre les deux au niveau de la définition du patron (les types de points sont toujours représentés par l'argument `marks`), mais les méthodes d'analyse appliquées aux deux questions diffèrent.\n\nDans le cas d'un patron avec une marque qualitative, nous pouvons définir une fonction de connexion de marques (*mark connection function*) $p_{ij}(r)$. Pour deux points séparés par une distance $r$, cette fonction donne la probabilité que le premier point porte la marque $i$ et le deuxième la marque $j$. Selon l'hypothèse nulle où les marques sont indépendantes, cette probabilité est égale au produit des proportions de chaque marque dans le patron entier, $p_{ij}(r) = p_i p_j$ indépendamment de $r$.\n\nDans *spatstat*, la fonction de connexion de marques est calculée avec la fonction `markconnect`, où il faut spécifier les marques $i$ et $j$ ainsi que le type de correction des effets de bord. Dans notre exemple, nous voyons que deux points rapprochés ont moins de chance d'avoir une statut différent (A et D) que prévu selon l'hypothèse de distribution aléatoire et indépendante des marques (ligne rouge pointillée).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-112_e925b891841588727659504a7a0c6e6d'}\n\n```{.r .cell-code}\nplot(markconnect(fir, i = \"A\", j = \"D\", correction = \"iso\"))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nDans ce graphique, les ondulations dans la fonction sont dues à l'erreur d'estimation d'une fonction continue de $r$ à partir d'un nombre limité de paires de points discrètes.\n\nPour simuler le modèle nul dans ce cas-ci, nous utilisons la fonction `rlabel` qui réassigne aléatoirement les marques parmi les points du patron, en maintenant la position des points.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-113_41cb4b77111500454c477fbd4c96dd08'}\n\n```{.r .cell-code}\nplot(envelope(fir, markconnect, i = \"A\", j = \"D\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNotez que puisque la fonction `rlabel` a un seul argument obligatoire correspondant au patron de points original, il n'était pas nécessaire de spécifier au long: `simulate = function(x) rlabel(x)`.\n\nVoici les résultats pour les paires d'arbres du même statut A ou D:\n\n\n::: {.cell fig.dim='[10,5]' hash='index_cache/html/unnamed-chunk-114_2a3fc9a64a69a67d1266f0273c3bb85c'}\n\n```{.r .cell-code}\npar(mfrow = c(1, 2))\nplot(envelope(fir, markconnect, i = \"A\", j = \"A\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(envelope(fir, markconnect, i = \"D\", j = \"D\", correction = \"iso\", \n nsim = 199, nrank = 5, simulate = rlabel))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=960}\n:::\n:::\n\n\nIl semble donc que la mortalité des sapins due à cette épidémie est agrégée spatialement, puisque les arbres situés à proximité l'un de l'autre ont une plus grande probabilité de partager le même statut que prévu par l'hypothèse nulle.\n\n## Références\n\nFortin, M.-J. et Dale, M.R.T. (2005) *Spatial Analysis: A Guide for Ecologists*. Cambridge University Press: Cambridge, UK. \n\nWiegand, T. et Moloney, K.A. (2013) *Handbook of Spatial Point-Pattern Analysis in Ecology*, CRC Press.\n\nLe jeu de données du dernier exemple est tiré des données de la Forêt d'enseignement et de recherche du Lac Duparquet (FERLD), disponibles sur Dryad en suivant [ce lien](https://doi.org/10.5061/dryad.tqjq2bvwz).\n\n\n# Solutions\n\n### Exercice 1\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-115_7bc8effd281fccbd2a1c1e21cd801493'}\n\n```{.r .cell-code}\nplot(envelope(semis_split[[2]], Kest, correction = \"iso\"))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 99 simulations of CSR ...\n1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,\n41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,\n81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99.\n\nDone.\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLes semis de peuplier semblent significativement agrégés selon la valeur du $K$.\n\n### Exercice 2\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-116_53115f6ed07f7e0e4e7d2c8989998e70'}\n\n```{.r .cell-code}\ndens_p <- density(semis_split[[2]], sigma = 5)\nplot(dens_p)\nplot(semis_split[[2]], add = TRUE)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nkhet_p <- envelope(semis_split[[2]], Kinhom, sigma = 5, correction = \"iso\",\n nsim = 199, nrank = 5, simulate = function(x) rpoispp(dens_p))\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGenerating 199 simulations by evaluating function ...\n1, 2, 3, 4.6.8.10.12.14.16.18.20.22.24.26.28.30.32.34.36.38.40\n.42.44.46.48.50.52.54.56.58.60.62.64.66.68.70.72.74.76.78.80\n.82.84.86.88.90.92.94.96.98.100.102.104.106.108.110.112.114.116.118.120\n.122.124.126.128.130.132.134.136.138.140.142.144.146.148.150.152.154.156.158.160\n.162.164.166.168.170.172.174.176.178.180.182.184.186.188.190.192.194.196.198 199.\n\nDone.\n```\n:::\n\n```{.r .cell-code}\nplot(khet_p)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIci, puisque nous estimons la variation de densité à une plus grande échelle, même après avoir tenu compte de cette variation, les semis de peuplier semblent agrégés à petite échelle.\n\n\n# Corrélation spatiale d'une variable {#spatial-correlation-fr}\n\nLa corrélation entre les mesures d'une variable prises à des points rapprochés est une caractéristique dans de nombreux jeux de données. Ce principe est parfois appelé \"première loi de la géographie\" et exprimé par la citation de Waldo Tobler: \"Everything is related to everything else, but near things are more related than distant things.\" (Tout est relié, mais les choses rapprochées le sont davantage que celles éloignées).\n\nEn statistique, nous parlons souvent d'*autocorrélation* pour désigner la corrélation qui existe entre les mesures d'une même variable prises à différents moments (autocorrélation temporelle) ou différents lieux (autocorrélation spatiale).\n\n## Dépendance intrinsèque ou induite\n\nIl existe deux types fondamentaux de dépendance spatiale sur une variable mesurée $y$: une dépendance *intrinsèque* à $y$, ou une dépendance *induite* par des variables externes influençant $y$, qui sont elles-mêmes corrélées dans l'espace.\n\nPar exemple, supposons que l'abondance d'une espèce soit corrélée entre deux sites rapprochés:\n\n- cette dépendance spatiale peut être induite si elle est due à une corrélation spatiale des facteurs d'habitat qui favorisent ou défavorisent l'espèce;\n\n- ou elle peut être intrinsèque si elle est due à la dispersion d'individus entre sites rapprochés.\n\nDans plusieurs cas, les deux types de dépendance affectent une variable donnée.\n\nSi la dépendance est simplement induite et que les variables externes qui en sont la cause sont incluses dans le modèle expliquant $y$, alors les résidus du modèle seront indépendants et nous pouvons utiliser toutes les méthodes déjà vues qui ignorent la dépendance spatiale.\n\nCependant, si la dépendance est intrinsèque ou due à des influences externes non-mesurées, alors il faudra tenir compte de la dépendance spatiale des résidus dans le modèle.\n\n## Différentes façons de modéliser les effets spatiaux\n\nDans cette formation, nous modéliserons directement les corrélations spatiales de nos données. Il est utile de comparer cette approche à d'autres façons d'inclure des aspects spatiaux dans un modèle statistique.\n\nD'abord, nous pourrions inclure des prédicteurs dans le modèle qui représentent la position (ex.: longitude, latitude). De tels prédicteurs peuvent être utiles pour détecter une tendance ou un gradient systématique à grande échelle, que cette tendance soit linéaire ou non (par exemple, avec un modèle additif généralisé).\n\nEn contraste à cette approche, les modèles que nous verrons maintenant servent à modéliser une corrélation spatiale dans les fluctuations aléatoires d'une variable (i.e., dans les résidus après avoir enlevé tout effet systématique).\n\nLes modèles mixtes utilisent des effets aléatoires pour représenter la non-indépendance de données sur la base de leur groupement, c'est-à-dire qu'après avoir tenu compte des effets fixes systématiques, les données d'un même groupe sont plus semblables (leur variation résiduelle est corrélée) par rapport aux données de groupes différents. Ces groupes étaient parfois définis selon des critères spatiaux (observations regroupées en sites).\n\nCependant, dans un contexte d'effet aléatoire de groupe, tous les groupes sont aussi différents les uns des autres, ex.: deux sites à 100 km l'un de l'autre ne sont pas plus ou moins semblables que deux sites distants de 2 km.\n\nLes méthodes que nous verrons ici et dans les prochains parties de la formation nous permettent donc ce modéliser la non-indépendance sur une échelle continue (plus proche = plus corrélé) plutôt que seulement discrète (hiérarchie de groupements).\n\n\n# Modèles géostatistiques {#geostat-models-fr}\n\nLa géostatistique désigne un groupe de techniques tirant leur origine en sciences de la Terre. Elle s'intéresse à des variables distribuées de façon continue dans l'espace, dont on cherche à estimer la distribution en échantillonnant un nombre de points. Un exemple classique de ces techniques provient du domaine minier, où l'on cherchait à créer une carte de la concentration du minerai sur un site à partir d'échantillons pris à différents points du site.\n\nPour ces modèles, nous supposerons que $z(x, y)$ est une variable spatiale stationnaire mesurée selon les coordonnées $x$ et $y$.\n\n## Variogramme\n\nUn aspect central de la géostatistique est l'estimation du variogramme $\\gamma_z$ de la variable $z$. Le variogramme est égal à la moitié de l'écart carré moyen entre les valeurs de $z$ pour deux points $(x_i, y_i)$ et $(x_j, y_j)$ séparés par une distance $h$.\n\n$$\\gamma_z(h) = \\frac{1}{2} \\text{E} \\left[ \\left( z(x_i, y_i) - z(x_j, y_j) \\right)^2 \\right]_{d_{ij} = h}$$\n\nDans cette équation, la fonction $\\text{E}$ avec l'indice $d_{ij}=h$ désigne l'espérance statistique (autrement dit, la moyenne) de l'écart au carré entre les valeurs de $z$ pour les points séparés par une distance $h$.\n\nSi on préfère exprimer l'autocorrélation $\\rho_z(h)$ entre mesures de $z$ séparées par une distance $h$, celle-ci est reliée au variogramme par l'équation:\n\n$$\\gamma_z = \\sigma_z^2(1 - \\rho_z)$$ ,\n\noù $\\sigma_z^2$ est la variance globale de $z$. \n\nNotez que $\\gamma_z = \\sigma_z^2$ si nous sommes à une distance où les mesures de $z$ sont indépendantes, donc $\\rho_z = 0$. Dans ce cas, on voit bien que $\\gamma_z$ s'apparente à une variance, même s'il est parfois appelé \"semivariogramme\" ou \"semivariance\" en raison du facteur 1/2 dans l'équation ci-dessus.\n\n## Modèles théoriques du variogramme\n\nPlusieurs modèles paramétriques ont été proposés pour représenter la corrélation spatiale en fonction de la distance entre points d'échantillonnage. Considérons d'abord une corrélation qui diminue de façon exponentielle: \n\n$$\\rho_z(h) = e^{-h/r}$$\n\nIci, $\\rho_z = 1$ pour $h = 0$ et la corréaltion est multipliée par $1/e \\approx 0.37$ pour chaque augmentation de $r$ de la distance. Dans ce contexte, $r$ se nomme la portée (*range*) de la corrélation.\n\nÀ partir de l'équation ci-dessus, nous pouvons calculer le variogramme correspondant.\n\n$$\\gamma_z(h) = \\sigma_z^2 (1 - e^{-h/r})$$\n\nVoici une représentation graphique de ce variogramme.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-117_94b4bef8ba36e1b515cfee5fff6c1ebb'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEn raison de la fonction exponentielle, la valeur de $\\gamma$ à des grandes distances s'approche de la variance globale $\\sigma_z^2$ sans exactement l'atteindre. Cette asymptote est appelée palier (*sill*) dans le contexte géostatistique et représentée par le symbole $s$.\n\nFinalement, il n'est parfois pas réaliste de supposer une corrélation parfaite lorsque la distance tend vers 0, en raison d'une variation possible de $z$ à très petite échelle. On peut ajouter au modèle un effet de pépite (*nugget*), noté $n$, pour que $\\gamma$ s'approche de $n$ (plutôt que 0) si $h$ tend vers 0. Le terme pépite provient de l'origine minière de ces techniques, où une pépite d'un minerai pourrait être la source d'une variation abrupte de la concentration à petite échelle.\n\nEn ajoutant l'effet de pépite, le reste du variogramme est \"compressé\" pour conserver le même palier, ce qui résulte en l'équation suivante.\n\n$$\\gamma_z(h) = n + (s - n) (1 - e^{-h/r})$$\n\nDans le package *gstat* que nous utiliserons ci-dessous, le terme $(s - n)$ est le palier partiel (*partial sill*, ou `psill`) pour la partie exponentielle.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-118_616ef9e44728a1524a3df51fd61bde38'}\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEn plus du modèle exponentiel, deux autres modèles théoriques courants pour le variogramme sont le modèle gaussien (où la corrélation suit une courbe demi-normale), ainsi que le modèle sphérique (où le variogramme augmente de façon linéaire au départ pour ensuite courber et atteindre le palier à une distance égale à sa portée $r$). Le modèle sphérique permet donc à la corrélation d'être exactement 0 à grande distance, plutôt que de s'approcher graduellement de zéro dans le cas des autres modèles.\n\n Modèle | $\\rho(h)$ | $\\gamma(h)$\n-------|-----------|-------------\nExponentiel | $\\exp\\left(-\\frac{h}{r}\\right)$ | $s \\left(1 - \\exp\\left(-\\frac{h}{r}\\right)\\right)$\nGaussien | $\\exp\\left(-\\frac{h^2}{r^2}\\right)$ | $s \\left(1 - \\exp\\left(-\\frac{h^2}{r^2}\\right)\\right)$\nSphérique $(h < r)$ * | $1 - \\frac{3}{2}\\frac{h}{r} + \\frac{1}{2}\\frac{h^3}{r^3}$ | $s \\left(\\frac{3}{2}\\frac{h}{r} - \\frac{1}{2}\\frac{h^3}{r^3} \\right)$\n\n\\* Pour le modèle sphérique, $\\rho = 0$ et $\\gamma = s$ si $h \\ge r$.\n\n\n\n::: {.cell fig.dim='[9,4]' hash='index_cache/html/unnamed-chunk-119_df4e0a7376691267996d3cce69016995'}\n::: {.cell-output-display}\n{width=864}\n:::\n:::\n\n\n## Variogramme empirique\n\nPour estimer $\\gamma_z(h)$ à partir de données empiriques, nous devons définir des classes de distance, donc grouper différentes distances dans une marge $\\pm \\delta$ autour d'une distance $h$, puis calculer l'écart-carré moyen pour les paires de points dans cette classe de distance.\n\n$$\\hat{\\gamma_z}(h) = \\frac{1}{2 N_{\\text{paires}}} \\sum \\left[ \\left( z(x_i, y_i) - z(x_j, y_j) \\right)^2 \\right]_{d_{ij} = h \\pm \\delta}$$\n\nNous verrons dans la partie suivante comment estimer un variogramme dans R.\n\n## Modèle de régression avec corrélation spatiale\n\nL'équation suivante représente une régression linéaire multiple incluant une corrélation spatiale résiduelle:\n\n$$v = \\beta_0 + \\sum_i \\beta_i u_i + z + \\epsilon$$\n\nIci, $v$ désigne la variable réponse et $u$ les prédicteurs, pour ne pas confondre avec les coordonnées spatiales $x$ et $y$. \n\nEn plus du résidu $\\epsilon$ qui est indépendant entre les observations, le modèle inclut un terme $z$ qui représente la portion spatialement corrélée de la variance résiduelle.\n\nVoici une suggestions d'étapes à suivre pour appliquer ce type de modèle:\n\n1. Ajuster le modèle de régression sans corrélation spatiale.\n\n2. Vérifier la présence de corrélation spatiale à partir du variogramme empirique des résidus.\n\n3. Ajuster un ou plusieurs modèles de régression avec corrélation spatiale et choisir celui qui montre le meilleur ajustement aux données. \n\n# Modèles géostatistiques dans R\n\nLe package *gstat* contient des fonctions liées à la géostatistique. Pour cet exemple, nous utiliserons le jeu de données `oxford` de ce package, qui contient des mesures de propriétés physiques et chimiques pour 126 échantillons du sol d'un site, ainsi que leurs coordonnées `XCOORD` et `YCOORD`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-120_bb070aeb602b5bb93fe5df883fdd6dbe'}\n\n```{.r .cell-code}\nlibrary(gstat)\n\ndata(oxford)\nstr(oxford)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n'data.frame':\t126 obs. of 22 variables:\n $ PROFILE : num 1 2 3 4 5 6 7 8 9 10 ...\n $ XCOORD : num 100 100 100 100 100 100 100 100 100 100 ...\n $ YCOORD : num 2100 2000 1900 1800 1700 1600 1500 1400 1300 1200 ...\n $ ELEV : num 598 597 610 615 610 595 580 590 598 588 ...\n $ PROFCLASS: Factor w/ 3 levels \"Cr\",\"Ct\",\"Ia\": 2 2 2 3 3 2 3 2 3 3 ...\n $ MAPCLASS : Factor w/ 3 levels \"Cr\",\"Ct\",\"Ia\": 2 3 3 3 3 2 2 3 3 3 ...\n $ VAL1 : num 3 3 4 4 3 3 4 4 4 3 ...\n $ CHR1 : num 3 3 3 3 3 2 2 3 3 3 ...\n $ LIME1 : num 4 4 4 4 4 0 2 1 0 4 ...\n $ VAL2 : num 4 4 5 8 8 4 8 4 8 8 ...\n $ CHR2 : num 4 4 4 2 2 4 2 4 2 2 ...\n $ LIME2 : num 4 4 4 5 5 4 5 4 5 5 ...\n $ DEPTHCM : num 61 91 46 20 20 91 30 61 38 25 ...\n $ DEP2LIME : num 20 20 20 20 20 20 20 20 40 20 ...\n $ PCLAY1 : num 15 25 20 20 18 25 25 35 35 12 ...\n $ PCLAY2 : num 10 10 20 10 10 20 10 20 10 10 ...\n $ MG1 : num 63 58 55 60 88 168 99 59 233 87 ...\n $ OM1 : num 5.7 5.6 5.8 6.2 8.4 6.4 7.1 3.8 5 9.2 ...\n $ CEC1 : num 20 22 17 23 27 27 21 14 27 20 ...\n $ PH1 : num 7.7 7.7 7.5 7.6 7.6 7 7.5 7.6 6.6 7.5 ...\n $ PHOS1 : num 13 9.2 10.5 8.8 13 9.3 10 9 15 12.6 ...\n $ POT1 : num 196 157 115 172 238 164 312 184 123 282 ...\n```\n:::\n:::\n\n\nSupposons que nous souhaitons modéliser la concentration de magnésium (`MG1`), représentée en fonction de la position spatiale dans le graphique suivant.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-121_16158cd54c4487cc58ec9fd8dedf3de7'}\n\n```{.r .cell-code}\nlibrary(ggplot2)\nggplot(oxford, aes(x = YCOORD, y = XCOORD, size = MG1)) +\n geom_point() +\n coord_fixed()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNotez que les axes $x$ et $y$ ont été inversés par souci d'espace. La fonction `coord_fixed()` de *ggplot2* assure que l'échelle soit la même sur les deux axes, ce qui est utile pour représenter des données spatiales. \n\nNous voyons tout de suite que ces mesures ont été prises sur une grille de 100 m de côté. Il semble que la concentration de magnésium soit spatialement corrélée, bien qu'il puisse s'agir d'une corrélation induite par une autre variable. Nous savons notamment que la concentration de magnésium est reliée négativement au pH du sol (`PH1`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-122_d467da9d444c7554518f3d138f017425'}\n\n```{.r .cell-code}\nggplot(oxford, aes(x = PH1, y = MG1)) +\n geom_point()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLa fonction `variogram` de *gstat* sert à estimer un variogramme à partir de données empiriques. Voici le résultat obtenu pour la variable `MG1`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-123_d148763eb057ac91a7c45c4a49d51a00'}\n\n```{.r .cell-code}\nvar_mg <- variogram(MG1 ~ 1, locations = ~ XCOORD + YCOORD, data = oxford)\nvar_mg\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n np dist gamma dir.hor dir.ver id\n1 225 100.0000 1601.404 0 0 var1\n2 200 141.4214 1950.805 0 0 var1\n3 548 215.0773 2171.231 0 0 var1\n4 623 303.6283 2422.245 0 0 var1\n5 258 360.5551 2704.366 0 0 var1\n6 144 400.0000 2948.774 0 0 var1\n7 570 427.5569 2994.621 0 0 var1\n8 291 500.0000 3402.058 0 0 var1\n9 366 522.8801 3844.165 0 0 var1\n10 200 577.1759 3603.060 0 0 var1\n11 458 619.8400 3816.595 0 0 var1\n12 90 670.8204 3345.739 0 0 var1\n```\n:::\n:::\n\n\nLa formule `MG1 ~ 1` indique qu'aucun prédicteur linéaire n'est inclus dans ce modèle, tandis que l'argument `locations` indique quelles variables du tableau correspondent aux coordonnées spatiales. \n\nDans le tableau obtenu, `gamma` est la valeur du variogramme pour la classe de distance centrée sur `dist`, tandis que `np` est le nombre de paires de points dans cette classe. Ici, puisque les points sont situés sur une grille, nous obtenons des classes de distance régulières (ex.: 100 m pour les points voisins sur la grille, 141 m pour les voisins en diagonale, etc.).\n\nNous nous limitons ici à l'estimation de variogrammes isotropiques, c'est-à-dire que le variogramme dépend seulement de la distance entre les deux points et non de la direction. Bien que nous n'ayons pas le temps de le voir aujourd'hui, il est possible avec *gstat* d'estimer séparément le variogramme dans différentes directions.\n\nNous pouvons illustrer le variogramme avec `plot`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-124_ca0a474a676de6872283aecd1d7057df'}\n\n```{.r .cell-code}\nplot(var_mg, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nSi nous voulons estimer la corrélation spatiale résiduelle de `MG1` après avoir inclus l'effet de `PH1`, nous pouvons ajouter ce prédicteur à la formule.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-125_11cddc5b7e870cd1cc0cda1a95fac338'}\n\n```{.r .cell-code}\nvar_mg <- variogram(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford)\nplot(var_mg, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEn incluant l'effet du pH, la portée de la corrélation spatiale semble diminuer, alors que le plateau est atteint autour de 300 m. Il semble même que le variogramme diminue au-delà de 400 m. En général, nous supposons que la variance entre deux points ne diminue pas avec la distance, à moins d'avoir un patron spatial périodique.\n\nLa fonction `fit.variogram` accepte comme arguments un variogramme estimé à partir des données, ainsi qu'un modèle théorique décrit dans une fonction `vgm`, puis estime les paramètres de ce modèle en fonction des données. L'ajustement se fait par la méthode des moindres carrés.\n\nPar exemple, `vgm(\"Exp\")` indique d'ajuster un modèle exponentiel. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-126_03d3f3aa8b262e89fa7d8da65b62e30c'}\n\n```{.r .cell-code}\nvfit <- fit.variogram(var_mg, vgm(\"Exp\"))\nvfit\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n model psill range\n1 Nug 0.000 0.00000\n2 Exp 1951.496 95.11235\n```\n:::\n:::\n\n\nIl n'y a aucun effet de pépite, car `psill = 0` pour la partie `Nug` (*nugget*) du modèle. La partie exponentielle a un palier à 1951 et une portée de 95 m.\n\nPour comparer différents modèles, on peut donner un vecteur de noms de modèles à `vgm`. Dans l'exemple suivant, nous incluons les modèles exponentiel, gaussien (\"Gau\") et sphérique (\"Sph\").\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-127_2f3bfeceade9f4f4dfc5b3eba9eda432'}\n\n```{.r .cell-code}\nvfit <- fit.variogram(var_mg, vgm(c(\"Exp\", \"Gau\", \"Sph\")))\nvfit\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n model psill range\n1 Nug 0.000 0.00000\n2 Exp 1951.496 95.11235\n```\n:::\n:::\n\n\nLa fonction nous donne le résultat du modèle le mieux ajusté (plus faible somme des écarts au carré), qui est ici le même modèle exponentiel.\n\nFinalement, nous pouvons superposer le modèle théorique et le variogramme empirique sur un même graphique.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-128_c877e0be691daa5fe18f6d2ba00dfdcd'}\n\n```{.r .cell-code}\nplot(var_mg, vfit, col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n## Régression avec corrélation spatiale\n\nNous avons vu ci-dessus que le package *gstat* permet d'estimer le variogramme des résidus d'un modèle linéaire. Dans notre exemple, la concentration de magnésium était modélisée en fonction du pH, avec des résidus spatialement corrélés.\n\nUn autre outil pour ajuster ce même type de modèle est la fonction `gls` du package *nlme*, qui est inclus avec l'installation de R. \n\nCette fonction applique la méthode des moindres carrés généralisés (*generalized least squares*) pour ajuster des modèles de régression linéaire lorsque les résidus ne sont pas indépendants ou lorsque la variance résiduelle n'est pas la même pour toutes les observations. Comme les estimés des coefficients dépendent de l'estimé des corrélations entre les résidus et que ces derniers dépendent eux-mêmes des coefficients, le modèle est ajusté par un algorithme itératif:\n\n1. On ajuste un modèle de régression linéaire classique (sans corrélation) pour obtenir des résidus.\n\n2. On ajuste le modèle de corrélation spatiale (variogramme) avec ses résidus.\n\n3. On ré-estime les coefficients de la régression en tenant compte maintenant des corrélations.\n\nLes étapes 2 et 3 sont répétées jusqu'à ce que les estimés soient stables à une précision voulue.\n\nVoici l'application de cette méthode au même modèle pour la concentration de magnésium dans le jeu de données `oxford`. Dans l'argument `correlation` de `gls`, nous spécifions un modèle de corrélation exponentielle en fonction de nos coordonnées spatiales et indiquons que nous voulons aussi estimer un effet de pépite.\n\nEn plus de la corrélation exponentielle `corExp`, la fonction `gls` peut aussi estimer un modèle gaussien (`corGaus`) ou sphérique (`corSpher`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-129_c4131310eb8ea32e0ccf4187e678e982'}\n\n```{.r .cell-code}\nlibrary(nlme)\ngls_mg <- gls(MG1 ~ PH1, oxford, \n correlation = corExp(form = ~ XCOORD + YCOORD, nugget = TRUE))\nsummary(gls_mg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized least squares fit by REML\n Model: MG1 ~ PH1 \n Data: oxford \n AIC BIC logLik\n 1278.65 1292.751 -634.325\n\nCorrelation Structure: Exponential spatial correlation\n Formula: ~XCOORD + YCOORD \n Parameter estimate(s):\n range nugget \n478.0322964 0.2944753 \n\nCoefficients:\n Value Std.Error t-value p-value\n(Intercept) 391.1387 50.42343 7.757084 0\nPH1 -41.0836 6.15662 -6.673079 0\n\n Correlation: \n (Intr)\nPH1 -0.891\n\nStandardized residuals:\n Min Q1 Med Q3 Max \n-2.1846957 -0.6684520 -0.3687813 0.4627580 3.1918604 \n\nResidual standard error: 53.8233 \nDegrees of freedom: 126 total; 124 residual\n```\n:::\n:::\n\n\nPour comparer ce résultat au variogramme ajusté ci-dessus, il faut transformer les paramètres donnés par `gls`. La portée (range) a le même sens dans les deux cas et correspond à 478 m pour le résultat de `gls`. La variance globale des résidus est le carré de `Residual standard error`. L'effet de pépite ici (0.294) est exprimé comme fraction de cette variance. Finalement, pour obtenir le palier partiel de la partie exponentielle, il faut soustraire l'effet de pépite de la variance totale. \n\nAprès avoir réalisé ces calculs, nous pouvons donner ces paramètres à la fonction `vgm` de *gstat* pour superposer ce variogramme estimé par `gls` à notre variogramme des résidus du modèle linéaire classique.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-130_1b4118890801a03647e2f78590f222be'}\n\n```{.r .cell-code}\ngls_range <- 478\ngls_var <- 53.823^2\ngls_nugget <- 0.294 * gls_var\ngls_psill <- gls_var - gls_nugget\n\ngls_vgm <- vgm(\"Exp\", psill = gls_psill, range = gls_range, nugget = gls_nugget)\n\nplot(var_mg, gls_vgm, col = \"black\", ylim = c(0, 4000))\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEst-ce que le modèle est moins bien ajusté aux données ici? En fait, ce variogramme empirique représenté par les points avait été obtenu à partir des résidus du modèle linéaire ignorant la corrélation spatiale, donc c'est un estimé biaisé des corrélations spatiales réelles. La méthode est quand même adéquate pour vérifier rapidement s'il y a présence de corrélations spatiales. Toutefois, pour ajuster simultanément les coefficients de la régression et les paramètres de corrélation spatiale, l'approche des moindres carrés généralisés (GLS) est préférable et produira des estimés plus justes.\n\nFinalement, notez que le résultat du modèle `gls` donne aussi l'AIC, que nous pouvons utiliser pour comparer l'ajustement de différents modèles (avec différents prédicteurs ou différentes formes de corrélation spatiale).\n\n## Exercice\n\nLe fichier [bryo_belg.csv](data/bryo_belg.csv) est adapté des données de l'étude: \n\n> Neyens, T., Diggle, P.J., Faes, C., Beenaerts, N., Artois, T. et Giorgi, E. (2019) Mapping species richness using opportunistic samples: a case study on ground-floor bryophyte species richness in the Belgian province of Limburg. *Scientific Reports* 9, 19122. https://doi.org/10.1038/s41598-019-55593-x\n\nCe tableau de données indique la richesse spécifique des bryophytes au sol (*richness*) pour différents points d'échantillonnage de la province belge de Limbourg, avec leur position *(x, y)* en km, en plus de l'information sur la proportion de forêts (*forest*) et de milieux humides (*wetland*) dans une cellule de 1 km$^2$ contenant le point d'échantillonnage.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-131_9e78f0ec8229f51b3dcf95f72b18a23a'}\n\n```{.r .cell-code}\nbryo_belg <- read.csv(\"data/bryo_belg.csv\")\nhead(bryo_belg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n richness forest wetland x y\n1 9 0.2556721 0.5036614 228.9516 220.8869\n2 6 0.6449114 0.1172068 227.6714 219.8613\n3 5 0.5039905 0.6327003 228.8252 220.1073\n4 3 0.5987329 0.2432942 229.2775 218.9035\n5 2 0.7600775 0.1163538 209.2435 215.2414\n6 10 0.6865434 0.0000000 210.4142 216.5579\n```\n:::\n:::\n\n\nPour cet exercice, nous utiliserons la racine carrée de la richesse spécifique comme variable réponse. La transformation racine carrée permet souvent d'homogénéiser la variance des données de comptage afin d'y appliquer une régression linéaire. \n\na) Ajustez un modèle linéaire de la richesse spécifique transformée en fonction de la fraction de forêt et de milieux humides, sans tenir compte des corrélations spatiales. Quel est l'effet des deux prédicteurs selon ce modèle?\n\nb) Calculez le variogramme empirique des résidus du modèle en (a). Semble-t-il y avoir une corrélation spatiale entre les points?\n\n*Note*: L'argument `cutoff` de la fonction `variogram` spécifie la distance maximale à laquelle le variogramme est calculé. Vous pouvez ajuster manuellement cette valeur pour bien voir le palier.\n\nc) Ré-ajustez le modèle linéaire en (a) avec la fonction `gls` du package *nlme*, en essayant différents types de corrélations spatiales (exponentielle, gaussienne, sphérique). Comparez les modèles (incluant celui sans corrélation spatiale) avec l'AIC.\n\nd) Quel est l'effet de la fraction de forêts et de milieux humides selon le modèle en (c)? Expliquez les différences entre les conclusions de ce modèle et du modèle en (a).\n\n\n# Krigeage\n\nTel que mentionné précédemment, une application courante des modèles géostatistiques consiste à prédire la valeur de la variable de réponse à des points non-échantillonnés, une forme d'interpolation spatiale appelée krigeage (*kriging*).\n\nIl existe trois principaux types de krigeage selon les suppositions faites au sujet de la variable réponse:\n\n- Krigeage ordinaire: variable stationnaire avec une moyenne inconnue.\n\n- Krigeage simple: Variable stationnaire avec une moyenne connue.\n\n- Krigeage universel: Variable dont la tendance est donnée par un modèle linéaire ou non linéaire.\n\nPour toutes les méthodes de krigeage, les prédictions à un nouveau point sont une moyenne pondérée des valeurs à des points connus. Ces pondérations sont choisies de manière à ce que le krigeage fournisse la meilleure prédiction linéaire non biaisée de la variable de réponse, si les hypothèses du modèle (en particulier le variogramme) sont correctes. C'est-à-dire que, parmi toutes les prédictions non biaisées possibles, les poids sont choisis de manière à donner l'erreur quadratique moyenne minimale. Le krigeage fournit également une estimation de l'incertitude de chaque prédiction.\n\nBien que nous ne présentions pas ici les équations détaillées du krigeage, les poids dépendent à la fois des corrélations (estimées par le variogramme) entre les points échantillonnés et le nouveau point, ainsi que des corrélations entre les points échantillonnés eux-mêmes. Autrement dit, les points échantillonnés proches du nouveau point ont plus de poids, mais les points échantillonnés isolés ont également plus de poids, car les points échantillonnés proches les uns des autres fournissent une informations redondante.\n\nLe krigeage est une méthode d'interpolation, donc la prédiction à un point échantillonné sera toujours égale à la valeur mesurée (la variable est supposée être mesurée sans erreur, elle varie seulement entre les points). Cependant, en présence d'un effet de pépite, tout petit déplacement par rapport à l'endroit échantillonné présentera une variabilité en fonction de la pépite.\n\nDans l'exemple ci-dessous, nous générons un nouvel ensemble de données composé de coordonnées (x, y) générées de façon aléatoire dans la zone d'étude ainsi que des valeurs de pH générées de façon aléatoire sur la base des données `oxford`. Nous appliquons ensuite la fonction `krige` pour prédire les valeurs de magnésium à ces nouveaux points. Notez que nous spécifions le variogramme dérivé des résultats du `gls` dans l'argument `model` de `krige`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-132_027c26268d41b1f7157bb584e297db99'}\n\n```{.r .cell-code}\nset.seed(14)\nnew_points <- data.frame(\n XCOORD = runif(100, min(oxford$XCOORD), max(oxford$XCOORD)),\n YCOORD = runif(100, min(oxford$YCOORD), max(oxford$YCOORD)),\n PH1 = rnorm(100, mean(oxford$PH1), sd(oxford$PH1))\n)\n\npred <- krige(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford,\n newdata = new_points, model = gls_vgm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[using universal kriging]\n```\n:::\n\n```{.r .cell-code}\nhead(pred)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n XCOORD YCOORD var1.pred var1.var\n1 227.0169 162.1185 47.13065 1269.002\n2 418.9136 465.9013 79.68437 1427.269\n3 578.5943 2032.7477 60.30539 1264.471\n4 376.2734 1530.7193 127.22366 1412.875\n5 591.5336 421.6290 105.88124 1375.485\n6 355.7369 404.3378 127.73055 1250.114\n```\n:::\n:::\n\n\nLe résultat de `krige` comprend les nouvelles coordonnées du point, la prédiction de la variable `var1.pred` ainsi que sa variance estimée `var1.var`. Dans le graphique ci-dessous, nous montrons les prédictions moyennes de MG1 à partir du krigeage (triangles) ainsi que les mesures (cercles).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-133_1b4299bab8f6eba5fe4ea3b112a66235'}\n\n```{.r .cell-code}\npred$MG1 <- pred$var1.pred\n\nggplot(oxford, aes(x = YCOORD, y = XCOORD, color = MG1)) +\n geom_point() +\n geom_point(data = pred, shape = 17, size = 2) +\n coord_fixed()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLa moyenne et la variance estimées par krigeage peuvent être utilisées pour simuler les valeurs possibles de la variable à chaque nouveau point, conditionnellement aux valeurs échantillonnées. Dans l'exemple ci-dessous, nous avons effectué 4 simulations conditionnelles en ajoutant l'argument `nsim = 4` à la même instruction `krige`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-134_9a008c1eb0ae0b7b22fbfc9aa9ca64ba'}\n\n```{.r .cell-code}\nsim_mg <- krige(MG1 ~ PH1, locations = ~ XCOORD + YCOORD, data = oxford,\n newdata = new_points, model = gls_vgm, nsim = 4)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\ndrawing 4 GLS realisations of beta...\n[using conditional Gaussian simulation]\n```\n:::\n\n```{.r .cell-code}\nhead(sim_mg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n XCOORD YCOORD sim1 sim2 sim3 sim4\n1 227.0169 162.1185 9.638739 34.53159 46.08685 77.86376\n2 418.9136 465.9013 60.029144 20.17179 76.46333 59.57924\n3 578.5943 2032.7477 100.791412 77.47887 73.50058 59.40279\n4 376.2734 1530.7193 112.615730 150.96664 78.76125 146.83928\n5 591.5336 421.6290 70.925240 72.85522 153.90610 126.63758\n6 355.7369 404.3378 161.608032 118.93640 134.45695 142.20074\n```\n:::\n:::\n\n::: {.cell fig.dim='[10,5]' hash='index_cache/html/unnamed-chunk-135_3de9cc48384c950ead05df0c82810126'}\n\n```{.r .cell-code}\nlibrary(tidyr)\nsim_mg <- pivot_longer(sim_mg, cols = c(sim1, sim2, sim3, sim4), \n names_to = \"sim\", values_to = \"MG1\")\nggplot(sim_mg, aes(x = YCOORD, y = XCOORD, color = MG1)) +\n geom_point() +\n coord_fixed() +\n facet_wrap(~ sim)\n```\n\n::: {.cell-output-display}\n{width=960}\n:::\n:::\n\n\n\n# Solutions\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-136_e5d36a60c009aa3f50973208ae8f2f5b'}\n\n```{.r .cell-code}\nbryo_lm <- lm(sqrt(richness) ~ forest + wetland, data = bryo_belg)\nsummary(bryo_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall:\nlm(formula = sqrt(richness) ~ forest + wetland, data = bryo_belg)\n\nResiduals:\n Min 1Q Median 3Q Max \n-1.8847 -0.4622 0.0545 0.4974 2.3116 \n\nCoefficients:\n Estimate Std. Error t value Pr(>|t|) \n(Intercept) 2.34159 0.08369 27.981 < 2e-16 ***\nforest 1.11883 0.13925 8.034 9.74e-15 ***\nwetland -0.59264 0.17216 -3.442 0.000635 ***\n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nResidual standard error: 0.7095 on 417 degrees of freedom\nMultiple R-squared: 0.2231,\tAdjusted R-squared: 0.2193 \nF-statistic: 59.86 on 2 and 417 DF, p-value: < 2.2e-16\n```\n:::\n:::\n\n\nLa proportion de forêts a un effet positif significatif et la proportion de milieux humides a un effet négatif significatif sur la richesse des bryophytes.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-137_ec3dcc9a8a06613df18c98b96808666b'}\n\n```{.r .cell-code}\nplot(variogram(sqrt(richness) ~ forest + wetland, locations = ~ x + y,\n data = bryo_belg, cutoff = 50), col = \"black\")\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLe variogramme augmente au moins jusqu'à une distance de 40 km, il semble donc y avoir des corrélations spatiales dans les résidus du modèle.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-138_7c7f1feca29413974ebbf1ffe2ed08c2'}\n\n```{.r .cell-code}\nbryo_exp <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corExp(form = ~ x + y, nugget = TRUE))\nbryo_gaus <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corGaus(form = ~ x + y, nugget = TRUE))\nbryo_spher <- gls(sqrt(richness) ~ forest + wetland, data = bryo_belg,\n correlation = corSpher(form = ~ x + y, nugget = TRUE))\n```\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-139_8c08d48b4eaefbe6cc8947569ca14603'}\n\n```{.r .cell-code}\nAIC(bryo_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 908.6358\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_exp)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 867.822\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_gaus)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 870.9592\n```\n:::\n\n```{.r .cell-code}\nAIC(bryo_spher)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 866.9117\n```\n:::\n:::\n\n\nLe modèle sphérique a l'AIC le plus faible.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-140_6c6c64ec797a7b31d531a376b94c8dbc'}\n\n```{.r .cell-code}\nsummary(bryo_spher)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized least squares fit by REML\n Model: sqrt(richness) ~ forest + wetland \n Data: bryo_belg \n AIC BIC logLik\n 866.9117 891.1102 -427.4558\n\nCorrelation Structure: Spherical spatial correlation\n Formula: ~x + y \n Parameter estimate(s):\n range nugget \n43.1727664 0.6063187 \n\nCoefficients:\n Value Std.Error t-value p-value\n(Intercept) 2.0368769 0.2481636 8.207800 0.000\nforest 0.6989844 0.1481690 4.717481 0.000\nwetland -0.2441130 0.1809118 -1.349348 0.178\n\n Correlation: \n (Intr) forest\nforest -0.251 \nwetland -0.235 0.241\n\nStandardized residuals:\n Min Q1 Med Q3 Max \n-1.75204183 -0.06568688 0.61415597 1.15240370 3.23322743 \n\nResidual standard error: 0.7998264 \nDegrees of freedom: 420 total; 417 residual\n```\n:::\n:::\n\n\nLa magnitude des deux effets est moins importante et l'effet des milieux humides n'est plus significatif. Comme c'est le cas pour d'autres types de résidus non indépendants, la \"taille effective\" de l'échantillon est ici inférieure au nombre de points, car des points proches les uns des autres fournissent une information redondante. Par conséquent, la relation entre les prédicteurs et la réponse est moins claire que celle donnée par le modèle supposant que tous ces points étaient indépendants.\n\nNotez que les résultats pour les trois modèles `gls` sont assez similaires, donc le choix d'inclure des corrélations spatiales était plus important que la forme exacte supposée pour le variogramme.\n\n\n# Données aréales {#areal-data-fr}\n\nLes données aréales sont des variables mesurées pour des régions de l'espace; ces régions sont définies par des polygones. Ce type de données est plus courant en sciences sociales, en géographie humaine et en épidémiologie, où les données sont souvent disponibles à l'échelle de divisions administratives du territoire. \n\nCe type de données apparaît aussi fréquemment dans la gestion des ressources naturelles. Par exemple, la carte suivante montre les unités d'aménagement forestier du Ministère de la Forêts, de la Faune et des Parcs du Québec.\n\n\n\nSupposons qu'une certaine variable soit disponible au niveau de ces divisions du territoire. Comment pouvons-nous modéliser la corrélation spatiale entre les unités qui sont spatialement rapprochées?\n\nUne option serait d'appliquer les méthodes géostatistiques vues précédemment, en calculant par exemple la distance entre les centres des polygones.\n\nUne autre option, qui est davantage privilégiée pour les données aréales, consiste à définir un réseau où chaque région est connectée aux régions voisines par un lien. On suppose ensuite que les variables sont directement corrélées entre régions voisines seulement. (Notons toutefois que les corrélations directes entre voisins immédiats génèrent aussi des corrélations indirectes pour une chaîne de voisins.)\n\nDans ce type de modèle, la corrélation n'est pas nécessairement la même d'un lien à un autre. Dans ce cas, chaque lien du réseau peut être associé à un *poids* représentant son importance pour la corrélation spatiale. Nous représentons ces poids par une matrice $W$ où $w_{ij}$ est le poids du lien entre les régions $i$ et $j$. Une région n'a pas de lien avec elle-même, donc $w_{ii} = 0$.\n\nUn choix simple pour $W$ consiste à assigner un poids égal à 1 si les régions sont voisines, sinon 0 (poids binaires).\n\nOutre les divisions du territoire en polygones, un autre exemple de données aréales consiste en une grille où la variable est compilée pour chaque cellule de la grille. Dans ce cas, une cellule a généralement 4 ou 8 cellules voisines, selon que les diagonales soient incluses ou non.\n\n# Indice de Moran {#moran-i-fr}\n\nAvant de discuter des modèles d'autocorrélation spatiale, nous présentons l'indice $I$ de Moran, qui permet de tester si une corrélation significative est présente entre régions voisines. \n\nL'indice de Moran est un coefficient d'autocorrélation spatiale des $z$, pondéré par les poids $w_{ij}$. Il prend donc des valeurs entre -1 et 1.\n\n$$I = \\frac{N}{\\sum_i \\sum_j w_{ij}} \\frac{\\sum_i \\sum_j w_{ij} (z_i - \\bar{z}) (z_j - \\bar{z})}{\\sum_i (z_i - \\bar{z})^2}$$\n\nDans cette équation, nous reconnaissons l'expression d'une corrélation, soit le produit des écarts à la moyenne de deux variables $z_i$ et $z_j$, divisé par le produit de leurs écarts-types (qui est le même, donc on obtient la variance). La contribution de chaque paire $(i, j)$ est multipliée par son poids $w_{ij}$ et le terme à gauche (le nombre de régions $N$ divisé par la somme des poids) assure que le résultat soit borné entre -1 et 1.\n\nPuisque la distribution de $I$ est connue en l'absence d'autocorrélation spatiale, cette statistique permet de tester l'hypothèse nulle selon laquelle il n'y a pas de corrélation spatiale entre régions voisines.\n\nBien que nous ne verrons pas d'exemple dans ce cours-ci, l'indice de Moran peut aussi être appliqué aux données ponctuelles. Dans ce cas, on divise les paires de points en classes de distance et on calcule $I$ pour chaque classe de distance; le poids $w_{ij} = 1$ si la distance entre $i$ et $j$ se trouve dans la classe de distance voulue, 0 autrement.\n\n# Modèles d'autorégression spatiale {#spatial-autoreg-fr}\n\nRappelons-nous la formule pour une régression linéaire avec dépendance spatiale:\n\n$$v = \\beta_0 + \\sum_i \\beta_i u_i + z + \\epsilon$$\n\noù $z$ est la portion de la variance résiduelle qui est spatialement corrélée.\n\nIl existe deux principaux types de modèles autorégressifs pour représenter la dépendance spatiale de $z$: l'autorégression conditionnelle (CAR) et l'autorégression simultanée (SAR).\n\n## Autorégression conditionnelle (CAR)\n\nDans le modèle d'autorégression conditionnelle, la valeur de $z_i$ pour la région $i$ suit une distribution normale: sa moyenne dépend de la valeur $z_j$ des régions voisines, multipliée par le poids $w_{ij}$ et un coefficient de corrélation $\\rho$; son écart-type $\\sigma_{z_i}$ peut varier d'une région à l'autre.\n\n$$z_i \\sim \\text{N}\\left(\\sum_j \\rho w_{ij} z_j,\\sigma_{z_i} \\right)$$\n\nDans ce modèle, si $w_{ij}$ est une matrice binaire (0 pour les non-voisins, 1 pour les voisins), alors $\\rho$ est le coefficient de corrélation partielle entre régions voisines. Cela est semblable à un modèle autorégressif d'ordre 1 dans le contexte de séries temporelles, où le coefficient d'autorégression indique la corrélation partielle.\n\n## Autorégression simultanée (SAR)\n\nDans le modèle d'autorégression simultanée, la valeur de $z_i$ est donnée directement par la somme de contributions des valeurs voisines $z_j$, multipliées par $\\rho w_{ij}$, avec un résidu indépendant $\\nu_i$ d'écart-type $\\sigma_z$.\n\n$$z_i = \\sum_j \\rho w_{ij} z_j + \\nu_i$$\n\nÀ première vue, cela ressemble à un modèle autorégressif temporel. Il existe cependant une différence conceptuelle importante. Pour les modèles temporels, l'influence causale est dirigée dans une seule direction: $v(t-2)$ affecte $v(t-1)$ qui affecte ensuite $v(t)$. Pour un modèle spatial, chaque $z_j$ qui affecte $z_i$ dépend à son tour de $z_i$. Ainsi, pour déterminer la distribution conjointe des $z$, il faut résoudre simultanément (d'où le nom du modèle) un système d'équations. \n\nPour cette raison, même si ce modèle ressemble à la formule du modèle conditionnel (CAR), les solutions des deux modèles diffèrent et dans le cas du SAR, le coefficient $\\rho$ n'est pas directement égal à la corrélation partielle due à chaque région voisine.\n\nPour plus de détails sur les aspects mathématiques de ces modèles, vous pouvez consulter l'article de Ver Hoef et al. (2018) suggéré en référence. \n\nPour l'instant, nous considérerons les SAR et les CAR comme deux types de modèles possibles pour représenter une corrélation spatiale sur un réseau. Nous pouvons toujours ajuster plusieurs modèles et les comparer avec l'AIC pour choisir la meilleure forme de la corrélation ou la meilleure matrice de poids.\n\nLes modèles CAR et SAR partagent un avantage sur les modèles géostatistiques au niveau de l'efficacité. Dans un modèle géostatistique, les corrélations spatiales sont définies entre chaque paire de points, même si elles deviennent négligeables lorsque la distance augmente. Pour un modèle CAR ou SAR, seules les régions voisines contribuent et la plupart des poids sont égaux à 0, ce qui rend ces modèles plus rapides à ajuster qu'un modèle géostatistique lorsque les données sont massives.\n\n# Analyse des données aréales dans R {#analysis-areal-fr}\n\nPour illustrer l'analyse de données aréales dans R, nous chargeons les packages *sf* (pour lire des données géospatiales), *spdep* (pour définir des réseaux spatiaux et calculer l'indice de Moran) et *spatialreg* (pour les modèles SAR et CAR).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-141_8c941e8bafdfac85f5eb2821d17ab03b'}\n\n```{.r .cell-code}\nlibrary(sf)\nlibrary(spdep)\nlibrary(spatialreg)\n```\n:::\n\n\nNous utiliserons comme exemple un jeu de données qui présente une partie des résultats de l'élection provinciale de 2018 au Québec, avec des caractéristiques de la population de chaque circonscription. Ces données sont inclues dans un fichier de type *shapefile* (.shp), que nous pouvons lire avec la fonction `read_sf` du package *sf*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-142_f24372ba1482109fbffa68f052fd7dfb'}\n\n```{.r .cell-code}\nelect2018 <- read_sf(\"data/elect2018.shp\")\nhead(elect2018)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nSimple feature collection with 6 features and 9 fields\nGeometry type: MULTIPOLYGON\nDimension: XY\nBounding box: xmin: 97879.03 ymin: 174515.3 xmax: 694261.1 ymax: 599757.1\nProjected CRS: LambertAQ\n# A tibble: 6 × 10\n circ age_moy pct_frn pct_prp rev_med propCAQ propPQ propPLQ propQS\n \n1 Abitibi-Est 40.8 0.963 0.644 34518 42.7 19.5 18.8 15.7\n2 Abitibi-Ouest 42.2 0.987 0.735 33234 34.1 33.3 11.3 16.6\n3 Acadie 40.3 0.573 0.403 25391 16.5 9 53.8 13.8\n4 Anjou-Louis-Riel 43.5 0.821 0.416 31275 28.9 14.7 39.1 14.5\n5 Argenteuil 43.3 0.858 0.766 31097 38.9 21.1 17.4 12.2\n6 Arthabaska 43.4 0.989 0.679 30082 61.8 9.4 11.4 12.6\n# … with 1 more variable: geometry \n```\n:::\n:::\n\n\n*Note*: Le jeu de données est en fait composé de 4 fichiers avec les extensions .dbf, .prj, .shp et .shx, mais il suffit d'inscrire le nom du fichier .shp dans `read_sf`.\n\nLes colonnes du jeu de données sont dans l'ordre:\n\n- le nom de la circonscription électorale;\n- quatre caractéristiques de la population (âge moyen, fraction de la population qui parle principalement français à la maison, fraction des ménages qui sont propriétaires de leur logement, revenu médian);\n- quatre colonnes montrant la fraction des votes obtenues par les principaux partis (CAQ, PQ, PLQ, QS);\n- une colonne `geometry` qui contient l'objet géométrique (multipolygone) correspondant à la circonscription.\n\nPour illustrer une des variables sur une carte, nous appelons la fonction `plot` avec le nom de la colonne entre crochets et guillemets. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-143_118d70deac183e230a7c64b3208cd1a7'}\n\n```{.r .cell-code}\nplot(elect2018[\"rev_med\"])\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nDans cet exemple, nous voulons modéliser la fraction des votes obtenue par la CAQ en fonction des caractéristiques de la population dans chaque circonscription et en tenant compte des corrélations spatiales entre circonscriptions voisines.\n\n## Définition du réseau de voisinage\n\nLa fonction `poly2nb` du package *spdep* définit un réseau de voisinage à partir de polygones. Le résultat `vois` est une liste de 125 éléments où chaque élément contient les indices des polygones voisins (limitrophes) d'un polygone donné.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-144_e6285b834db05d427f22b7669e5dbee2'}\n\n```{.r .cell-code}\nvois <- poly2nb(elect2018)\nvois[[1]]\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 2 37 63 88 101 117\n```\n:::\n:::\n\n\nAinsi, la première circonscription (Abitibi-Est) a 6 circonscriptions voisines, dont on peut trouver les noms ainsi:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-145_2fc04a4a3fbb352f0ae58db913423a12'}\n\n```{.r .cell-code}\nelect2018$circ[vois[[1]]]\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] \"Abitibi-Ouest\" \"Gatineau\" \n[3] \"Laviolette-Saint-Maurice\" \"Pontiac\" \n[5] \"Rouyn-Noranda-Témiscamingue\" \"Ungava\" \n```\n:::\n:::\n\n\nNous pouvons illustrer ce réseau en faisant l'extraction des coordonnées du centre de chaque circonscription, en créant une carte muette avec `plot(elect2018[\"geometry\"])`, puis en ajoutant le réseau comme couche additionnelle avec `plot(vois, add = TRUE, coords = coords)`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-146_56fcb69c11c78b9880373ab1b16efb12'}\n\n```{.r .cell-code}\ncoords <- st_centroid(elect2018) %>%\n st_coordinates()\nplot(elect2018[\"geometry\"])\nplot(vois, add = TRUE, col = \"red\", coords = coords)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nOn peut faire un \"zoom\" sur le sud du Québec en choisissant les limites `xlim` et `ylim` appropriées.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-147_b0a05b92ad9c5bc6e15ecbc77d7fd239'}\n\n```{.r .cell-code}\nplot(elect2018[\"geometry\"], \n xlim = c(400000, 800000), ylim = c(100000, 500000))\nplot(vois, add = TRUE, col = \"red\", coords = coords)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nIl nous reste à ajouter des poids à chaque lien du réseau avec la fonction `nb2listw`. Le style de poids \"B\" correspond aux poids binaires, soit 1 pour la présence de lien et 0 pour l'absence de lien entre deux circonscriptions.\n\nUne fois ces poids définis, nous pouvons vérifier avec le test de Moran s'il y a une autocorrélation significative des votes obtenus par la CAQ entre circonscriptions voisines.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-148_59eb24f4ba758ea6399bc94ea1c419ba'}\n\n```{.r .cell-code}\npoids <- nb2listw(vois, style = \"B\")\n\nmoran.test(elect2018$propCAQ, poids)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\n\tMoran I test under randomisation\n\ndata: elect2018$propCAQ \nweights: poids \n\nMoran I statistic standard deviate = 13.148, p-value < 2.2e-16\nalternative hypothesis: greater\nsample estimates:\nMoran I statistic Expectation Variance \n 0.680607768 -0.008064516 0.002743472 \n```\n:::\n:::\n\n\nLa valeur de $I = 0.68$ est très significative à en juger par la valeur $p$ du test.\n\nVérifions si la corrélation spatiale persiste après avoir tenu compte des quatre caractéristiques de la population, donc en inspectant les résidus d'un modèle linéaire incluant ces quatre prédicteurs.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-149_7d8643515ed0e408c5e5163ec8e3740c'}\n\n```{.r .cell-code}\nelect_lm <- lm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, data = elect2018)\nsummary(elect_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall:\nlm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018)\n\nResiduals:\n Min 1Q Median 3Q Max \n-30.9890 -4.4878 0.0562 6.2653 25.8146 \n\nCoefficients:\n Estimate Std. Error t value Pr(>|t|) \n(Intercept) 1.354e+01 1.836e+01 0.737 0.463 \nage_moy -9.170e-01 3.855e-01 -2.378 0.019 * \npct_frn 4.588e+01 5.202e+00 8.820 1.09e-14 ***\npct_prp 3.582e+01 6.527e+00 5.488 2.31e-07 ***\nrev_med -2.624e-05 2.465e-04 -0.106 0.915 \n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nResidual standard error: 9.409 on 120 degrees of freedom\nMultiple R-squared: 0.6096,\tAdjusted R-squared: 0.5965 \nF-statistic: 46.84 on 4 and 120 DF, p-value: < 2.2e-16\n```\n:::\n\n```{.r .cell-code}\nmoran.test(residuals(elect_lm), poids)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\n\tMoran I test under randomisation\n\ndata: residuals(elect_lm) \nweights: poids \n\nMoran I statistic standard deviate = 6.7047, p-value = 1.009e-11\nalternative hypothesis: greater\nsample estimates:\nMoran I statistic Expectation Variance \n 0.340083290 -0.008064516 0.002696300 \n```\n:::\n:::\n\n\nL'indice de Moran a diminué mais demeure significatif, donc une partie de la corrélation précédente était induite par ces prédicteurs, mais il reste une corrélation spatiale due à d'autres facteurs. \n\n## Modèles d'autorégression spatiale\n\nFinalement, nous ajustons des modèles SAR et CAR à ces données avec la fonction `spautolm` (*spatial autoregressive linear model*) de *spatialreg*. Voici le code pour un modèle SAR incluant l'effet des même quatre prédicteurs. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-150_34bc73005b64f5a3ee73549b2cbc9b5e'}\n\n```{.r .cell-code}\nelect_sar <- spautolm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids)\nsummary(elect_sar)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids)\n\nResiduals:\n Min 1Q Median 3Q Max \n-23.08342 -4.10573 0.24274 4.29941 23.08245 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 15.09421119 16.52357745 0.9135 0.36098\nage_moy -0.70481703 0.32204139 -2.1886 0.02863\npct_frn 39.09375061 5.43653962 7.1909 6.435e-13\npct_prp 14.32329345 6.96492611 2.0565 0.03974\nrev_med 0.00016730 0.00023209 0.7208 0.47101\n\nLambda: 0.12887 LR test value: 42.274 p-value: 7.9339e-11 \nNumerical Hessian standard error of lambda: 0.012069 \n\nLog likelihood: -433.8862 \nML residual variance (sigma squared): 53.028, (sigma: 7.282)\nNumber of observations: 125 \nNumber of parameters estimated: 7 \nAIC: 881.77\n```\n:::\n:::\n\n\nLa valeur donnée par `Lambda` dans le sommaire correspond au coefficient $\\rho$ dans notre description du modèle. Le test du rapport de vraisemblance (`LR test`) confirme que cette corrélation spatiale résiduelle (après avoir tenu compte de l'effet des prédicteurs) est significative.\n\nLes effets estimés pour les prédicteurs sont semblables à ceux du modèle linéaire sans corrélation spatiale. Les effets de l'âge moyen, de la fraction de francophones et la fraction de propriétaires demeurent significatifs, bien que leur magnitude ait un peu diminué.\n\nPour évaluer un modèle CAR plutôt que SAR, nous devons spécifier `family = \"CAR\"`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-151_7ba6f7fcd4cc33a20eb6848945d3cce4'}\n\n```{.r .cell-code}\nelect_car <- spautolm(propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids, family = \"CAR\")\nsummary(elect_car)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = propCAQ ~ age_moy + pct_frn + pct_prp + rev_med, \n data = elect2018, listw = poids, family = \"CAR\")\n\nResiduals:\n Min 1Q Median 3Q Max \n-21.73315 -4.24623 -0.24369 3.44228 23.43749 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 16.57164696 16.84155327 0.9840 0.325128\nage_moy -0.79072151 0.32972225 -2.3981 0.016478\npct_frn 38.99116707 5.43667482 7.1719 7.399e-13\npct_prp 17.98557474 6.80333470 2.6436 0.008202\nrev_med 0.00012639 0.00023106 0.5470 0.584364\n\nLambda: 0.15517 LR test value: 40.532 p-value: 1.9344e-10 \nNumerical Hessian standard error of lambda: 0.0026868 \n\nLog likelihood: -434.7573 \nML residual variance (sigma squared): 53.9, (sigma: 7.3416)\nNumber of observations: 125 \nNumber of parameters estimated: 7 \nAIC: 883.51\n```\n:::\n:::\n\n\nPour un modèle CAR avec des poids binaires, la valeur de `Lambda` (que nous avions appelé $\\rho$) donne directement le coefficient de corrélation partielle entre circonscriptions voisines. Notez que l'AIC ici est légèrement supérieur au modèle SAR, donc ce dernier donnait un meilleur ajustement.\n\n## Exercice\n\nLe jeu de données `rls_covid`, en format *shapefile*, contient des données sur les cas de COVID-19 détectés, le nombre de cas par 1000 personnes (`taux_1k`) et la densité de population (`dens_pop`) dans chacun des réseaux locaux de service de santé (RLS) du Québec. (Source: Données téléchargées de l'Institut national de santé publique du Québec en date du 17 janvier 2021.)\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-152_117a49f704cd9751636b707b593f6428'}\n\n```{.r .cell-code}\nrls_covid <- read_sf(\"data/rls_covid.shp\")\nhead(rls_covid)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nSimple feature collection with 6 features and 5 fields\nGeometry type: MULTIPOLYGON\nDimension: XY\nBounding box: xmin: 785111.2 ymin: 341057.8 xmax: 979941.5 ymax: 541112.7\nProjected CRS: Conique_conforme_de_Lambert_du_MTQ_utilis_e_pour_Adresse_Qu_be\n# A tibble: 6 × 6\n RLS_code RLS_nom cas taux_1k dens_…¹ geometry\n \n1 0111 RLS de Kamouraska 152 7.34 6.76 (((827028.3 412772.4, 82…\n2 0112 RLS de Rivière-du-Lo… 256 7.34 19.6 (((855905 452116.9, 8557…\n3 0113 RLS de Témiscouata 81 4.26 4.69 (((911829.4 441311.2, 91…\n4 0114 RLS des Basques 28 3.3 5.35 (((879249.6 471975.6, 87…\n5 0115 RLS de Rimouski 576 9.96 15.5 (((917748.1 503148.7, 91…\n6 0116 RLS de La Mitis 76 4.24 5.53 (((951316 523499.3, 9525…\n# … with abbreviated variable name ¹dens_pop\n```\n:::\n:::\n\n\nAjustez un modèle linéaire du nombre de cas par 1000 en fonction de la densité de population (il est suggéré d'appliquer une transformation logarithmique à cette dernière). Vérifiez si les résidus du modèle sont corrélés entre RLS limitrophes avec un test de Moran, puis modélisez les mêmes données avec un modèle autorégressif conditionnel.\n\n## Référence\n\nVer Hoef, J.M., Peterson, E.E., Hooten, M.B., Hanks, E.M. et Fortin, M.-J. (2018) Spatial autoregressive models for statistical inference from ecological data. *Ecological Monographs* 88: 36-59.\n\n\n# GLMM avec processus spatial gaussien {#glmm-spatial-gaussian-fr}\n\nDans les parties précédentes, nous avons vu comment tenir compte de la dépendance spatiale dans les modèles de régression linéaire avec des modèles géostatistiques (également appelés processus gaussiens) ou des modèles d'autocorrélation spatiale (CAR/SAR). Dans cette dernière partie, nous verrons comment combiner ces caractéristiques avec des modèles de régression plus complexes, en particulier les modèles linéaires généralisés à effets mixtes (GLMM).\n\n## Données\n\nLe jeu de données `gambia` inclus avec le package *geoR* présente les résultats d'une étude sur la prévalence du paludisme chez les enfants de 65 villages en Gambie. Nous utiliserons une version légèrement transformée des données contenues dans le fichier [gambia.csv](data/gambia.csv).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-153_94be0528ee530f4b0d9120a3e4a412d9'}\n\n```{.r .cell-code}\nlibrary(geoR)\n\ngambia <- read.csv(\"data/gambia.csv\")\nhead(gambia)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n id_village x y pos age netuse treated green phc\n1 1 349.6313 1458.055 1 1783 0 0 40.85 1\n2 1 349.6313 1458.055 0 404 1 0 40.85 1\n3 1 349.6313 1458.055 0 452 1 0 40.85 1\n4 1 349.6313 1458.055 1 566 1 0 40.85 1\n5 1 349.6313 1458.055 0 598 1 0 40.85 1\n6 1 349.6313 1458.055 1 590 1 0 40.85 1\n```\n:::\n:::\n\n\nVoici les champs de ce jeu de données:\n\n- *id_village*: Identifiant du village.\n- *x* and *y*: Coordonnées spatiales du village (en km, basé sur les coordonnées UTM).\n- *pos*: Réponse binaire, si l'enfant a eu un test positif du paludisme.\n- *age*: Âge de l'enfant en jours.\n- *netuse*: Si l'enfant dort sous un moustiquaire ou non.\n- *treated*: Si le moustiquaire est traité ou non.\n- *green*: Mesure de la végétation basée sur les données de télédétection (disponible à l'échelle du village).\n- *phc*: Présence ou absence d'un centre de santé publique pour le village.\n\nNous pouvons compter le nombre de cas positifs et le nombre total d'enfants testés par village pour cartographier la fraction des cas positifs (ou prévalence, *prev*).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-154_f2e9fe8cc46d29ee6147236d160f6a1a'}\n\n```{.r .cell-code}\n# Jeu de données à l'échelle du village\ngambia_agg <- group_by(gambia, id_village, x, y, green, phc) %>%\n summarize(pos = sum(pos), total = n()) %>%\n mutate(prev = pos / total) %>%\n ungroup()\n```\n\n::: {.cell-output .cell-output-stderr}\n```\n`summarise()` has grouped output by 'id_village', 'x', 'y', 'green'. You can\noverride using the `.groups` argument.\n```\n:::\n\n```{.r .cell-code}\nhead(gambia_agg)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n# A tibble: 6 × 8\n id_village x y green phc pos total prev\n \n1 1 350. 1458. 40.8 1 17 33 0.515\n2 2 359. 1460. 40.8 1 19 63 0.302\n3 3 360. 1460. 40.1 0 7 17 0.412\n4 4 364. 1497. 40.8 0 8 24 0.333\n5 5 366. 1460. 40.8 0 10 26 0.385\n6 6 367. 1463. 40.8 0 7 18 0.389\n```\n:::\n:::\n\n::: {.cell hash='index_cache/html/unnamed-chunk-155_b02463961b3424baa4da82ed27a5ca7e'}\n\n```{.r .cell-code}\nggplot(gambia_agg, aes(x = x, y = y)) +\n geom_point(aes(color = prev)) +\n geom_path(data = gambia.borders, aes(x = x / 1000, y = y / 1000)) +\n coord_fixed() +\n theme_minimal() +\n scale_color_viridis_c()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNous utilisons le jeu de données `gambia.borders` du package *geoR* pour tracer les frontières des pays avec `geom_path`. Comme ces frontières sont en mètres, nous les divisons par 1000 pour obtenir la même échelle que nos points. Nous utilisons également `coord_fixed` pour assurer un rapport d'aspect de 1:1 entre les axes et utilisons la palette de couleur `viridis`, qui permet de visualiser plus facilement une variable continue par rapport à la palette par défaut dans *ggplot2*.\n\nSur la base de cette carte, il semble y avoir une corrélation spatiale dans la prévalence du paludisme, le groupe de villages de l'est montrant des valeurs de prévalence plus élevées (jaune-vert) et le groupe du milieu montrant des valeurs de prévalence plus faibles (violet).\n\n## GLMM non spatial\n\nPour ce premier exemple, nous allons ignorer l'aspect spatial des données et modéliser la présence du paludisme (*pos*) en fonction de l'utilisation d'une moustiquaire (*netuse*) et de la présence d'un centre de santé publique (*phc*). Comme nous avons une réponse binaire, nous devons utiliser un modèle de régression logistique (un GLM). Comme nous avons des prédicteurs au niveau individuel et au niveau du village et que nous nous attendons à ce que les enfants d'un même village aient une probabilité plus similaire d'avoir le paludisme même après avoir pris en compte ces prédicteurs, nous devons ajouter un effet aléatoire du village. Le résultat est un GLMM que nous ajustons en utilisant la fonction `glmer` du package *lme4*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-156_7c91bce3c832a01ae8f8b3f26d71b9fa'}\n\n```{.r .cell-code}\nlibrary(lme4)\n\nmod_glmm <- glmer(pos ~ netuse + phc + (1 | id_village), \n data = gambia, family = binomial)\nsummary(mod_glmm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nGeneralized linear mixed model fit by maximum likelihood (Laplace\n Approximation) [glmerMod]\n Family: binomial ( logit )\nFormula: pos ~ netuse + phc + (1 | id_village)\n Data: gambia\n\n AIC BIC logLik deviance df.resid \n 2428.0 2450.5 -1210.0 2420.0 2031 \n\nScaled residuals: \n Min 1Q Median 3Q Max \n-2.1286 -0.7120 -0.4142 0.8474 3.3434 \n\nRandom effects:\n Groups Name Variance Std.Dev.\n id_village (Intercept) 0.8149 0.9027 \nNumber of obs: 2035, groups: id_village, 65\n\nFixed effects:\n Estimate Std. Error z value Pr(>|z|) \n(Intercept) 0.1491 0.2297 0.649 0.5164 \nnetuse -0.6044 0.1442 -4.190 2.79e-05 ***\nphc -0.4985 0.2604 -1.914 0.0556 . \n---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\nCorrelation of Fixed Effects:\n (Intr) netuse\nnetuse -0.422 \nphc -0.715 -0.025\n```\n:::\n:::\n\n\nD'après ces résultats, les variables *netuse* et *phc* sont toutes deux associées à une diminution de la prévalence du paludisme, bien que l'effet de *phc* ne soit pas significatif à un seuil $\\alpha = 0.05$. L'ordonnée à l'origine (0.149) est le logit de la probabilité de présence du paludisme pour un enfant sans moustiquaire et sans centre de santé publique, mais c'est l'ordonnée à l'origine moyenne pour tous les villages. Il y a beaucoup de variation entre les villages selon l'écart-type de l'effet aléatoire (0.90). Nous pouvons obtenir l'ordonnée à l'origine estimée pour chaque village avec la fonction `coef`:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-157_63042bdf37fbb1a41197653e4f00698a'}\n\n```{.r .cell-code}\nhead(coef(mod_glmm)$id_village)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n (Intercept) netuse phc\n1 0.93727515 -0.6043602 -0.4984835\n2 0.09204843 -0.6043602 -0.4984835\n3 0.22500620 -0.6043602 -0.4984835\n4 -0.46271089 -0.6043602 -0.4984835\n5 0.13680037 -0.6043602 -0.4984835\n6 -0.03723346 -0.6043602 -0.4984835\n```\n:::\n:::\n\n\nPar exemple, l'ordonnée à l'origine pour le village 1 est environ 0.94, équivalente à une probabilité de 72%:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-158_4a79548bf948a9a1dd6b953821a54623'}\n\n```{.r .cell-code}\nplogis(0.937)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 0.7184933\n```\n:::\n:::\n\n\ntandis que celle pour le village 2 est équivalente à une probabilité de 52%:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-159_4c5678258eaea6caef0b0f87f03a5423'}\n\n```{.r .cell-code}\nplogis(0.092)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n[1] 0.5229838\n```\n:::\n:::\n\n\nLe [package DHARMa](https://cran.r-project.org/web/packages/DHARMa/vignettes/DHARMa.html) fournit une méthode générale pour vérifier si les résidus d'un GLMM sont distribués selon le modèle spécifié et s'il existe une tendance résiduelle. Il simule des réplicats de chaque observation selon le modèle ajusté et détermine ensuite un \"résidu standardisé\", qui est la position relative de la valeur observée par rapport aux valeurs simulées, par exemple 0 si l'observation est plus petite que toutes les simulations, 0.5 si elle se trouve au milieu, etc. Si le modèle représente bien les données, chaque valeur du résidu standardisé entre 0 et 1 doit avoir la même probabilité, de sorte que les résidus standardisés doivent produire une distribution uniforme entre 0 et 1.\n\nLa fonction `simulateResiduals` effectue le calcul des résidus standardisés, puis la fonction `plot` trace les graphiques de diagnostic avec les résultats de certains tests.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-160_9f18e83c75ae6d568f2e7722da9a3235'}\n\n```{.r .cell-code}\nlibrary(DHARMa)\nres_glmm <- simulateResiduals(mod_glmm)\nplot(res_glmm)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLe graphique de gauche est un graphique quantile-quantile des résidus standardisés. Les résultats de trois tests statistiques sont également présentés: un test de Kolmogorov-Smirnov (*KS*) qui vérifie s'il y a un écart par rapport à la distribution théorique, un test de dispersion qui vérifie s'il y a une sous-dispersion ou une surdispersion et un test de valeurs aberrantes (*outlier*) basé sur le nombre de résidus qui sont plus extrêmes que toutes les simulations. Ici, nous obtenons un résultat significatif pour les valeurs aberrantes, bien que le message indique que ce résultat pourrait avoir un taux d'erreur de type I plus grand que prévu dans ce cas.\n\nÀ droite, nous obtenons généralement un graphique des résidus standardisés (en *y*) en fonction du rang des valeurs prédites, afin de vérifier l'absence de tendance résiduelle. Ici, les prédictions sont regroupées par quartile, il serait donc préférable d'agréger les prédictions et les résidus par village, ce que nous pouvons faire avec la fonction `recalculateResiduals`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-161_24ccd295095906cee82b1b1c09edfb05'}\n\n```{.r .cell-code}\nplot(recalculateResiduals(res_glmm, group = gambia$id_village))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nLe graphique de droite montre les points individuels, ainsi qu'une régression quantile pour le 1er quartile, la médiane et le 3e quartile. En théorie, ces trois courbes devraient être des lignes droites horizontales (pas de tendance des résidus par rapport aux prévisions). La courbe pour le 3e quartile (en rouge) est significativement différente d'une ligne horizontale, ce qui pourrait indiquer un effet systématique manquant dans le modèle.\n\n## GLMM spatial avec spaMM\n\nLe package *spaMM* (modèles mixtes spatiaux) est un package R relativement récent qui permet d'effectuer une estimation approximative du maximum de vraisemblance des paramètres pour les GLM avec dépendance spatiale, modélisés soit comme un processus gaussien, soit avec un CAR (nous verrons ce dernier dans la dernière section). Le package implémente différents algorithmes, mais il existe une fonction unique `fitme` qui choisit l'algorithme approprié pour chaque type de modèle. Par exemple, voici le même modèle (non spatial) que nous avons vu ci-dessus, ajusté avec *spaMM*.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-162_54461b112807b785cded2a0cabf936b4'}\n\n```{.r .cell-code}\nlibrary(spaMM)\n\nmod_spamm_glmm <- fitme(pos ~ netuse + phc + (1 | id_village),\n data = gambia, family = binomial)\nsummary(mod_spamm_glmm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + (1 | id_village)\nEstimation of lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.1491 0.2287 0.6519\nnetuse -0.6045 0.1420 -4.2567\nphc -0.4986 0.2593 -1.9231\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n id_village : 0.8151 \n --- Coefficients for log(lambda):\n Group Term Estimate Cond.SE\n id_village (Intercept) -0.2045 0.2008\n# of obs: 2035; # of groups: id_village, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1210.016\n```\n:::\n:::\n\n\nNotez que les estimés des effets fixes ainsi que la variance des effets aléatoires sont presque identiques à ceeux obtenues par `glmer` ci-dessus.\n\nNous pouvons maintenant utiliser *spaMM* pour ajuster le même modèle avec l'ajout de corrélations spatiales entre les villages. Dans la formule du modèle, ceci est représenté comme un effet aléatoire `Matern(1 | x + y)`, ce qui signifie que les ordonnées à l'origine sont spatialement corrélées entre les villages suivant une fonction de corrélation de Matérn des coordonnées (*x, y*). La fonction de Matérn est une fonction flexible de corrélation spatiale qui comprend un paramètre de forme $\\nu$ (`nu`), de sorte que lorsque $\\nu = 0,5$, elle est équivalente à la corrélation exponentielle, mais quand $\\nu$ prend de grandes valeurs, elle se rapproche d'une corrélation gaussienne. Nous pourrions laisser la fonction estimer $\\nu$, mais ici nous le fixons à 0.5 avec l'argument `fixed` de `fitme`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-163_94f8693a9a4ea45698056ea7d175adbc'}\n\n```{.r .cell-code}\nmod_spamm <- fitme(pos ~ netuse + phc + Matern(1 | x + y) + (1 | id_village),\n data = gambia, family = binomial, fixed = list(nu = 0.5))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nIncrease spaMM.options(separation_max=<.>) to at least 21 if you want to check separation (see 'help(separation)').\n```\n:::\n\n```{.r .cell-code}\nsummary(mod_spamm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + Matern(1 | x + y) + (1 | id_village)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.06861 0.3352 0.2047\nnetuse -0.51719 0.1407 -3.6757\nphc -0.44416 0.2052 -2.1648\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.nu 1.rho \n0.50000000 0.05128692 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n x + y : 0.6421 \n id_village : 0.1978 \n# of obs: 2035; # of groups: x + y, 65; id_village, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1197.968\n```\n:::\n:::\n\n\nCommençons par vérifier les effets aléatoires du modèle. La fonction de corrélation spatiale a un paramètre `rho` égal à 0.0513. Ce paramètre dans *spaMM* est l'inverse de la portée, donc ici la portée de la corrélation exponentielle est de 1/0.0513 ou environ 19.5 km. Il y a maintenant deux pramètres de variance, celui identifié comme `x + y` est la variance à longue distance (i.e. le palier) pour le modèle de corrélation exponentielle alors que celui identifié comme `id_village` montre la portion non corrélée de la variation entre les villages.\n\nSi nous avions ici laissé les effets aléatoires `(1 | id_village)` dans la formule pour représenter la partie non spatiale de la variation entre les villages, nous pourrions également représenter ceci avec un effet de pépite dans le modèle géostatistique. Dans les deux cas, cela représenterait l'idée que même deux villages très proches l'un de l'autre auraient des prévalences de base différentes dans le modèle.\n\nPar défaut, la fonction `Matern` n'a pas d'effet de pépite, mais nous pouvons en ajouter un en spécifiant une `pépite` non nulle dans la liste initiale des paramètres `init`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-164_7807f13fbd48e4a433573a5160e106f1'}\n\n```{.r .cell-code}\nmod_spamm2 <- fitme(pos ~ netuse + phc + Matern(1 | x + y),\n data = gambia, family = binomial, fixed = list(nu = 0.5),\n init = list(Nugget = 0.1))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nIncrease spaMM.options(separation_max=<.>) to at least 21 if you want to check separation (see 'help(separation)').\n```\n:::\n\n```{.r .cell-code}\nsummary(mod_spamm2)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: pos ~ netuse + phc + Matern(1 | x + y)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: binomial( link = logit ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) 0.06861 0.3352 0.2047\nnetuse -0.51719 0.1407 -3.6757\nphc -0.44416 0.2052 -2.1648\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.nu 1.Nugget 1.rho \n0.50000000 0.23551027 0.05128692 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n x + y : 0.8399 \n# of obs: 2035; # of groups: x + y, 65 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -1197.968\n```\n:::\n:::\n\n\nComme vous pouvez le voir, toutes les estimations sont les mêmes, sauf que la variance de la portion spatiale (palier) est maintenant de 0.84 et que la pépite est égale à une fraction 0.235 de ce palier, soit une variance de 0.197, ce qui est identique à l'effet aléatoire `id_village` dans la version ci-dessus. Les deux formulations sont donc équivalentes.\n\nMaintenant, rappelons les coefficients que nous avions obtenus pour le GLMM non spatial :\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-165_d9e37edd6e102c7e0e32c00182b4c98d'}\n\n```{.r .cell-code}\nsummary(mod_glmm)$coefficients\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 0.1490596 0.2296971 0.6489399 5.163772e-01\nnetuse -0.6043602 0.1442448 -4.1898243 2.791706e-05\nphc -0.4984835 0.2604083 -1.9142382 5.558973e-02\n```\n:::\n:::\n\n\nDans la version spatiale, les deux effets fixes se sont légèrement rapprochés de zéro, mais l'erreur-type de l'effet de `phc` a diminué. Il est intéressant de noter que l'inclusion de la dépendance spatiale nous a permis d'estimer plus précisément l'effet de la présence d'un centre de santé publique dans le village. Ce ne serait pas toujours le cas: pour un prédicteur qui est également fortement corrélé dans l'espace, la corrélation spatiale dans la réponse rend plus difficile l'estimation de l'effet de ce prédicteur, puisqu'il est confondu avec l'effet spatial. Cependant, pour un prédicteur qui n'est pas corrélé dans l'espace, l'inclusion de l'effet spatial réduit la variance résiduelle (non spatiale) et peut donc augmenter la précision de l'effet du prédicteur.\n\nLe package *spaMM* est également compatible avec *DHARMa* pour les diagnostics résiduels. (Vous pouvez ignorer l'avertissement selon lequel il ne fait pas partie de la classe des modèles pris en charge, cela est dû à l'utilisation de la fonction `fitme` plutôt que d'une fonction d'algorithme spécifique dans *spaMM*).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-166_482f0fc040c81b2f1de2f8ee99aed0d1'}\n\n```{.r .cell-code}\nres_spamm <- simulateResiduals(mod_spamm2)\nplot(res_spamm)\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n\n```{.r .cell-code}\nplot(recalculateResiduals(res_spamm, group = gambia$id_village))\n```\n\n::: {.cell-output .cell-output-stderr}\n```\nDHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details\n```\n:::\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nEnfin, bien que nous allons montrer comment calculer et visualiser des prédictions spatiales ci-dessous, nous pouvons produire une carte rapide des effets spatiaux estimés dans un modèle *spaMM* avec la fonction `filled.mapMM`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-167_e868e1e85e43353fb2484a914c5ac95b'}\n\n```{.r .cell-code}\nfilled.mapMM(mod_spamm2)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\n## Processus gaussiens vs. splines de lissage\n\nSi vous connaissez bien les modèles additifs généralisés (GAM), vous avez peut-être pensé à représenter la variation spatiale de la prévalence du paludisme (comme le montre la carte ci-dessus) par une spline de lissage en 2D (en fonction de $x$ et $y$) dans un GAM.\n\nLe code ci-dessous correspond à l'équivalent GAM de notre GLMM avec processus gaussien ci-dessus, ajusté avec la fonction `gam` du package *mgcv*. L'effet spatial est représenté par la spline 2D `s(x, y)` alors que l'effet aléatoire non spatial de village est représenté par `s(id_village, bs = \"re\")`, qui est équivalent à `(1 | id_village)` dans les modèles précédents. Notez que pour la fonction `gam`, les variables catégorielles doivent être explicitement converties en facteurs.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-168_5bc46e857407589375ab5b89e189742e'}\n\n```{.r .cell-code}\nlibrary(mgcv)\ngambia$id_village <- as.factor(gambia$id_village)\nmod_gam <- gam(pos ~ netuse + phc + s(id_village, bs = \"re\") + s(x, y), \n data = gambia, family = binomial)\n```\n:::\n\n\nPour visualiser la spline en 2D, nous utiliserons le package [*gratia*](https://fromthebottomoftheheap.net/2018/10/23/introducing-gratia/).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-169_07227aba979cb7fed1f2b23e7e58bfaa'}\n\n```{.r .cell-code}\nlibrary(gratia)\ndraw(mod_gam)\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nNotez que le graphique de la spline `s(x, y)` (en haut à droite) ne s'étend pas trop loin des emplacements des données (les autres zones sont vides). Dans ce graphique, on peut également voir que les effets aléatoires des villages suivent la distribution gaussienne attendue (en haut à gauche).\n\nEnsuite, nous utiliserons à la fois le GLMM spatial de la section précédente et ce GAMM pour prédire la prévalence moyenne sur une grille spatiale de points contenue dans le fichier [gambia_pred.csv](data/gambia_pred.csv). Le graphique ci-dessous ajoute ces points de prédiction (en noir) sur la carte précédente des points de données.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-170_a944ccbc8f583a47e766a152bff9062f'}\n\n```{.r .cell-code}\ngambia_pred <- read.csv(\"data/gambia_pred.csv\")\n\nggplot(gambia_agg, aes(x = x, y = y)) +\n geom_point(data = gambia_pred) +\n geom_point(aes(color = prev)) +\n geom_path(data = gambia.borders, aes(x = x / 1000, y = y / 1000)) +\n coord_fixed() +\n theme_minimal() +\n scale_color_viridis_c()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nPour faire des prédictions à partir du modèle GAMM à ces endroits, le code ci-dessous effectue les étapes suivantes:\n\n- Tous les prédicteurs du modèle doivent se trouver dans le tableau de données de prédiction, nous ajoutons donc des valeurs constantes de *netuse* et *phc* (toutes deux égales à 1) pour tous les points. Ainsi, nous ferons des prédictions sur la prévalence du paludisme dans le cas où un moustiquaire est utilisée et où un centre de santé publique est présent. Nous ajoutons également un *id_village* constant, bien qu'il ne soit pas utilisé dans les prédictions (voir ci-dessous).\n\n- Nous appelons la fonction `predict` à la sortie de `gam` pour produire des prédictions aux nouveaux points de données (argument `newdata`), en incluant les erreurs-types (`se.fit = TRUE`) et en excluant les effets aléatoires du village, donc la prédiction est faite pour un \"village moyen\". L'objet résultant `gam_pred` aura des colonnes `fit` (prédiction moyenne) et `se.fit` (erreur-type). Ces prédictions et erreurs-types sont sur l'échelle du lien (logit).\n\n- Nous rattachons le jeu de données de prédiction original à `gam_pred` avec `cbind`. \n\n- Nous ajoutons des colonnes pour la prédiction moyenne et les limites de l'intervalle de confiance à 50% (moyenne $\\pm$ 0.674 erreur-type), converties de l'échelle logit à l'échelle de probabilité avec `plogis`. Nous choisissons un intervalle de 50% car un intervalle de 95% peut être trop large ici pour contraster les différentes prédictions sur la carte à la fin de cette section.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-171_357ffbfea872595db79ace469d64440a'}\n\n```{.r .cell-code}\ngambia_pred <- mutate(gambia_pred, netuse = 1, phc = 1, id_village = 1)\n\ngam_pred <- predict(mod_gam, newdata = gambia_pred, se.fit = TRUE, \n exclude = \"s(id_village)\")\ngam_pred <- cbind(gambia_pred, as.data.frame(gam_pred))\ngam_pred <- mutate(gam_pred, pred = plogis(fit), \n lo = plogis(fit - 0.674 * se.fit), # 50% CI\n hi = plogis(fit + 0.674 * se.fit))\n```\n:::\n\n\n*Note* : La raison pour laquelle nous ne faisons pas de prédictions directement sur l'échelle de probabilité (réponse) est que la formule normale des intervalles de confiance s'applique plus précisément sur l'échelle logit. L'ajout d'un certain nombre d'erreurs-types autour de la moyenne sur l'échelle de probabilité conduirait à des intervalles moins précis et peut-être même à des intervalles de confiance en dehors de la plage de valeurs possible (0, 1) pour une probabilité.\n\nNous appliquons la même stratégie pour faire des prédictions à partir du GLMM spatial avec *spaMM*. Il y a quelques différences dans la méthode `predict` par rapport au cas du GAMM.\n\n- L'argument `binding = \"fit\"` signifie que les prédictions moyennes (colonne `fit`) seront attachées à l'ensemble de données de prédiction et retournées sous forme de tableau de données `spamm_pred`.\n\n- L'argument `variances = list(linPred = TRUE)` indique à `predict` de calculer la variance du prédicteur linéaire (donc le carré de l'erreur-type). Cependant, il apparaît comme un attribut `predVar` dans le tableau de données de sortie plutôt que dans une colonne `se.fit`, donc nous le déplaçons vers une colonne sur la ligne suivante. \n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-172_4419491a3882f147cdc904a6d1ed9d9c'}\n\n```{.r .cell-code}\nspamm_pred <- predict(mod_spamm, newdata = gambia_pred, type = \"link\",\n binding = \"fit\", variances = list(linPred = TRUE))\nspamm_pred$se.fit <- sqrt(attr(spamm_pred, \"predVar\"))\nspamm_pred <- mutate(spamm_pred, pred = plogis(fit), \n lo = plogis(fit - 0.674 * se.fit),\n hi = plogis(fit + 0.674 * se.fit))\n```\n:::\n\n\nEnfin, nous combinons les deux ensembles de prédictions sous la forme de différentes rangées d'un tableau de données `pred_all` avec `bind_rows`. Le nom du tableau de données d'où provient chaque prédiction (`gam` ou `spamm`) apparaîtra dans la colonne \"model\" (argument `.id`). Pour simplifier la production du prochain graphique, nous utilisons ensuite `pivot_longer` dans le package *tidyr* pour changer les trois colonnes \"pred\", \"lo\" et \"hi\" en deux colonnes, \"stat\" et \"value\" (`pred_tall` a donc trois rangées pour chaque rangée dans `pred_all`).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-173_1fc1b4f68f5b10a718d8d768a968469c'}\n\n```{.r .cell-code}\npred_all <- bind_rows(gam = gam_pred, spamm = spamm_pred, .id = \"model\")\n\nlibrary(tidyr)\npred_tall <- pivot_longer(pred_all, c(pred, lo, hi), names_to = \"stat\",\n values_to = \"value\")\n```\n:::\n\n\nUne fois ces étapes franchies, nous pouvons enfin examiner les cartes de prédiction (moyenne, limites inférieure et supérieure de l'intervalle de confiance à 50 %) à l'aide d'un graphique `ggplot`. Les points de données originaux sont indiqués en rouge.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-174_f5e1618501cf8d5cc8fb3b12843ae8e2'}\n\n```{.r .cell-code}\nggplot(pred_tall, aes(x = x, y = y)) +\n geom_point(aes(color = value)) +\n geom_point(data = gambia_agg, color = \"red\", size = 0) +\n coord_fixed() +\n facet_grid(stat~model) +\n scale_color_viridis_c() +\n theme_minimal()\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nBien que les deux modèles s'accordent à dire que la prévalence est plus élevée près du groupe de villages de l'est, le GAMM estime également une prévalence plus élevée en quelques points (bord ouest et autour du centre) où il n'y a pas de données. Il s'agit d'un artefact de la forme de la spline autour des points de données, puisqu'une spline est censée correspondre à une tendance globale, bien que non linéaire. En revanche, le modèle géostatistique représente l'effet spatial sous forme de corrélations locales et revient à la prévalence moyenne globale lorsqu'il est éloigné de tout point de données, ce qui est une supposition plus sûre. C'est l'une des raisons pour lesquelles il est préférable de choisir un modèle géostatistique / processus gaussien dans ce cas.\n\n## Méthodes bayésiennes pour les GLMM avec processus gaussiens\n\nLes modèles bayésiens fournissent un cadre flexible pour exprimer des modèles avec une structure de dépendance complexe entre les données, y compris la dépendance spatiale. Cependant, l'ajustement d'un modèle de processus gaussien avec une approche entièrement bayésienne peut être lent, en raison de la nécessité de calculer une matrice de covariance spatiale entre toutes les paires de points à chaque itération. \n\nLa méthode INLA (pour *integrated nested Laplace approximation*) effectue un calcul approximatif de la distribution postérieure bayésienne, ce qui la rend adaptée aux problèmes de régression spatiale. Nous ne l'abordons pas dans ce cours, mais je recommande le manuel de Paula Moraga (dans la section des références ci-dessous) qui fournit des exemples concrets d'utilisation de la méthode INLA pour divers modèles de données géostatistiques et aréales, dans le contexte de l'épidémiologie, y compris des modèles avec une dépendance à la fois spatiale et temporelle. Le livre présente les mêmes données sur le paludisme en Gambie comme exemple d'un ensemble de données géostatistiques, ce qui a inspiré son utilisation dans ce cours.\n\n# GLMM avec autorégression spatiale {#glmm-spatial-autoreg-fr}\n\nNous revenons au dernier exemple de la partie précédente, où nous avions modélisé le taux de cas de COVID-19 (cas / 1000) pour les divisions administratives du réseau de la santé (RLS) au Québec en fonction de leur densité de population. Le taux est donné par la colonne \"taux_1k\" dans le *shapefile* `rls_covid`.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-175_d979460e37556b83e05dc8fb16e15b65'}\n\n```{.r .cell-code}\nlibrary(sf)\nrls_covid <- read_sf(\"data/rls_covid.shp\")\nrls_covid <- rls_covid[!is.na(rls_covid$dens_pop), ]\nplot(rls_covid[\"taux_1k\"])\n```\n\n::: {.cell-output-display}\n{width=672}\n:::\n:::\n\n\nAuparavant, nous avions modélisé le logarithme de ce taux comme une fonction linéaire du logarithme de la densité de population, la variance résiduelle étant corrélée entre les unités voisines via une structure CAR (autorégression conditionnelle), comme le montre le code ci-dessous.\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-176_eabbd635c0d88a1a771574c50afa7c53'}\n\n```{.r .cell-code}\nlibrary(spdep)\nlibrary(spatialreg)\n\nrls_nb <- poly2nb(rls_covid)\nrls_w <- nb2listw(rls_nb, style = \"B\")\n\ncar_lm <- spautolm(log(taux_1k) ~ log(dens_pop), data = rls_covid,\n listw = rls_w, family = \"CAR\")\nsummary(car_lm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\n\nCall: spautolm(formula = log(taux_1k) ~ log(dens_pop), data = rls_covid, \n listw = rls_w, family = \"CAR\")\n\nResiduals:\n Min 1Q Median 3Q Max \n-1.201858 -0.254084 -0.053348 0.281482 1.427053 \n\nCoefficients: \n Estimate Std. Error z value Pr(>|z|)\n(Intercept) 1.702068 0.168463 10.1035 < 2.2e-16\nlog(dens_pop) 0.206623 0.032848 6.2903 3.169e-10\n\nLambda: 0.15762 LR test value: 23.991 p-value: 9.6771e-07 \nNumerical Hessian standard error of lambda: 0.0050486 \n\nLog likelihood: -80.68953 \nML residual variance (sigma squared): 0.2814, (sigma: 0.53048)\nNumber of observations: 95 \nNumber of parameters estimated: 4 \nAIC: 169.38\n```\n:::\n:::\n\n\n*Rappel*: La fonction `poly2nb` du package *spdep* crée une liste de voisins basée sur les polygones limitrophes dans un *shapefile*, puis `nb2listw` la convertit en une liste de poids, ici des poids binaires (`style = \"B\"`) de sorte que chaque région limitrophe reçoive le même poids de 1 dans le modèle autorégressif.\n\nAu lieu d'utiliser les taux, il serait possible de modéliser directement les cas avec une régression de Poisson, qui est appropriée pour les données de comptage. Pour tenir compte du fait que si le risque par personne était égal, les cas seraient proportionnels à la population, nous pouvons ajouter la population de l'unité `pop` comme *offset* dans la régression de Poisson. Par conséquent, le modèle ressemblerait à : `cas ~ log(dens_pop) + offset(log(pop))`. Notez que puisque la régression de Poisson utilise un lien logarithmique, ce modèle avec `log(pop)` comme *offset* suppose que `log(cas / pop)` (donc le taux logarithmique) est proportionnel à `log(dens_pop)`, tout comme le modèle linéaire ci-dessus, mais il a l'avantage de modéliser la variabilité des données brutes (le nombre de cas) directement avec une distribution de Poisson.\n\nNous n'avons pas la population dans ces données, mais nous pouvons l'estimer à partir des cas et du taux (cas / 1000) comme suit:\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-177_6dfaa30fb79c49e08cda1647cb0cd013'}\n\n```{.r .cell-code}\nrls_covid$pop <- rls_covid$cas / rls_covid$taux_1k * 1000\n```\n:::\n\n\nPour définir un modèle CAR dans *spaMM*, nous avons besoin d'une matrice de poids plutôt que d'une liste de poids comme dans le package *spatialreg*. Heureusement, le package *spdep* comprend également une fonction `nb2mat` pour convertir la liste des voisins en une matrice de poids, là encore en utilisant des poids binaires. Pour éviter un avertissement dans R, nous spécifions que les noms des lignes et des colonnes de cette matrice doivent être égaux aux identifiants associés à chaque unité (`RLS_code`). Ensuite, nous ajoutons un terme `adjacency(1 | RLS_code)` au modèle pour spécifier que la variation résiduelle entre les différents groupes définis par `RLS_code` est spatialement corrélée avec une structure CAR (ici, chaque groupe n'a qu'une observation puisque nous avons un point de données par unité RLS).\n\n\n::: {.cell hash='index_cache/html/unnamed-chunk-178_c3221c2defe378081625dfcfb8bdbe89'}\n\n```{.r .cell-code}\nlibrary(spaMM)\n\nrls_mat <- nb2mat(rls_nb, style = \"B\")\nrownames(rls_mat) <- rls_covid$RLS_code\ncolnames(rls_mat) <- rls_covid$RLS_code\n\nrls_spamm <- fitme(cas ~ log(dens_pop) + offset(log(pop)) + adjacency(1 | RLS_code),\n data = rls_covid, adjMatrix = rls_mat, family = poisson)\nsummary(rls_spamm)\n```\n\n::: {.cell-output .cell-output-stdout}\n```\nformula: cas ~ log(dens_pop) + offset(log(pop)) + adjacency(1 | RLS_code)\nEstimation of corrPars and lambda by ML (p_v approximation of logL).\nEstimation of fixed effects by ML (p_v approximation of logL).\nEstimation of lambda by 'outer' ML, maximizing logL.\nfamily: poisson( link = log ) \n ------------ Fixed effects (beta) ------------\n Estimate Cond. SE t-value\n(Intercept) -5.1618 0.16855 -30.625\nlog(dens_pop) 0.1999 0.03267 6.119\n --------------- Random effects ---------------\nFamily: gaussian( link = identity ) \n --- Correlation parameters:\n 1.rho \n0.1576605 \n --- Variance parameters ('lambda'):\nlambda = var(u) for u ~ Gaussian; \n RLS_code : 0.266 \n# of obs: 95; # of groups: RLS_code, 95 \n ------------- Likelihood values -------------\n logLik\nlogL (p_v(h)): -709.3234\n```\n:::\n:::\n\n\nNotez que le coefficient de corrélation spatiale `rho` (0.158) est similaire à la quantité équivalente dans le modèle `spautolm` ci-dessus, où il était appelé `Lambda`. L'effet de `log(dens_pop)` est également d'environ 0.2 dans les deux modèles.\n\n\n## Référence\n\nMoraga, Paula (2019) Geospatial Health Data: Modeling and Visualization with R-INLA and Shiny. Chapman & Hall/CRC Biostatistics Series. Disponible en ligne: [https://www.paulamoraga.com/book-geospatial/](https://www.paulamoraga.com/book-geospatial/). \n",
"supporting": [],
"filters": [
"rmarkdown/pagebreak.lua"
diff --git a/.quarto/_freeze/posts/2021-03-25-point-count-data-analysis/index/execute-results/html.json b/.quarto/_freeze/posts/2021-03-25-point-count-data-analysis/index/execute-results/html.json
index e8032b8..2729741 100644
--- a/.quarto/_freeze/posts/2021-03-25-point-count-data-analysis/index/execute-results/html.json
+++ b/.quarto/_freeze/posts/2021-03-25-point-count-data-analysis/index/execute-results/html.json
@@ -1,10 +1,8 @@
{
- "hash": "81d2f348a7490fadd07c97687be6f98a",
+ "hash": "bdd59f9c065e2296897c5e573a62409d",
"result": {
- "markdown": "---\ntitle: \"Point-count Data Analysis\"\ndescription: |\n Analysis of point-count data in the presence of variable survey methodologies and detection error offered by Péter Sólymos to BIOS2 Fellows in March 2021.\nauthor: \n - name: \"Péter Sólymos\"\n affiliation: University of Alberta\nimage: thumb.jpeg\ndate: \"2021-03-25\"\ncategories: [Technical, EN]\ntoc: true\nnumber-sections: true\nnumber-depth: 1\n---\n\n\n\n\nThis course is aimed towards researchers analyzing field observations, who are often faced by data heterogeneities due to field sampling protocols changing from one project to another, or through time over the lifespan of projects, or trying to combine 'legacy' data sets with new data collected by recording units.\n\nSuch heterogeneities can bias analyses when data sets are integrated inadequately, or can lead to information loss when filtered and standardized to common standards. Accounting for these issues is important for better inference regarding status and trend of species and communities.\n\nAnalysts of such 'messy' data sets need to feel comfortable with manipulating the data, need a full understanding the mechanics of the models being used (i.e. critically interpreting the results and acknowledging assumptions and limitations), and should be able to make informed choices when faced with methodological challenges.\n\nThe course emphasizes critical thinking and active learning through hands on programming exercises. We will use publicly available data sets to demonstrate the data manipulation and analysis. We will use freely available and open-source R packages.\n\nThe expected outcome of the course is a solid foundation for further professional development via increased confidence in applying these methods for field observations.\n\n## Instructor\n\n[**Dr. Peter Solymos**](https://peter.solymos.org)\\\n[Boreal Avian Modelling Project](https://borealbirds.ca) and the [Alberta Biodiversity Monitoring Institute](https://abmi.ca)\\\n[Department of Biological Sciences](https://www.ualberta.ca/biological-sciences/), [University of Alberta](https://ualberta.ca)\n\n## Outline\n\nEach day will consist of 3 sessions, roughly one hour each, with short breaks in between.\n\n> The video recordings from the workshop can be found on [YouTube](https://www.youtube.com/watch?v=cXGXvAOqEng&list=PLH424kyZX5ip0PfOo7g13nJEQNVxZlMOh).\n\n| Session | Topic | Files | Videos |\n|-----------------|-----------------|:-----------------:|:-----------------:|\n| **Day 1** | **Naive techniques** | | |\n| | 1\\. Introductions | [Slides](https://peter.solymos.org/qpad-workshop/day1-1-intro.pdf) | [Video](https://youtu.be/cXGXvAOqEng) |\n| | 2\\. Organizing point count data | [Notes](https://peter.solymos.org/qpad-workshop/day1-2-data-processing.html) | [Part 1](https://youtu.be/4PLyaU6bqRc), [Part 2](https://youtu.be/dcsiv-v0UgA) |\n| | 3\\. Regression techniques | [Notes](https://peter.solymos.org/qpad-workshop/day1-3-regression.html) | [Part 1](https://youtu.be/z_TpcF0FD4o), [Part 2](https://youtu.be/ZdTgdTqxFSM) |\n| **Day 2** | **Behavioral complexities** | | |\n| | 1\\. Statistical assumptions and nuisance variables | [Slides](https://peter.solymos.org/qpad-workshop/day2-1-intro.pdf) | [Video](https://youtu.be/8v3Uf_aILxI) |\n| | 2\\. Behavioral complexities | [Notes](https://peter.solymos.org/qpad-workshop/day2-2-behavior.html) | [bSims](https://youtu.be/gJ11_wlsEfU), [Video](https://youtu.be/UgGeaxMCs2c) |\n| | 3\\. Removal modeling techniques | [Notes](https://peter.solymos.org/qpad-workshop/day2-3-removal.html) | [Video](https://youtu.be/ny0ED9cxzeg) |\n| | 4\\. Finite mixture models and testing assumptions | [Notes](https://peter.solymos.org/qpad-workshop/day2-4-mixtures.html) | [Mixtures](https://youtu.be/A1cnzXMMlxU), [Testing](https://youtu.be/flF5NL73ZZE) |\n| **Day 3** | **The detection process** | | |\n| | 1\\. The detection process | [Slides](https://peter.solymos.org/qpad-workshop/day3-1-intro.pdf) | [Video](https://youtu.be/CkdYEF_hZqY) |\n| | 2\\. Distance sampling and density | [Notes](https://peter.solymos.org/qpad-workshop/day3-2-detection.html) | [Video](https://youtu.be/x8GfKDEJcrA) |\n| | 3\\. Estimating population density | [Notes](https://peter.solymos.org/qpad-workshop/day3-2-detection.html) | [Video](https://youtu.be/yeoGxRQd6o0) |\n| | 4\\. Assumptions | [Notes](https://peter.solymos.org/qpad-workshop/day3-2-detection.html) | [Video](https://youtu.be/o0bx-vNCaL0) |\n| **Day 4** | **Coming full circle** | | |\n| | 1\\. QPAD overview | [Slides](https://peter.solymos.org/qpad-workshop/day4-1-intro.pdf) | [Video](https://youtu.be/TU9rcwY2Y-g) |\n| | 2\\. Models with detectability offsets | [Notes](https://peter.solymos.org/qpad-workshop/day4-2-qpad.html) | [Offsets](https://youtu.be/vw_WO2hgNwk), [Models](https://youtu.be/Cy68E1GyNVU) |\n| | 3\\. Model validation and error propagation | [Notes](https://peter.solymos.org/qpad-workshop/day4-2-qpad.html) | [Validation](https://youtu.be/lRcJzfE838k), [Error](https://youtu.be/na5cTYNq2HM) |\n| | 4\\. Recordings, roadsides, closing remarks | [Notes](https://peter.solymos.org/qpad-workshop/day4-3-recordings.html) | [Video](https://youtu.be/ckEDGdLA_J4) |\n\n## Get course materials\n\n### Install required software\n\nFollow the instructions at the [R website](http://cran.r-project.org) to download and install the most up-to-date base R version suitable for your operating system (the latest R version at the time of writing these instructions is 4.0.4).\n\nThen run the following script in R:\n\n``` r\nsource(\"https://raw.githubusercontent.com/psolymos/qpad-workshop/main/src/install.R\")\n```\n\nHaving RStudio is not absolutely necessary, but it will make life easier. RStudio is also available for different operating systems. Pick the open source desktop edition from [here](http://www.rstudio.com/products/rstudio/download/) (the latest RStudio Desktop version at the time of writing these instructions is 1.4.1106).\n\nPrior exposure to R programming is not necessary, but knowledge of basic R object types and their manipulation (arrays, data frames, indexing) is useful for following hands-on exercises. Software Carpentry's [Data types and structures in R](http://swcarpentry.github.io/r-novice-inflammation/13-supp-data-structures/index.html) is a good resource to brush up your R skills.\n\n### Get the notes\n\nIf you don't want to use git:\n\n1. Download the [workshop archive](qpad-workshop-Final.zip) release into a folder\n2. Extract the zip archive\n3. Open the `workshop.Rproj` file in RStudio (or open any other R GUI/console and `setwd()` to the directory where you downloaded the file)\n4. (You can delete the archive)\n\nIf you want to use git: fork or clone the repository\n\n``` bash\ncd into/your/dir\ngit clone https://github.com/psolymos/qpad-workshop.git\n```\n\n## Useful resources\n\n- [Using the QPAD package to get offsets based on estimates from the Boreal Avian Modelling Project's database](https://github.com/ABbiodiversity/recurring/blob/master/offset/README.md)\n- [NA-POPS: Point count Offsets for Population Sizes of North America landbirds](http://na-pops.org/)\n\n## References\n\nSólymos, P., Toms, J. D., Matsuoka, S. M., Cumming, S. G., Barker, N. K. S., Thogmartin, W. E., Stralberg, D., Crosby, A. D., Dénes, F. V., Haché, S., Mahon, C. L., Schmiegelow, F. K. A., and Bayne, E. M., 2020. Lessons learned from comparing spatially explicit models and the Partners in Flight approach to estimate population sizes of boreal birds in Alberta, Canada. *Condor*, 122: 1-22. [PDF](https://drive.google.com/file/d/115WgtPd4zUSIFfSTHbWYs8OCHNdpKkh5/view?usp=sharing)\n\nSólymos, P., Matsuoka, S. M., Cumming, S. G., Stralberg, D., Fontaine, P., Schmiegelow, F. K. A., Song, S. J., and Bayne, E. M., 2018. Evaluating time-removal models for estimating availability of boreal birds during point-count surveys: sample size requirements and model complexity. *Condor*, 120: 765-786. [PDF](https://drive.google.com/file/d/13Czd_A82P0ZhIlvAEabxdHfmaZcJaNU3/view?usp=sharing)\n\nSólymos, P., Matsuoka, S. M., Stralberg, D., Barker, N. K. S., and Bayne, E. M., 2018. Phylogeny and species traits predict bird detectability. *Ecography*, 41: 1595-1603. [PDF](https://drive.google.com/file/d/1CRKl-bh1tqxddijEWZoNcDO_xFIgOfWZ/view?usp=sharing)\n\nVan Wilgenburg, S. L., Sólymos, P., Kardynal, K. J. and Frey, M. D., 2017. Paired sampling standardizes point count data from humans and acoustic recorders. *Avian Conservation and Ecology*, 12(1):13. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPOTZyTXlDb0xFQTA/view?usp=sharing)\n\nYip, D. A., Leston, L., Bayne, E. M., Sólymos, P. and Grover, A., 2017. Experimentally derived detection distances from audio recordings and human observers enable integrated analysis of point count data. *Avian Conservation and Ecology*, 12(1):11. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPQ2F6d1llQ3lPTzg/view?usp=sharing)\n\nSólymos, P., and Lele, S. R., 2016. Revisiting resource selection probability functions and single-visit methods: clarification and extensions. *Methods in Ecology and Evolution*, 7:196-205. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPRE5tVlRMSmhLWmM/view?usp=sharing)\n\nMatsuoka, S. M., Mahon, C. L., Handel, C. M., Sólymos, P., Bayne, E. M., Fontaine, P. C., and Ralph, C. J., 2014. Reviving common standards in point-count surveys for broad inference across studies. *Condor* 116:599-608. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPcGZNS3JSRUlBdDQ/view?usp=sharing)\n\nSólymos, P., Matsuoka, S. M., Bayne, E. M., Lele, S. R., Fontaine, P., Cumming, S. G., Stralberg, D., Schmiegelow, F. K. A. & Song, S. J., 2013. Calibrating indices of avian density from non-standardized survey data: making the most of a messy situation. *Methods in Ecology and Evolution* 4:1047-1058. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPV0RNUFU1N1dmS1E/view?usp=sharing)\n\nMatsuoka, S. M., Bayne, E. M., Sólymos, P., Fontaine, P., Cumming, S. G., Schmiegelow, F. K. A., & Song, S. A., 2012. Using binomial distance-sampling models to estimate the effective detection radius of point-counts surveys across boreal Canada. *Auk* 129:268-282. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPbFhhRUtZNWQyMk0/view?usp=sharing)\n\n## License\n\nThe course material is licensed under [Attribution-NonCommercial-ShareAlike 4.0 International (CC BY-NC-SA 4.0)](https://creativecommons.org/licenses/by-nc-sa/4.0/) license. Source code is under [MIT](LICENSE) license.\n",
- "supporting": [
- "index_files"
- ],
+ "markdown": "---\ntitle: \"Point-count Data Analysis\"\ndescription: |\n Analysis of point-count data in the presence of variable survey methodologies and detection error offered by Peter Solymos to BIOS2 Fellows in March 2021.\nauthor: Peter Solymos\nimage: thumb.jpeg\ndate: \"2021-03-25\"\ncategories: [Technical, EN]\ntoc: true\nnumber-sections: true\nnumber-depth: 1\n---\n\n\n\n\nThis course is aimed towards researchers analyzing field observations, who are often faced by data heterogeneities due to field sampling protocols changing from one project to another, or through time over the lifespan of projects, or trying to combine 'legacy' data sets with new data collected by recording units.\n\nSuch heterogeneities can bias analyses when data sets are integrated inadequately, or can lead to information loss when filtered and standardized to common standards. Accounting for these issues is important for better inference regarding status and trend of species and communities.\n\nAnalysts of such 'messy' data sets need to feel comfortable with manipulating the data, need a full understanding the mechanics of the models being used (i.e. critically interpreting the results and acknowledging assumptions and limitations), and should be able to make informed choices when faced with methodological challenges.\n\nThe course emphasizes critical thinking and active learning through hands on programming exercises. We will use publicly available data sets to demonstrate the data manipulation and analysis. We will use freely available and open-source R packages.\n\nThe expected outcome of the course is a solid foundation for further professional development via increased confidence in applying these methods for field observations.\n\n## Instructor\n\n[**Dr. Peter Solymos**](https://peter.solymos.org)\\\n[Boreal Avian Modelling Project](https://borealbirds.ca) and the [Alberta Biodiversity Monitoring Institute](https://abmi.ca)\\\n[Department of Biological Sciences](https://www.ualberta.ca/biological-sciences/), [University of Alberta](https://ualberta.ca)\n\n## Outline\n\nEach day will consist of 3 sessions, roughly one hour each, with short breaks in between.\n\n> The video recordings from the workshop can be found on [YouTube](https://www.youtube.com/watch?v=cXGXvAOqEng&list=PLH424kyZX5ip0PfOo7g13nJEQNVxZlMOh).\n\n| Session | Topic | Files | Videos |\n|-----------|----------------------------------------------------|:----------------------------------------------------------------------------:|:---------------------------------------------------------------------------------:|\n| **Day 1** | **Naive techniques** | | |\n| | 1\\. Introductions | [Slides](https://peter.solymos.org/qpad-workshop/day1-1-intro.pdf) | [Video](https://youtu.be/cXGXvAOqEng) |\n| | 2\\. Organizing point count data | [Notes](https://peter.solymos.org/qpad-workshop/day1-2-data-processing.html) | [Part 1](https://youtu.be/4PLyaU6bqRc), [Part 2](https://youtu.be/dcsiv-v0UgA) |\n| | 3\\. Regression techniques | [Notes](https://peter.solymos.org/qpad-workshop/day1-3-regression.html) | [Part 1](https://youtu.be/z_TpcF0FD4o), [Part 2](https://youtu.be/ZdTgdTqxFSM) |\n| **Day 2** | **Behavioral complexities** | | |\n| | 1\\. Statistical assumptions and nuisance variables | [Slides](https://peter.solymos.org/qpad-workshop/day2-1-intro.pdf) | [Video](https://youtu.be/8v3Uf_aILxI) |\n| | 2\\. Behavioral complexities | [Notes](https://peter.solymos.org/qpad-workshop/day2-2-behavior.html) | [bSims](https://youtu.be/gJ11_wlsEfU), [Video](https://youtu.be/UgGeaxMCs2c) |\n| | 3\\. Removal modeling techniques | [Notes](https://peter.solymos.org/qpad-workshop/day2-3-removal.html) | [Video](https://youtu.be/ny0ED9cxzeg) |\n| | 4\\. Finite mixture models and testing assumptions | [Notes](https://peter.solymos.org/qpad-workshop/day2-4-mixtures.html) | [Mixtures](https://youtu.be/A1cnzXMMlxU), [Testing](https://youtu.be/flF5NL73ZZE) |\n| **Day 3** | **The detection process** | | |\n| | 1\\. The detection process | [Slides](https://peter.solymos.org/qpad-workshop/day3-1-intro.pdf) | [Video](https://youtu.be/CkdYEF_hZqY) |\n| | 2\\. Distance sampling and density | [Notes](https://peter.solymos.org/qpad-workshop/day3-2-detection.html) | [Video](https://youtu.be/x8GfKDEJcrA) |\n| | 3\\. Estimating population density | [Notes](https://peter.solymos.org/qpad-workshop/day3-2-detection.html) | [Video](https://youtu.be/yeoGxRQd6o0) |\n| | 4\\. Assumptions | [Notes](https://peter.solymos.org/qpad-workshop/day3-2-detection.html) | [Video](https://youtu.be/o0bx-vNCaL0) |\n| **Day 4** | **Coming full circle** | | |\n| | 1\\. QPAD overview | [Slides](https://peter.solymos.org/qpad-workshop/day4-1-intro.pdf) | [Video](https://youtu.be/TU9rcwY2Y-g) |\n| | 2\\. Models with detectability offsets | [Notes](https://peter.solymos.org/qpad-workshop/day4-2-qpad.html) | [Offsets](https://youtu.be/vw_WO2hgNwk), [Models](https://youtu.be/Cy68E1GyNVU) |\n| | 3\\. Model validation and error propagation | [Notes](https://peter.solymos.org/qpad-workshop/day4-2-qpad.html) | [Validation](https://youtu.be/lRcJzfE838k), [Error](https://youtu.be/na5cTYNq2HM) |\n| | 4\\. Recordings, roadsides, closing remarks | [Notes](https://peter.solymos.org/qpad-workshop/day4-3-recordings.html) | [Video](https://youtu.be/ckEDGdLA_J4) |\n\n## Get course materials\n\n### Install required software\n\nFollow the instructions at the [R website](http://cran.r-project.org) to download and install the most up-to-date base R version suitable for your operating system (the latest R version at the time of writing these instructions is 4.0.4).\n\nThen run the following script in R:\n\n``` r\nsource(\"https://raw.githubusercontent.com/psolymos/qpad-workshop/main/src/install.R\")\n```\n\nHaving RStudio is not absolutely necessary, but it will make life easier. RStudio is also available for different operating systems. Pick the open source desktop edition from [here](http://www.rstudio.com/products/rstudio/download/) (the latest RStudio Desktop version at the time of writing these instructions is 1.4.1106).\n\nPrior exposure to R programming is not necessary, but knowledge of basic R object types and their manipulation (arrays, data frames, indexing) is useful for following hands-on exercises. Software Carpentry's [Data types and structures in R](http://swcarpentry.github.io/r-novice-inflammation/13-supp-data-structures/index.html) is a good resource to brush up your R skills.\n\n### Get the notes\n\nIf you don't want to use git:\n\n1. Download the [workshop archive](qpad-workshop-Final.zip) release into a folder\n2. Extract the zip archive\n3. Open the `workshop.Rproj` file in RStudio (or open any other R GUI/console and `setwd()` to the directory where you downloaded the file)\n4. (You can delete the archive)\n\nIf you want to use git: fork or clone the repository\n\n``` bash\ncd into/your/dir\ngit clone https://github.com/psolymos/qpad-workshop.git\n```\n\n## Useful resources\n\n- [Using the QPAD package to get offsets based on estimates from the Boreal Avian Modelling Project's database](https://github.com/ABbiodiversity/recurring/blob/master/offset/README.md)\n- [NA-POPS: Point count Offsets for Population Sizes of North America landbirds](http://na-pops.org/)\n\n## References\n\nSólymos, P., Toms, J. D., Matsuoka, S. M., Cumming, S. G., Barker, N. K. S., Thogmartin, W. E., Stralberg, D., Crosby, A. D., Dénes, F. V., Haché, S., Mahon, C. L., Schmiegelow, F. K. A., and Bayne, E. M., 2020. Lessons learned from comparing spatially explicit models and the Partners in Flight approach to estimate population sizes of boreal birds in Alberta, Canada. *Condor*, 122: 1-22. [PDF](https://drive.google.com/file/d/115WgtPd4zUSIFfSTHbWYs8OCHNdpKkh5/view?usp=sharing)\n\nSólymos, P., Matsuoka, S. M., Cumming, S. G., Stralberg, D., Fontaine, P., Schmiegelow, F. K. A., Song, S. J., and Bayne, E. M., 2018. Evaluating time-removal models for estimating availability of boreal birds during point-count surveys: sample size requirements and model complexity. *Condor*, 120: 765-786. [PDF](https://drive.google.com/file/d/13Czd_A82P0ZhIlvAEabxdHfmaZcJaNU3/view?usp=sharing)\n\nSólymos, P., Matsuoka, S. M., Stralberg, D., Barker, N. K. S., and Bayne, E. M., 2018. Phylogeny and species traits predict bird detectability. *Ecography*, 41: 1595-1603. [PDF](https://drive.google.com/file/d/1CRKl-bh1tqxddijEWZoNcDO_xFIgOfWZ/view?usp=sharing)\n\nVan Wilgenburg, S. L., Sólymos, P., Kardynal, K. J. and Frey, M. D., 2017. Paired sampling standardizes point count data from humans and acoustic recorders. *Avian Conservation and Ecology*, 12(1):13. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPOTZyTXlDb0xFQTA/view?usp=sharing)\n\nYip, D. A., Leston, L., Bayne, E. M., Sólymos, P. and Grover, A., 2017. Experimentally derived detection distances from audio recordings and human observers enable integrated analysis of point count data. *Avian Conservation and Ecology*, 12(1):11. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPQ2F6d1llQ3lPTzg/view?usp=sharing)\n\nSólymos, P., and Lele, S. R., 2016. Revisiting resource selection probability functions and single-visit methods: clarification and extensions. *Methods in Ecology and Evolution*, 7:196-205. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPRE5tVlRMSmhLWmM/view?usp=sharing)\n\nMatsuoka, S. M., Mahon, C. L., Handel, C. M., Sólymos, P., Bayne, E. M., Fontaine, P. C., and Ralph, C. J., 2014. Reviving common standards in point-count surveys for broad inference across studies. *Condor* 116:599-608. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPcGZNS3JSRUlBdDQ/view?usp=sharing)\n\nSólymos, P., Matsuoka, S. M., Bayne, E. M., Lele, S. R., Fontaine, P., Cumming, S. G., Stralberg, D., Schmiegelow, F. K. A. & Song, S. J., 2013. Calibrating indices of avian density from non-standardized survey data: making the most of a messy situation. *Methods in Ecology and Evolution* 4:1047-1058. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPV0RNUFU1N1dmS1E/view?usp=sharing)\n\nMatsuoka, S. M., Bayne, E. M., Sólymos, P., Fontaine, P., Cumming, S. G., Schmiegelow, F. K. A., & Song, S. A., 2012. Using binomial distance-sampling models to estimate the effective detection radius of point-counts surveys across boreal Canada. *Auk* 129:268-282. [PDF](https://drive.google.com/file/d/0B-q59n6LIwYPbFhhRUtZNWQyMk0/view?usp=sharing)\n\n## License\n\nThe course material is licensed under [Attribution-NonCommercial-ShareAlike 4.0 International (CC BY-NC-SA 4.0)](https://creativecommons.org/licenses/by-nc-sa/4.0/) license. Source code is under [MIT](LICENSE) license.\n",
+ "supporting": [],
"filters": [
"rmarkdown/pagebreak.lua"
],
diff --git a/.quarto/_freeze/posts/2021-05-04-building-r-packages/index/execute-results/html.json b/.quarto/_freeze/posts/2021-05-04-building-r-packages/index/execute-results/html.json
index 91de80c..5d646d1 100644
--- a/.quarto/_freeze/posts/2021-05-04-building-r-packages/index/execute-results/html.json
+++ b/.quarto/_freeze/posts/2021-05-04-building-r-packages/index/execute-results/html.json
@@ -1,7 +1,7 @@
{
- "hash": "f9c5cd75754140ed67e59951a6ea480b",
+ "hash": "2759d1707cdb7cd48df6fad351b0353b",
"result": {
- "markdown": "---\ntitle: \"Building R packages\"\ndescription: |\n This practical training will cover the basics of modern package development in R with a focus on the following three aspects: (1) how to turn your code into functions, (2) how to write tests and documentation, and (3) how to share your R package on GitHub..\nauthor: \n - name: \"Andrew MacDonald\"\n affilitation: Université de Sherbrooke\ndate: \"2021-05-04\"\nimage: altumcode-PNbDkQ2DDgM-unsplash.jpeg\ncategories: [Technical, EN]\ntoc: true\nnumber-sections: true\nnumber-depth: 1\n---\n\n\n\n\n\n\n
\n\nR packages! they are kind of like cookies:\n\n- Almost everyone enjoys them\n\n- delicious when homemade\n\n- Lots of storebought options available\n\n- Great skill to have\n\n- not necessary to sell them!\n\n \n\nBut most of all: cookies are delicious for what they *contain*: chocolate chunks, candy, oats, cocoa. However, all cookies share some fundamental ingredients and nearly identical structure. Flour, saturated with fat and sugar hydrated only with an egg, flavoured with vanilla and salt. The basic formula is invariant and admits only slight deviation -- otherwise, it becomes something other than a cookie.\n\nThis workshop is devoted to the study of cookie dough.\n\n### *Mise en place* : development environment\n\nWe'll explore a few useful packages in this workshop. The first two in particular are very popular tools for modern-day R package development:\n\n``` r\ninstall.packages(\"devtools\")\ninstall.packages(\"usethis\")\ninstall.packages(\"testthat\")\ninstall.packages(\"assertthat\")\n```\n\nBuilding an R package also requires specific tools for compiling the finished package. Run the following line to make sure you have the development environment:\n\n``` r\ndevtools::has_devel()\n```\n\nIf you do not have the software to build R packages, you should see a message which will help you find the correct links to download what you need!\n\nWindows will need RTools. First do the check above to see if you are already set up. If not then [download the software here](https://cran.r-project.org/bin/windows/Rtools/).\n\nand Install. After that, open R and run the following:\n\n``` r\nwriteLines('PATH=\"${RTOOLS40_HOME}\\\\usr\\\\bin;${PATH}\"', con = \"~/.Renviron\")\n```\n\nand restart R. Then run the check above once more to confirm\n\n\n\n## The structure: flour and sugar\n\n> No cookies without carbs\n\nAn R package is essentially a folder on your computer with specific structure. We will begin by creating an empty R package and taking a tour!\n\nOpen your R code editor, and find out where you are:\n\n``` r\ngetwd()\n```\n\nThis is to prepare for the next step, where we will choose a location for our R package folder. Please be intentional about where you place your R package! Do not place it in the same space as another package, Rstudio project or other project. Create a new and isolated location for it.\n\nI am working from an existing R project in my typical R Projects folder, so I go up one level:\n\n``` r\nusethis::create_package(\"../netwerk\")\n```\n\n\n\n\n\nLet's run R CMD CHECK right away. We will do this MANY TIMES.\n\n``` r\ndevtools::check()\n```\n\nWe should see some warnings! let's keep these in mind as we continue our tour.\n\n### The DESCRIPTION file\n\nThe most important file to notice is the DESCRIPTION. This gives general information about the entire package. It is written in a specific file format\n\n``` dcf\nPackage: netwerk\nTitle: Werks with Networks\nVersion: 0.0.0.9000\nAuthors@R: \n person(given = \"Andrew\",\n family = \"MacDonald\",\n role = c(\"aut\", \"cre\"),\n email = \"\")\nDescription: it does networks.\nLicense: MIT + file LICENSE\nEncoding: UTF-8\nLazyData: true\nRoxygen: list(markdown = TRUE)\nRoxygenNote: 7.1.1\nSuggests: \n testthat (>= 3.0.0)\nConfig/testthat/edition: 3\n```\n\nHere are some things to edit *manually* in `DESCRIPTION`:\n\n- package name \\[tk naming of R packages\\] -- make it short and convenient if you can!\n- Title: write this part In Title Case. Don't end the title with a period.\n- Description: Describe the package in a short block of text. This *should* end with a period.\n- Authors: Add your name here and the name of anyone building the package with you. `usethis` will have done the first step for you, and filled in the structure. Only \"aut\" (author) and \"cre\" (creator) are essential. [but many others are possible](https://www.loc.gov/marc/relators/relaterm.html)\n\nAdd your name here.\n\nAdd a license\n\n``` r\nusethis::use_mit_license(copyright_holder = \"\")\n```\n\nnote about the different roles that R package authors can have. Funny ones. but creator and maintainer are the key ones.\n\nNote the R folder. We'll get much more into that later\n\n- Rbuildignore\n\n## Keeping notes\n\ncreate an R file\n\n``` r\nusethis::use_build_ignore(\"dev.R\")\n```\n\nthe docs folder\n\nhere we have a very minimal version of an R packages we're going to be adding to it as the course progresses.\n\nOne thing we can do right away is build and check the R package\n\nWhat exactly is happining here? slide from R package tutorial.\n\nLots of checkpoints and progress confrimations along the way.\n\nOK so what is that all about? we have compiled the R package and it has gone to where the R packages on our computer go.\n\nThere is a natural cycle to how the different steps in an R package workflow proceed -- see the documentation for this lesson -- we will be following this process (TK another pictures?\n\nOk so now that we ahve the basic structure, let's talk about some content for the R package. I received the donation of a little R function already that we can use to create this workflow in a nice way\n\nThis R function (explain what the function does)\n\nOK so let's focus on just one part of this function.\n\nload all -- shortcut\n\n> how do we do this in VScode?\n\n> how to add something to the .Rbuildignore? it would be nice to have a little .dev script as a space to create all the ohter dependencies that are involved in making an R package.\n\n\n::: {.cell}\n\n:::\n\n\n## Useful links\n\nThis workshop borrows heavily from some excellent sources:\n\n- the [R packages book](https://r-pkgs.org/index.html) especially the [\"Whole Game\"](https://r-pkgs.org/whole-game.html#whole-game) chapter!\n- [rOpenSci Packages: Development, Maintenance, and Peer Review](https://devguide.ropensci.org/index.html)\n\nhttps://builder.r-hub.io/about.html\n",
+ "markdown": "---\ntitle: \"Building R packages\"\ndescription: |\n This practical training will cover the basics of modern package development in R with a focus on the following three aspects: (1) how to turn your code into functions, (2) how to write tests and documentation, and (3) how to share your R package on GitHub..\nauthor: Andrew MacDonald\ndate: \"2021-05-04\"\nimage: altumcode-PNbDkQ2DDgM-unsplash.jpeg\ncategories: [Technical, EN]\ntoc: true\nnumber-sections: true\nnumber-depth: 1\n---\n\n\n\n\n\n\n
\n\nR packages! they are kind of like cookies:\n\n- Almost everyone enjoys them\n\n- delicious when homemade\n\n- Lots of storebought options available\n\n- Great skill to have\n\n- not necessary to sell them!\n\n \n\nBut most of all: cookies are delicious for what they *contain*: chocolate chunks, candy, oats, cocoa. However, all cookies share some fundamental ingredients and nearly identical structure. Flour, saturated with fat and sugar hydrated only with an egg, flavoured with vanilla and salt. The basic formula is invariant and admits only slight deviation -- otherwise, it becomes something other than a cookie.\n\nThis workshop is devoted to the study of cookie dough.\n\n### *Mise en place* : development environment\n\nWe'll explore a few useful packages in this workshop. The first two in particular are very popular tools for modern-day R package development:\n\n``` r\ninstall.packages(\"devtools\")\ninstall.packages(\"usethis\")\ninstall.packages(\"testthat\")\ninstall.packages(\"assertthat\")\n```\n\nBuilding an R package also requires specific tools for compiling the finished package. Run the following line to make sure you have the development environment:\n\n``` r\ndevtools::has_devel()\n```\n\nIf you do not have the software to build R packages, you should see a message which will help you find the correct links to download what you need!\n\nWindows will need RTools. First do the check above to see if you are already set up. If not then [download the software here](https://cran.r-project.org/bin/windows/Rtools/).\n\nand Install. After that, open R and run the following:\n\n``` r\nwriteLines('PATH=\"${RTOOLS40_HOME}\\\\usr\\\\bin;${PATH}\"', con = \"~/.Renviron\")\n```\n\nand restart R. Then run the check above once more to confirm\n\n\n\n## The structure: flour and sugar\n\n> No cookies without carbs\n\nAn R package is essentially a folder on your computer with specific structure. We will begin by creating an empty R package and taking a tour!\n\nOpen your R code editor, and find out where you are:\n\n``` r\ngetwd()\n```\n\nThis is to prepare for the next step, where we will choose a location for our R package folder. Please be intentional about where you place your R package! Do not place it in the same space as another package, Rstudio project or other project. Create a new and isolated location for it.\n\nI am working from an existing R project in my typical R Projects folder, so I go up one level:\n\n``` r\nusethis::create_package(\"../netwerk\")\n```\n\n\n\n\n\nLet's run R CMD CHECK right away. We will do this MANY TIMES.\n\n``` r\ndevtools::check()\n```\n\nWe should see some warnings! let's keep these in mind as we continue our tour.\n\n### The DESCRIPTION file\n\nThe most important file to notice is the DESCRIPTION. This gives general information about the entire package. It is written in a specific file format\n\n``` dcf\nPackage: netwerk\nTitle: Werks with Networks\nVersion: 0.0.0.9000\nAuthors@R: \n person(given = \"Andrew\",\n family = \"MacDonald\",\n role = c(\"aut\", \"cre\"),\n email = \"\")\nDescription: it does networks.\nLicense: MIT + file LICENSE\nEncoding: UTF-8\nLazyData: true\nRoxygen: list(markdown = TRUE)\nRoxygenNote: 7.1.1\nSuggests: \n testthat (>= 3.0.0)\nConfig/testthat/edition: 3\n```\n\nHere are some things to edit *manually* in `DESCRIPTION`:\n\n- package name \\[tk naming of R packages\\] -- make it short and convenient if you can!\n- Title: write this part In Title Case. Don't end the title with a period.\n- Description: Describe the package in a short block of text. This *should* end with a period.\n- Authors: Add your name here and the name of anyone building the package with you. `usethis` will have done the first step for you, and filled in the structure. Only \"aut\" (author) and \"cre\" (creator) are essential. [but many others are possible](https://www.loc.gov/marc/relators/relaterm.html)\n\nAdd your name here.\n\nAdd a license\n\n``` r\nusethis::use_mit_license(copyright_holder = \"\")\n```\n\nnote about the different roles that R package authors can have. Funny ones. but creator and maintainer are the key ones.\n\nNote the R folder. We'll get much more into that later\n\n- Rbuildignore\n\n## Keeping notes\n\ncreate an R file\n\n``` r\nusethis::use_build_ignore(\"dev.R\")\n```\n\nthe docs folder\n\nhere we have a very minimal version of an R packages we're going to be adding to it as the course progresses.\n\nOne thing we can do right away is build and check the R package\n\nWhat exactly is happining here? slide from R package tutorial.\n\nLots of checkpoints and progress confrimations along the way.\n\nOK so what is that all about? we have compiled the R package and it has gone to where the R packages on our computer go.\n\nThere is a natural cycle to how the different steps in an R package workflow proceed -- see the documentation for this lesson -- we will be following this process (TK another pictures?\n\nOk so now that we ahve the basic structure, let's talk about some content for the R package. I received the donation of a little R function already that we can use to create this workflow in a nice way\n\nThis R function (explain what the function does)\n\nOK so let's focus on just one part of this function.\n\nload all -- shortcut\n\n> how do we do this in VScode?\n\n> how to add something to the .Rbuildignore? it would be nice to have a little .dev script as a space to create all the ohter dependencies that are involved in making an R package.\n\n\n::: {.cell}\n\n:::\n\n\n## Useful links\n\nThis workshop borrows heavily from some excellent sources:\n\n- the [R packages book](https://r-pkgs.org/index.html) especially the [\"Whole Game\"](https://r-pkgs.org/whole-game.html#whole-game) chapter!\n- [rOpenSci Packages: Development, Maintenance, and Peer Review](https://devguide.ropensci.org/index.html)\n\nhttps://builder.r-hub.io/about.html\n",
"supporting": [],
"filters": [
"rmarkdown/pagebreak.lua"
diff --git a/.quarto/_freeze/posts/2021-06-22-introduction-to-shiny-apps/index/execute-results/html.json b/.quarto/_freeze/posts/2021-06-22-introduction-to-shiny-apps/index/execute-results/html.json
index 316242f..7463485 100644
--- a/.quarto/_freeze/posts/2021-06-22-introduction-to-shiny-apps/index/execute-results/html.json
+++ b/.quarto/_freeze/posts/2021-06-22-introduction-to-shiny-apps/index/execute-results/html.json
@@ -1,7 +1,7 @@
{
- "hash": "81821a688a1a06601deacad615689703",
+ "hash": "0731d9bc5af487d5bd597e0159bdd54a",
"result": {
- "markdown": "---\ntitle: \"Introduction to Shiny Apps\"\ndescription: \"Introduction to interactive app development with R Shiny.\"\nauthor:\n - name: \"Katherine Hébert\"\n affiliation: Université de Sherbrooke\n - name: \"Andrew MacDonald\"\n affiliation: Université de Sherbrooke\n - name: \"Jake Lawlor\"\n affiliation: McGill University\n - name: \"Vincent Bellavance\"\n affiliation: Université de Sherbrooke\ndate: \"06-22-2021\"\nimage: image.jpg\ncategories: [Technical, Fellow contributed, EN]\ntoc: true\nnumber-sections: true\nnumber-depth: 1\n---\n\n\n\n\n## Why do you want to use Shiny?\n\nThere are many reasons to consider using Shiny for a project:\n\n- Sharing results from a paper with your readers;\n- Helping you explore a model, mathematics, simulations;\n- Letting non R users use R.\n\n## Hello Shiny!\n\nHere is an example of a Shiny app that RStudio generates when you open a new Shiny Web App file:\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Define UI for app that draws a histogram ----\nui <- fluidPage(\n\n # App title ----\n titlePanel(\"Hello Shiny!\"),\n\n # Sidebar layout with input and output definitions ----\n sidebarLayout(\n\n # Sidebar panel for inputs ----\n sidebarPanel(\n\n # Input: Slider for the number of bins ----\n sliderInput(inputId = \"bins\",\n label = \"Number of bins:\",\n min = 1,\n max = 50,\n value = 30)\n\n ),\n\n # Main panel for displaying outputs ----\n mainPanel(\n\n # Output: Histogram ----\n plotOutput(outputId = \"distPlot\")\n\n )\n )\n)\n```\n:::\n\n\n# How a Shiny app works\n\n## Building blocks\n\nWe've now seen the basic building blocks of a Shiny app:\n\n- The **user interface**, which determines how the app \"looks\". This is how we tell Shiny where to ask for user inputs, and where to put any outputs we create.\n- **Reactive values**, which are values that change according to user inputs. These are values that affect the outputs we create in the Shiny app, such as tables or plots.\n- The **server**, where we use reactive values to generate some outputs.\n\n### IDs\n\nThe **user interface** and **server** communicate through IDs that we assign to inputs from the user and outputs from the server.\n\n\n\nWe use an ID (*in orange*) to link the user input in the UI to the reactive values used in the server:\n\n\n\nWe use another ID (*in blue*) to link the output created in the server to the output shown in the user interface:\n\n\n\n### Organisation\n\nThese elements can all be placed in one script named `app.R` or separately in scripts named `ui.R` and `server.R`. The choice is up to you, although it becomes easier to work in separate `ui.R` and `server.R` scripts when the Shiny app becomes more complex.\n\n**Example 1: Everything in `app.R`**\n\n **Example 2: Split things into `ui.R` and `server.R`**\n\n\n\n## Plots\n\nShiny is an excellent tool for visual exploration - it is at its most useful when a user can *see* something change before their eyes according to some selections. This is a great way to allow users to explore a dataset, explore the results of some analyses according to different parameters, and so on!\n\nLet's now add a plot to our Shiny app, to visualize the distribution of a variable depending on user input. We'll be adding the `ggplot2` and `ggridges` packages in the set-up step at the top of our `app.R` to allow us to make a plot.\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# load packages\nlibrary(shiny)\nlibrary(ggridges)\nlibrary(ggplot2)\nlibrary(here)\nlibrary(readr)\n```\n:::\n\n\n### User interface\n\nTo add a plot in our Shiny, we need to indicate where the plot should appear in the app. We can do this with `plotOutput()`, a similar function to `tableOutput()` in the previous section that is meant for plot outputs, as the name suggests.\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Define UI for application that makes a table andplots the Volcano Explosivity \n# Index for the most eruptive volcanoes within a selected range of years\n\nui <- fluidPage(\n \n # Application title ----\n \n titlePanel(\"Exploring volcano explosivity\"),\n \n # Input interface ----\n \n sidebarLayout(\n sidebarPanel(\n \n # Sidebar with a slider range input\n sliderInput(\"years\", # the id your server needs to use the selected value\n label = h3(\"Years\"),\n min = 1900, max = 2020, # maximum range that can be selected\n value = c(2010, 2020) # this is the default slider position\n )\n )\n ),\n \n # Show the outputs from the server ---------------\n mainPanel(\n \n # Show a ridgeplot of explosivity index for selected volcanoes\n plotOutput(\"ridgePlot\"),\n \n # then, show the table we made in the previous step\n tableOutput(\"erupt_table\")\n \n )\n)\n```\n:::\n\n\nNow our Shiny app knows where we want to place our plot.\n\n### Server\n\nWe now need to create the plot we want to show in our app. This plot will change depending on one or several reactive values that the user can input or select in our UI.\n\nWe link the UI and server together with IDs that are assigned to each object. Above, we told the UI to expect a plot output with the ID `\"ridgePlot\"`. In the server, we will create a plot and render it as a plot object using `renderPlot()`, and we will assign this plot output to the ID we call in the UI (as `output$ridgePlot`).\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Define server logic required to make your output(s)\nserver <- function(input, output) {\n\n \n # prepare the data\n # ----------------------------------------------------------\n \n # read the dataset\n eruptions <- readr::read_rds(here::here(\"data\", \"eruptions.rds\"))\n \n # filter the dataset to avoid overloading the plot \n eruptions <- eruptions[which(eruptions$volcano_name %in% names(which(table(eruptions$volcano_name) > 30))),]\n # this subsets to volcanoes that have erupted more than 30 times\n \n \n # make reactive dataset\n # ----------------------------------------------------------\n \n # subset volcano data with input year range\n eruptions_filtered <- reactive({\n subset(eruptions, start_year >= input$years[1] & end_year <= input$years[2])\n })\n \n \n # create and render the outputs\n # ----------------------------------------------------------\n \n # create the table of volcanoes\n output$erupt_table <- renderTable({\n head(eruptions_filtered())\n })\n \n # render the plot output\n output$ridgePlot <- renderPlot({\n \n # create the plot\n ggplot(data = eruptions_filtered(),\n aes(x = vei,\n y = volcano_name,\n fill = volcano_name)) +\n # we are using a ridgeplot geom here, from the ggridges package\n geom_density_ridges( size = .5) + # line width\n \n # label the axes\n labs(x = \"Volcano Explosivity Index\", y = \"\") +\n \n # adjust the ggplot theme to make the plot \"prettier\"\n theme_classic() + \n theme(legend.position = \"none\",\n axis.text = element_text(size = 12, face = \"bold\"),\n axis.title = element_text(size = 14, face = \"bold\"))\n })\n}\n```\n:::\n\n\n### The Shiny app\n\nNow, if we run the Shiny app, we have a plot above the table we made previously. They are positioned in this way because the `plotOutput()` comes before the `tableOutput()` in the UI.\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Run the application\nshinyApp(ui = ui, server = server)\n```\n:::\n\n\n\n\n## Customising the theme\n\nIf you'd like to go one step further, you can also customize the appearance of your Shiny app using built-in themes, or creating your own themes.\n\n### Using built-in themes\n\nThere are several built-in themes in Shiny, which allow you to quickly change the appearance of your app. You can browse a gallery of available themes here [here](https://rstudio.github.io/shinythemes/), or test themes out interactively [here](https://shiny.rstudio.com/gallery/shiny-theme-selector.html).\n\nLet's try the *darkly* theme on our Shiny app. To do this, we will need the `shinythemes` package.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlibrary(shinythemes)\n```\n:::\n\n\nWe can change the theme of our previous app with one line of code:\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Define UI for application that makes a table andplots the Volcano Explosivity \n# Index for the most eruptive volcanoes within a selected range of years\n\nui <- fluidPage(\n \n # Application title ----\n \n titlePanel(\"Exploring volcano explosivity\"),\n \n # Input interface ----\n \n sidebarLayout(\n sidebarPanel(\n \n # Sidebar with a slider range input\n sliderInput(\"years\", # the id your server needs to use the selected value\n label = h3(\"Years\"),\n min = 1900, max = 2020, # maximum range that can be selected\n value = c(2010, 2020) # this is the default slider position\n )\n )\n ),\n \n # Show the outputs from the server ---------------\n mainPanel(\n \n # Show a ridgeplot of explosivity index for selected volcanoes\n plotOutput(\"ridgePlot\"),\n \n # then, show the table we made in the previous step\n tableOutput(\"erupt_table\")\n \n ),\n \n # Customize the theme ----------------------\n \n # Use the darkly theme\n theme = shinythemes::shinytheme(\"darkly\")\n)\n```\n:::\n\n\nNow, if we run the app, it looks a little different:\n\n\n\n### Using a custom theme\n\nYou can also go beyond the built-in themes, and create your own custom theme with the fonts and colours of your choice. You can also apply this theme to the outputs rendered in the app, to bring all the visuals together for a more cohesive look.\n\n#### Customizing a theme\n\nTo create a custom theme, we will be using the `bs_theme()` function from the `bslib` package.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlibrary(bslib)\n```\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\n# Create a custom theme \ncute_theme <- bslib::bs_theme(\n \n bg = \"#36393B\", # background colour\n fg = \"#FFD166\", # most of the text on your app\n primary = \"#F26430\", # buttons, ...\n \n # you can also choose fonts\n base_font = font_google(\"Open Sans\"),\n heading_font = font_google(\"Open Sans\")\n)\n```\n:::\n\n\nTo apply this theme to our Shiny app (and the outputs), we will be using the `thematic` package.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlibrary(thematic)\n```\n:::\n\n\nThere are two essential steps to apply a custom theme to a Shiny app:\n\n1. Activating thematic.\n2. Setting the user interface's theme to the custom theme (`cute_theme`).\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Activate thematic\n# so your R outputs will be changed to match up with your chosen styling\nthematic::thematic_shiny()\n\n# Define UI for application that makes a table andplots the Volcano Explosivity \n# Index for the most eruptive volcanoes within a selected range of years\n\nui <- fluidPage(\n \n # Application title ----\n \n titlePanel(\"Exploring volcano explosivity\"),\n \n # Input interface ----\n \n sidebarLayout(\n sidebarPanel(\n \n # Sidebar with a slider range input\n sliderInput(\"years\", # the id your server needs to use the selected value\n label = h3(\"Years\"),\n min = 1900, max = 2020, # maximum range that can be selected\n value = c(2010, 2020) # this is the default slider position\n )\n )\n ),\n \n # Show the outputs from the server ---------------\n mainPanel(\n \n # Show a ridgeplot of explosivity index for selected volcanoes\n plotOutput(\"ridgePlot\"),\n \n # then, show the table we made in the previous step\n tableOutput(\"erupt_table\")\n \n ),\n \n # Customize the theme ----------------------\n \n # Use our custom theme\n theme = cute_theme\n)\n```\n:::\n\n\nNow, if we run the app, the user interface and plot theme is set to the colours and fonts we set in `cute_theme`:\n\n\n\nHere, `thematic` is not changing the colours used to represent a variable in our plot, because this is an informative colour scale (unlike the colour of axis labels, lines, and the plot background). However, if we remove this colour variable in our ridgeplot in the server, thematic will change the plot colours as well. Here is a simplified example of our server to see what these changes would look like:\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Define server logic required to make your output(s)\nserver <- function(input, output) {\n \n #... (all the good stuff we wrote above)\n \n # render the plot output\n output$ridgePlot <- renderPlot({\n \n # create the plot\n ggplot(data = eruptions_filtered(),\n aes(x = vei,\n y = volcano_name)) + # we are no longer setting \n # the fill argument to a variable\n \n # we are using a ridgeplot geom here, from the ggridges package\n geom_density_ridges(size = .5) + \n \n # label the axes\n labs(x = \"Volcano Explosivity Index\", y = \"\") +\n \n # remove the \"classic\" ggplot2 so it doesn't override thematic's changes\n # theme_classic() + \n theme(legend.position = \"none\",\n axis.text = element_text(size = 12, face = \"bold\"),\n axis.title = element_text(size = 14, face = \"bold\"))\n })\n }\n```\n:::\n\n\nNow, our plot's theme follows the app's custom theme as well:\n\n\n\n# Constructing a Shiny app using shinyDashboards\n\n## Taking advantage of good defaults\n\nHere, we will use shiny extension `shinyDashboards` and `leaflet` to construct a custom Shiny App to map volcanoes of the world. First, we need a few additional packages.\n\n**Note: All Source code for this app can be found [here](https://github.com/bios2/shiny_day_2/tree/main/Jake_volcano_map/Volcano_Leaflet) on the BIOS2 Github.**\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# load packages\nlibrary(shiny)\nlibrary(shinydashboard) # dashboard layout package\nlibrary(shinyWidgets) # fancy widgets package\nlibrary(leaflet) # interactive maps package\nlibrary(dplyr)\nlibrary(ggplot2)\n```\n:::\n\n\n### Using ShinyDashboard\n\nWe will create our app using defaults from the ShinyDashboard package, which always includes three main components: a header, using `dashboardHeader()`, a sidebar, using `dashboardSidebar()`, and a body, using `dashboardBody()`. These are then added together using the `dashboardPage()` function.\n\nBuilding these elements is less like usual R coding, and more like web design, since we are, in fact, designing a unser interface for a web app. Here, we'll make a basic layout before populating it.\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# create the header of our app\nheader <- dashboardHeader(\n title = \"Exploring Volcanoes of the World\",\n titleWidth = 350 # since we have a long title, we need to extend width element in pixels\n)\n\n\n# create dashboard body - this is the major UI element\nbody <- dashboardBody(\n\n # make first row of elements (actually, this will be the only row)\n fluidRow(\n \n # make first column, 25% of page - width = 3 of 12 columns\n column(width = 3,\n \n \n # Box 1: text explaining what this app is\n #-----------------------------------------------\n box( width = NULL,\n status=\"primary\", # this line can change the automatic color of the box.\n title = NULL,\n p(\"here, we'll include some info about this app\")\n\n \n ), # end box 1\n \n \n # box 2 : input for selecting volcano type\n #-----------------------------------------------\n box(width = NULL, status = \"primary\",\n title = \"Selection Criteria\", solidHeader = T, \n \n p(\"here, we'll add a UI element for selecting volcano types\"),\n\n ), # end box 2\n \n \n \n # box 3: ggplot of selected volcanoes by continent\n #------------------------------------------------\n box(width = NULL, status = \"primary\",\n solidHeader = TRUE, collapsible = T,\n title = \"Volcanoes by Continent\",\n p(\"here, we'll add a bar plot of volcanoes in each continent\")\n ) # end box 3\n \n ), # end column 1\n \n # second column - 75% of page (9 of 12 columns)\n #--------------------------------------------------\n column(width = 9,\n # Box 4: leaflet map\n box(width = NULL, background = \"light-blue\", height = 850,\n p(\"here, we'll show volcanoes on a map\"),\n ) # end box with map\n ) # end second column\n \n ) # end fluidrow\n) # end body\n\n\n# add elements together\ndashboardPage(\n skin = \"blue\",\n header = header,\n sidebar = dashboardSidebar(disable = TRUE), # here, we only have one tab of our app, so we don't need a sidebar\n body = body\n)\n```\n:::\n\n\n\n\n## Populating the Layout\n\nNow, we are going to fill out app with elements. In this app, we will only have one user input: a selection of the volcano type to show. We will use this input (`input$volcano_type`), which will be used to filter data in the server (i.e. make a smaller dataset using only volcanoes of the selected types), then use this filtered dataset to create output elements (plots and maps).\n\nBelow, we show the necessary code to include in both the UI and the Server to create each plot element. Notice that after the reactive value `selected_volcanoes` is created in the selection box, this is the only object that is used to create the other elements in the app.\n\n| Location | Element | UI | Server |\n|:----------------|:----------------|:------------------|:------------------|\n| Box 1 | **Intro Textbox** | Markdown/HTML text code | |\n| Box 2 | **Selection Wigets** | `checkboxGroupButtons(` `inputID = \"volcano_type\")` | `selected_volcanoes <- reactive({` `volcano_df %>% filter(type %in% input$volcano_type)})` to create a filtered dataset that will react to user input |\n| Box 3 | **Bar Graph** | `plotOutput(\"continentplot\")` | `output$continentplot <- renderPlot(...))` which will plot from the `selectied_volcanoes` reactive object |\n| Box 4 | **Leaflet Map** | `leafletOutput(\"volcanomap\")` | `output$volcanomap <- renderLeaflet(...)` to map points from the `selectied_volcanoes` reactive object |\n\n\n\n## Challenge!\n\nUse the code provided to add your own additional user input to the Shiny App. The code (which you can access [here](https://github.com/bios2/shiny_day_2/tree/main/Jake_volcano_map/Volcano_Leaflet) leaves a space for an additional UI input inside box 2). Then, you'll need to use your new input element to the reactive value in the Server, as noted in the server code.\n\nUse the [Default Shiny Widgets](https://shiny.rstudio.com/gallery/widget-gallery.html) or [shinyWidgets extended package](http://shinyapps.dreamrs.fr/shinyWidgets/) galleries to explore the types of elements you can add.\n\n\n\n### See the completed app\n\nSee our completed app [HERE](https://jakelawlor.shinyapps.io/Volcanoes_of_the_World/)\n\n# Constructing a Shiny app using Golem\n\nFirst step is creating your own golem project:\n\n\n\nGolem provides you with some very helpful \"workflow\" scripts:\n\nEdit the Description by filling in this function in `01_dev.R`\n\nThen, add all the dependencies\n\nTogether, this edits the `DESCRIPTION` of your R package to look something like this:\n\nNow we can start building the app.\n\n\n::: {.cell}\n\n```{.r .cell-code}\napp_ui <- function(request) {\n tagList(\n # Leave this function for adding external resources\n golem_add_external_resources(),\n # Your application UI logic \n shinydashboard::dashboardPage(\n header = shinydashboard::dashboardHeader(\n title = \"Exploring Volcanoes of the World\",\n titleWidth = 350 # since we have a long title, we need to extend width element in pixels\n ),\n sidebar = shinydashboard::dashboardSidebar(disable = TRUE), # here, we only have one tab, so we don't need a sidebar\n body = shinydashboard::dashboardBody(\n # make first row of elements (actually, this will be the only row)\n fluidRow(\n # make first column, 25% of page - width = 3 of 12 colums\n column(width = 3,\n # box 1 : input for selecting volcano type\n #-----------------------------------------------\n shinydashboard::box(width = NULL, status = \"primary\",\n title = \"Selection Criteria\", solidHeader = T\n \n ## CHECKBOX HERE\n \n ), # end box 1\n # box 2: ggplot of selected volcanoes by continent\n #------------------------------------------------\n shinydashboard::box(width = NULL, status = \"primary\",\n solidHeader = TRUE, collapsible = T,\n title = \"Volcanoes by Continent\"\n \n ## PLOT HERE\n\n ) # end box 2\n ), # end column 1\n \n # second column - 75% of page (9 of 12 columns)\n column(width = 9,\n \n # Box 3: leaflet map\n shinydashboard::box(width = NULL, background = \"light-blue\"\n \n ## MAP HERE \n \n ) # end box with map\n ) # end second column\n ) # end fluidrow\n ) # end body\n )\n )\n}\n```\n:::\n\n\nThis indicates where each of the three components of the app would go.\n\nAt this point we can run the app to get a very empty-looking UI:\n\n\n\n### Golem modules\n\nWe could split this app into three different sections, corresponding to each of the three boxes:\n\n1. Filter the type of volcano we see\n2. take the filtered volcanoes and plot a stacked bar chart\n3. take the filtered volcanoes and plot a map\n\n### Selecting the volcanoes\n\n\n::: {.cell}\n\n```{.r .cell-code}\n#' volcano_select UI Function\n#'\n#' @description A shiny Module.\n#'\n#' @param id,input,output,session Internal parameters for {shiny}.\n#'\n#' @noRd \n#'\n#' @importFrom shiny NS tagList \nmod_volcano_select_ui <- function(id){\n ns <- NS(id)\n tagList(\n # Widget specifying the species to be included on the plot\n shinyWidgets::checkboxGroupButtons(\n inputId = ns(\"volcano_type\"),\n label = \"Volcano Type\",\n choices = c(\"Stratovolcano\" , \"Shield\" ,\"Cone\" , \"Caldera\" , \"Volcanic Field\",\n \"Complex\" , \"Other\", \"Lava Dome\" , \"Submarine\" ),\n checkIcon = list(\n yes = tags$i(class = \"fa fa-check-square\", \n style = \"color: steelblue\"),\n no = tags$i(class = \"fa fa-square-o\", \n style = \"color: steelblue\"))\n ) # end checkboxGroupButtons\n )\n}\n \n#' volcano_select Server Functions\n#'\n#' @noRd \nmod_volcano_select_server <- function(id, volcano){\n moduleServer( id, function(input, output, session){\n ns <- session$ns\n \n # make reactive dataset\n # ------------------------------------------------\n # Make a subset of the data as a reactive value\n # this subset pulls volcano rows only in the selected types of volcano\n selected_volcanoes <- reactive({\n \n req(input$volcano_type)\n \n volcano %>%\n \n # select only volcanoes in the selected volcano type (by checkboxes in the UI)\n dplyr::filter(volcano_type_consolidated %in% input$volcano_type) %>%\n # Space to add your suggested filter here!! \n # --- --- --- --- --- --- --- --- --- --- --- --- ---\n # filter() %>%\n # --- --- --- --- --- --- --- --- --- --- --- --- ---\n # change volcano type into factor (this makes plotting it more consistent)\n dplyr::mutate(volcano_type_consolidated = factor(volcano_type_consolidated,\n levels = c(\"Stratovolcano\" , \"Shield\", \"Cone\", \"Caldera\", \"Volcanic Field\",\n \"Complex\" , \"Other\" , \"Lava Dome\" , \"Submarine\" ) ) )\n })\n \n })\n}\n \n## To be copied in the UI\n# mod_volcano_select_ui(\"volcano_select_1\")\n \n## To be copied in the server\n# mod_volcano_select_server(\"volcano_select_1\")\n```\n:::\n\n\nI also like to test my modules by using them to create a toy Shiny app. The best place to do this is by using a testthat directory. This is another great advantage of using a package workflow. You can set this up easily with `usethis::use_test()`: just run `usethis::use_test` from the R console when you have the module open.\n\nThen write a simple test like this\n\n\n::: {.cell}\n\n```{.r .cell-code}\ntest_that(\"volcano selection module works\", {\n \n testthat::skip_if_not(interactive())\n \n \n ui <- fluidPage(\n ## To be copied in the UI\n mod_volcano_select_ui(\"volcano_select_1\"),\n tableOutput(\"table\")\n )\n \n server <- function(input, output) {\n ## To be copied in the server\n volcano_data <- readRDS(\"data/volcanoes.rds\")\n selected_data <- mod_volcano_select_server(\"volcano_select_1\",\n volcano = volcano_data)\n \n output$table <- renderTable(selected_data())\n }\n \n shinyApp(ui = ui, server = server)\n \n})\n```\n:::\n\n\nWhich generates the following simple app:\n\n\n\n### Barplot of continents\n\n\n::: {.cell}\n\n```{.r .cell-code}\n#' continentplot UI Function\n#'\n#' @description A shiny Module.\n#'\n#' @param id,input,output,session Internal parameters for {shiny}.\n#'\n#' @noRd \n#'\n#' @importFrom shiny NS tagList \nmod_continentplot_ui <- function(id){\n ns <- NS(id)\n tagList(\n plotOutput(ns(\"barplot\"), # this calls to object continentplot that is made in the server page\n height = 350)\n )\n}\n \n#' continentplot Server Functions\n#'\n#' @noRd \nmod_continentplot_server <- function(id, volcano, selected_volcanoes){\n \n # kind of helpful\n stopifnot(is.reactive(selected_volcanoes))\n \n moduleServer( id, function(input, output, session){\n ns <- session$ns\n \n output$barplot <- renderPlot({\n \n # create basic barplot\n barplot <- ggplot2::ggplot(data = volcano,\n ggplot2::aes(x=continent,\n fill = volcano_type_consolidated))+\n # update theme and axis labels:\n ggplot2::theme_bw()+\n ggplot2::theme(plot.background = ggplot2::element_rect(color=\"transparent\",fill = \"transparent\"),\n panel.background = ggplot2::element_rect(color=\"transparent\",fill=\"transparent\"),\n panel.border = ggplot2::element_rect(color=\"transparent\",fill=\"transparent\"))+\n ggplot2::labs(x=NULL, y=NULL, title = NULL) +\n ggplot2::theme(axis.text.x = ggplot2::element_text(angle=45,hjust=1))\n \n \n # IF a selected_volcanoes() object exists, update the blank ggplot. \n # basically this makes it not mess up when nothing is selected\n \n barplot <- barplot +\n ggplot2::geom_bar(data = selected_volcanoes(), show.legend = F) +\n ggplot2::scale_fill_manual(values = RColorBrewer::brewer.pal(9,\"Set1\"), drop=F) +\n ggplot2::scale_x_discrete(drop=F)\n \n \n # print the plot\n barplot\n \n }) # end renderplot command\n \n \n })\n}\n \n## To be copied in the UI\n# mod_continentplot_ui(\"continentplot_1\")\n \n## To be copied in the server\n# mod_continentplot_server(\"continentplot_1\")\n```\n:::\n\n\nthe test\n\n\n::: {.cell}\n\n```{.r .cell-code}\ntest_that(\"volano barplot works\", {\n \n testthat::skip_if_not(interactive())\n \n \n ui <- fluidPage(\n ## To be copied in the UI\n mod_continentplot_ui(\"continentplot_1\"),\n tableOutput(\"table\")\n )\n \n server <- function(input, output) {\n ## To be copied in the server\n volcano_data <- readRDS(\"data/volcanoes.rds\")\n volcano_recent <- subset(volcano_data, last_eruption_year > 2000)\n mod_continentplot_server(\"continentplot_1\",\n volcano = volcano_data,\n selected_volcanoes = reactive(volcano_recent))\n }\n \n shinyApp(ui = ui, server = server)\n})\n```\n:::\n",
+ "markdown": "---\ntitle: \"Introduction to Shiny Apps\"\ndescription: |\n Introduction to interactive app development with R Shiny. \nauthor:\n - name: Katherine Hébert\n - name: Andrew MacDonald\n - name: Jake Lawlor\n - name: Vincent Bellevance\ndate: \"06-22-2021\"\nimage: image.jpg\ncategories: [Technical, Fellow contributed, EN]\ntoc: true\nnumber-sections: true\nnumber-depth: 1\n---\n\n\n\n\n## Why do you want to use Shiny?\n\nThere are many reasons to consider using Shiny for a project:\n\n- Sharing results from a paper with your readers;\n- Helping you explore a model, mathematics, simulations;\n- Letting non R users use R.\n\n## Hello Shiny!\n\nHere is an example of a Shiny app that RStudio generates when you open a new Shiny Web App file:\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Define UI for app that draws a histogram ----\nui <- fluidPage(\n\n # App title ----\n titlePanel(\"Hello Shiny!\"),\n\n # Sidebar layout with input and output definitions ----\n sidebarLayout(\n\n # Sidebar panel for inputs ----\n sidebarPanel(\n\n # Input: Slider for the number of bins ----\n sliderInput(inputId = \"bins\",\n label = \"Number of bins:\",\n min = 1,\n max = 50,\n value = 30)\n\n ),\n\n # Main panel for displaying outputs ----\n mainPanel(\n\n # Output: Histogram ----\n plotOutput(outputId = \"distPlot\")\n\n )\n )\n)\n```\n:::\n\n\n\n# How a Shiny app works\n\n## Building blocks\n\nWe've now seen the basic building blocks of a Shiny app:\n\n- The **user interface**, which determines how the app \"looks\". This is how we tell Shiny where to ask for user inputs, and where to put any outputs we create.\n- **Reactive values**, which are values that change according to user inputs. These are values that affect the outputs we create in the Shiny app, such as tables or plots.\n- The **server**, where we use reactive values to generate some outputs.\n\n### IDs\n\nThe **user interface** and **server** communicate through IDs that we assign to inputs from the user and outputs from the server.\n\n\n\nWe use an ID (*in orange*) to link the user input in the UI to the reactive values used in the server:\n\n\n\nWe use another ID (*in blue*) to link the output created in the server to the output shown in the user interface:\n\n\n\n### Organisation\n\nThese elements can all be placed in one script named `app.R` or separately in scripts named `ui.R` and `server.R`. The choice is up to you, although it becomes easier to work in separate `ui.R` and `server.R` scripts when the Shiny app becomes more complex.\n\n**Example 1: Everything in `app.R`**\n\n **Example 2: Split things into `ui.R` and `server.R`**\n\n\n\n## Plots\n\nShiny is an excellent tool for visual exploration - it is at its most useful when a user can *see* something change before their eyes according to some selections. This is a great way to allow users to explore a dataset, explore the results of some analyses according to different parameters, and so on!\n\nLet's now add a plot to our Shiny app, to visualize the distribution of a variable depending on user input. We'll be adding the `ggplot2` and `ggridges` packages in the set-up step at the top of our `app.R` to allow us to make a plot.\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# load packages\nlibrary(shiny)\nlibrary(ggridges)\nlibrary(ggplot2)\nlibrary(here)\nlibrary(readr)\n```\n:::\n\n\n### User interface\n\nTo add a plot in our Shiny, we need to indicate where the plot should appear in the app. We can do this with `plotOutput()`, a similar function to `tableOutput()` in the previous section that is meant for plot outputs, as the name suggests.\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Define UI for application that makes a table andplots the Volcano Explosivity \n# Index for the most eruptive volcanoes within a selected range of years\n\nui <- fluidPage(\n \n # Application title ----\n \n titlePanel(\"Exploring volcano explosivity\"),\n \n # Input interface ----\n \n sidebarLayout(\n sidebarPanel(\n \n # Sidebar with a slider range input\n sliderInput(\"years\", # the id your server needs to use the selected value\n label = h3(\"Years\"),\n min = 1900, max = 2020, # maximum range that can be selected\n value = c(2010, 2020) # this is the default slider position\n )\n )\n ),\n \n # Show the outputs from the server ---------------\n mainPanel(\n \n # Show a ridgeplot of explosivity index for selected volcanoes\n plotOutput(\"ridgePlot\"),\n \n # then, show the table we made in the previous step\n tableOutput(\"erupt_table\")\n \n )\n)\n```\n:::\n\n\nNow our Shiny app knows where we want to place our plot.\n\n### Server\n\nWe now need to create the plot we want to show in our app. This plot will change depending on one or several reactive values that the user can input or select in our UI.\n\nWe link the UI and server together with IDs that are assigned to each object. Above, we told the UI to expect a plot output with the ID `\"ridgePlot\"`. In the server, we will create a plot and render it as a plot object using `renderPlot()`, and we will assign this plot output to the ID we call in the UI (as `output$ridgePlot`).\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Define server logic required to make your output(s)\nserver <- function(input, output) {\n\n \n # prepare the data\n # ----------------------------------------------------------\n \n # read the dataset\n eruptions <- readr::read_rds(here::here(\"data\", \"eruptions.rds\"))\n \n # filter the dataset to avoid overloading the plot \n eruptions <- eruptions[which(eruptions$volcano_name %in% names(which(table(eruptions$volcano_name) > 30))),]\n # this subsets to volcanoes that have erupted more than 30 times\n \n \n # make reactive dataset\n # ----------------------------------------------------------\n \n # subset volcano data with input year range\n eruptions_filtered <- reactive({\n subset(eruptions, start_year >= input$years[1] & end_year <= input$years[2])\n })\n \n \n # create and render the outputs\n # ----------------------------------------------------------\n \n # create the table of volcanoes\n output$erupt_table <- renderTable({\n head(eruptions_filtered())\n })\n \n # render the plot output\n output$ridgePlot <- renderPlot({\n \n # create the plot\n ggplot(data = eruptions_filtered(),\n aes(x = vei,\n y = volcano_name,\n fill = volcano_name)) +\n # we are using a ridgeplot geom here, from the ggridges package\n geom_density_ridges( size = .5) + # line width\n \n # label the axes\n labs(x = \"Volcano Explosivity Index\", y = \"\") +\n \n # adjust the ggplot theme to make the plot \"prettier\"\n theme_classic() + \n theme(legend.position = \"none\",\n axis.text = element_text(size = 12, face = \"bold\"),\n axis.title = element_text(size = 14, face = \"bold\"))\n })\n}\n```\n:::\n\n\n### The Shiny app\n\nNow, if we run the Shiny app, we have a plot above the table we made previously. They are positioned in this way because the `plotOutput()` comes before the `tableOutput()` in the UI.\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Run the application\nshinyApp(ui = ui, server = server)\n```\n:::\n\n\n\n\n## Customising the theme\n\nIf you'd like to go one step further, you can also customize the appearance of your Shiny app using built-in themes, or creating your own themes.\n\n### Using built-in themes\n\nThere are several built-in themes in Shiny, which allow you to quickly change the appearance of your app. You can browse a gallery of available themes here [here](https://rstudio.github.io/shinythemes/), or test themes out interactively [here](https://shiny.rstudio.com/gallery/shiny-theme-selector.html).\n\nLet's try the *darkly* theme on our Shiny app. To do this, we will need the `shinythemes` package.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlibrary(shinythemes)\n```\n:::\n\n\nWe can change the theme of our previous app with one line of code:\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Define UI for application that makes a table andplots the Volcano Explosivity \n# Index for the most eruptive volcanoes within a selected range of years\n\nui <- fluidPage(\n \n # Application title ----\n \n titlePanel(\"Exploring volcano explosivity\"),\n \n # Input interface ----\n \n sidebarLayout(\n sidebarPanel(\n \n # Sidebar with a slider range input\n sliderInput(\"years\", # the id your server needs to use the selected value\n label = h3(\"Years\"),\n min = 1900, max = 2020, # maximum range that can be selected\n value = c(2010, 2020) # this is the default slider position\n )\n )\n ),\n \n # Show the outputs from the server ---------------\n mainPanel(\n \n # Show a ridgeplot of explosivity index for selected volcanoes\n plotOutput(\"ridgePlot\"),\n \n # then, show the table we made in the previous step\n tableOutput(\"erupt_table\")\n \n ),\n \n # Customize the theme ----------------------\n \n # Use the darkly theme\n theme = shinythemes::shinytheme(\"darkly\")\n)\n```\n:::\n\n\nNow, if we run the app, it looks a little different:\n\n\n\n### Using a custom theme\n\nYou can also go beyond the built-in themes, and create your own custom theme with the fonts and colours of your choice. You can also apply this theme to the outputs rendered in the app, to bring all the visuals together for a more cohesive look.\n\n#### Customizing a theme\n\nTo create a custom theme, we will be using the `bs_theme()` function from the `bslib` package.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlibrary(bslib)\n```\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\n# Create a custom theme \ncute_theme <- bslib::bs_theme(\n \n bg = \"#36393B\", # background colour\n fg = \"#FFD166\", # most of the text on your app\n primary = \"#F26430\", # buttons, ...\n \n # you can also choose fonts\n base_font = font_google(\"Open Sans\"),\n heading_font = font_google(\"Open Sans\")\n)\n```\n:::\n\n\nTo apply this theme to our Shiny app (and the outputs), we will be using the `thematic` package.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlibrary(thematic)\n```\n:::\n\n\nThere are two essential steps to apply a custom theme to a Shiny app:\n\n1. Activating thematic.\n2. Setting the user interface's theme to the custom theme (`cute_theme`).\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Activate thematic\n# so your R outputs will be changed to match up with your chosen styling\nthematic::thematic_shiny()\n\n# Define UI for application that makes a table andplots the Volcano Explosivity \n# Index for the most eruptive volcanoes within a selected range of years\n\nui <- fluidPage(\n \n # Application title ----\n \n titlePanel(\"Exploring volcano explosivity\"),\n \n # Input interface ----\n \n sidebarLayout(\n sidebarPanel(\n \n # Sidebar with a slider range input\n sliderInput(\"years\", # the id your server needs to use the selected value\n label = h3(\"Years\"),\n min = 1900, max = 2020, # maximum range that can be selected\n value = c(2010, 2020) # this is the default slider position\n )\n )\n ),\n \n # Show the outputs from the server ---------------\n mainPanel(\n \n # Show a ridgeplot of explosivity index for selected volcanoes\n plotOutput(\"ridgePlot\"),\n \n # then, show the table we made in the previous step\n tableOutput(\"erupt_table\")\n \n ),\n \n # Customize the theme ----------------------\n \n # Use our custom theme\n theme = cute_theme\n)\n```\n:::\n\n\nNow, if we run the app, the user interface and plot theme is set to the colours and fonts we set in `cute_theme`:\n\n\n\nHere, `thematic` is not changing the colours used to represent a variable in our plot, because this is an informative colour scale (unlike the colour of axis labels, lines, and the plot background). However, if we remove this colour variable in our ridgeplot in the server, thematic will change the plot colours as well. Here is a simplified example of our server to see what these changes would look like:\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Define server logic required to make your output(s)\nserver <- function(input, output) {\n \n #... (all the good stuff we wrote above)\n \n # render the plot output\n output$ridgePlot <- renderPlot({\n \n # create the plot\n ggplot(data = eruptions_filtered(),\n aes(x = vei,\n y = volcano_name)) + # we are no longer setting \n # the fill argument to a variable\n \n # we are using a ridgeplot geom here, from the ggridges package\n geom_density_ridges(size = .5) + \n \n # label the axes\n labs(x = \"Volcano Explosivity Index\", y = \"\") +\n \n # remove the \"classic\" ggplot2 so it doesn't override thematic's changes\n # theme_classic() + \n theme(legend.position = \"none\",\n axis.text = element_text(size = 12, face = \"bold\"),\n axis.title = element_text(size = 14, face = \"bold\"))\n })\n }\n```\n:::\n\n\nNow, our plot's theme follows the app's custom theme as well:\n\n\n\n\n# Constructing a Shiny app using shinyDashboards\n\n## Taking advantage of good defaults\n\nHere, we will use shiny extension `shinyDashboards` and `leaflet` to construct a custom Shiny App to map volcanoes of the world. First, we need a few additional packages.\n\n**Note: All Source code for this app can be found [here](https://github.com/bios2/shiny_day_2/tree/main/Jake_volcano_map/Volcano_Leaflet) on the BIOS2 Github.**\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# load packages\nlibrary(shiny)\nlibrary(shinydashboard) # dashboard layout package\nlibrary(shinyWidgets) # fancy widgets package\nlibrary(leaflet) # interactive maps package\nlibrary(dplyr)\nlibrary(ggplot2)\n```\n:::\n\n\n### Using ShinyDashboard\n\nWe will create our app using defaults from the ShinyDashboard package, which always includes three main components: a header, using `dashboardHeader()`, a sidebar, using `dashboardSidebar()`, and a body, using `dashboardBody()`. These are then added together using the `dashboardPage()` function.\n\nBuilding these elements is less like usual R coding, and more like web design, since we are, in fact, designing a unser interface for a web app. Here, we'll make a basic layout before populating it.\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# create the header of our app\nheader <- dashboardHeader(\n title = \"Exploring Volcanoes of the World\",\n titleWidth = 350 # since we have a long title, we need to extend width element in pixels\n)\n\n\n# create dashboard body - this is the major UI element\nbody <- dashboardBody(\n\n # make first row of elements (actually, this will be the only row)\n fluidRow(\n \n # make first column, 25% of page - width = 3 of 12 columns\n column(width = 3,\n \n \n # Box 1: text explaining what this app is\n #-----------------------------------------------\n box( width = NULL,\n status=\"primary\", # this line can change the automatic color of the box.\n title = NULL,\n p(\"here, we'll include some info about this app\")\n\n \n ), # end box 1\n \n \n # box 2 : input for selecting volcano type\n #-----------------------------------------------\n box(width = NULL, status = \"primary\",\n title = \"Selection Criteria\", solidHeader = T, \n \n p(\"here, we'll add a UI element for selecting volcano types\"),\n\n ), # end box 2\n \n \n \n # box 3: ggplot of selected volcanoes by continent\n #------------------------------------------------\n box(width = NULL, status = \"primary\",\n solidHeader = TRUE, collapsible = T,\n title = \"Volcanoes by Continent\",\n p(\"here, we'll add a bar plot of volcanoes in each continent\")\n ) # end box 3\n \n ), # end column 1\n \n # second column - 75% of page (9 of 12 columns)\n #--------------------------------------------------\n column(width = 9,\n # Box 4: leaflet map\n box(width = NULL, background = \"light-blue\", height = 850,\n p(\"here, we'll show volcanoes on a map\"),\n ) # end box with map\n ) # end second column\n \n ) # end fluidrow\n) # end body\n\n\n# add elements together\ndashboardPage(\n skin = \"blue\",\n header = header,\n sidebar = dashboardSidebar(disable = TRUE), # here, we only have one tab of our app, so we don't need a sidebar\n body = body\n)\n```\n:::\n\n\n\n\n## Populating the Layout\n\nNow, we are going to fill out app with elements. In this app, we will only have one user input: a selection of the volcano type to show. We will use this input (`input$volcano_type`), which will be used to filter data in the server (i.e. make a smaller dataset using only volcanoes of the selected types), then use this filtered dataset to create output elements (plots and maps).\n\nBelow, we show the necessary code to include in both the UI and the Server to create each plot element. Notice that after the reactive value `selected_volcanoes` is created in the selection box, this is the only object that is used to create the other elements in the app.\n\n| Location | Element | UI | Server |\n|:----------------|:----------------|:-------------------|:-------------------|\n| Box 1 | **Intro Textbox** | Markdown/HTML text code | |\n| Box 2 | **Selection Wigets** | `checkboxGroupButtons(` `inputID = \"volcano_type\")` | `selected_volcanoes <- reactive({` `volcano_df %>% filter(type %in% input$volcano_type)})` to create a filtered dataset that will react to user input |\n| Box 3 | **Bar Graph** | `plotOutput(\"continentplot\")` | `output$continentplot <- renderPlot(...))` which will plot from the `selectied_volcanoes` reactive object |\n| Box 4 | **Leaflet Map** | `leafletOutput(\"volcanomap\")` | `output$volcanomap <- renderLeaflet(...)` to map points from the `selectied_volcanoes` reactive object |\n\n\n\n## Challenge!\n\nUse the code provided to add your own additional user input to the Shiny App. The code (which you can access [here](https://github.com/bios2/shiny_day_2/tree/main/Jake_volcano_map/Volcano_Leaflet) leaves a space for an additional UI input inside box 2). Then, you'll need to use your new input element to the reactive value in the Server, as noted in the server code.\n\nUse the [Default Shiny Widgets](https://shiny.rstudio.com/gallery/widget-gallery.html) or [shinyWidgets extended package](http://shinyapps.dreamrs.fr/shinyWidgets/) galleries to explore the types of elements you can add.\n\n\n\n### See the completed app\n\nSee our completed app [HERE](https://jakelawlor.shinyapps.io/Volcanoes_of_the_World/)\n\n\n# Constructing a Shiny app using Golem\n\nFirst step is creating your own golem project:\n\n\n\nGolem provides you with some very helpful \"workflow\" scripts:\n\nEdit the Description by filling in this function in `01_dev.R`\n\nThen, add all the dependencies\n\nTogether, this edits the `DESCRIPTION` of your R package to look something like this:\n\nNow we can start building the app.\n\n\n::: {.cell}\n\n```{.r .cell-code}\napp_ui <- function(request) {\n tagList(\n # Leave this function for adding external resources\n golem_add_external_resources(),\n # Your application UI logic \n shinydashboard::dashboardPage(\n header = shinydashboard::dashboardHeader(\n title = \"Exploring Volcanoes of the World\",\n titleWidth = 350 # since we have a long title, we need to extend width element in pixels\n ),\n sidebar = shinydashboard::dashboardSidebar(disable = TRUE), # here, we only have one tab, so we don't need a sidebar\n body = shinydashboard::dashboardBody(\n # make first row of elements (actually, this will be the only row)\n fluidRow(\n # make first column, 25% of page - width = 3 of 12 colums\n column(width = 3,\n # box 1 : input for selecting volcano type\n #-----------------------------------------------\n shinydashboard::box(width = NULL, status = \"primary\",\n title = \"Selection Criteria\", solidHeader = T\n \n ## CHECKBOX HERE\n \n ), # end box 1\n # box 2: ggplot of selected volcanoes by continent\n #------------------------------------------------\n shinydashboard::box(width = NULL, status = \"primary\",\n solidHeader = TRUE, collapsible = T,\n title = \"Volcanoes by Continent\"\n \n ## PLOT HERE\n\n ) # end box 2\n ), # end column 1\n \n # second column - 75% of page (9 of 12 columns)\n column(width = 9,\n \n # Box 3: leaflet map\n shinydashboard::box(width = NULL, background = \"light-blue\"\n \n ## MAP HERE \n \n ) # end box with map\n ) # end second column\n ) # end fluidrow\n ) # end body\n )\n )\n}\n```\n:::\n\n\nThis indicates where each of the three components of the app would go.\n\nAt this point we can run the app to get a very empty-looking UI:\n\n\n\n### Golem modules\n\nWe could split this app into three different sections, corresponding to each of the three boxes:\n\n1. Filter the type of volcano we see\n2. take the filtered volcanoes and plot a stacked bar chart\n3. take the filtered volcanoes and plot a map\n\n### Selecting the volcanoes\n\n\n::: {.cell}\n\n```{.r .cell-code}\n#' volcano_select UI Function\n#'\n#' @description A shiny Module.\n#'\n#' @param id,input,output,session Internal parameters for {shiny}.\n#'\n#' @noRd \n#'\n#' @importFrom shiny NS tagList \nmod_volcano_select_ui <- function(id){\n ns <- NS(id)\n tagList(\n # Widget specifying the species to be included on the plot\n shinyWidgets::checkboxGroupButtons(\n inputId = ns(\"volcano_type\"),\n label = \"Volcano Type\",\n choices = c(\"Stratovolcano\" , \"Shield\" ,\"Cone\" , \"Caldera\" , \"Volcanic Field\",\n \"Complex\" , \"Other\", \"Lava Dome\" , \"Submarine\" ),\n checkIcon = list(\n yes = tags$i(class = \"fa fa-check-square\", \n style = \"color: steelblue\"),\n no = tags$i(class = \"fa fa-square-o\", \n style = \"color: steelblue\"))\n ) # end checkboxGroupButtons\n )\n}\n \n#' volcano_select Server Functions\n#'\n#' @noRd \nmod_volcano_select_server <- function(id, volcano){\n moduleServer( id, function(input, output, session){\n ns <- session$ns\n \n # make reactive dataset\n # ------------------------------------------------\n # Make a subset of the data as a reactive value\n # this subset pulls volcano rows only in the selected types of volcano\n selected_volcanoes <- reactive({\n \n req(input$volcano_type)\n \n volcano %>%\n \n # select only volcanoes in the selected volcano type (by checkboxes in the UI)\n dplyr::filter(volcano_type_consolidated %in% input$volcano_type) %>%\n # Space to add your suggested filter here!! \n # --- --- --- --- --- --- --- --- --- --- --- --- ---\n # filter() %>%\n # --- --- --- --- --- --- --- --- --- --- --- --- ---\n # change volcano type into factor (this makes plotting it more consistent)\n dplyr::mutate(volcano_type_consolidated = factor(volcano_type_consolidated,\n levels = c(\"Stratovolcano\" , \"Shield\", \"Cone\", \"Caldera\", \"Volcanic Field\",\n \"Complex\" , \"Other\" , \"Lava Dome\" , \"Submarine\" ) ) )\n })\n \n })\n}\n \n## To be copied in the UI\n# mod_volcano_select_ui(\"volcano_select_1\")\n \n## To be copied in the server\n# mod_volcano_select_server(\"volcano_select_1\")\n```\n:::\n\n\nI also like to test my modules by using them to create a toy Shiny app. The best place to do this is by using a testthat directory. This is another great advantage of using a package workflow. You can set this up easily with `usethis::use_test()`: just run `usethis::use_test` from the R console when you have the module open.\n\nThen write a simple test like this\n\n\n::: {.cell}\n\n```{.r .cell-code}\ntest_that(\"volcano selection module works\", {\n \n testthat::skip_if_not(interactive())\n \n \n ui <- fluidPage(\n ## To be copied in the UI\n mod_volcano_select_ui(\"volcano_select_1\"),\n tableOutput(\"table\")\n )\n \n server <- function(input, output) {\n ## To be copied in the server\n volcano_data <- readRDS(\"data/volcanoes.rds\")\n selected_data <- mod_volcano_select_server(\"volcano_select_1\",\n volcano = volcano_data)\n \n output$table <- renderTable(selected_data())\n }\n \n shinyApp(ui = ui, server = server)\n \n})\n```\n:::\n\n\nWhich generates the following simple app:\n\n\n\n### Barplot of continents\n\n\n::: {.cell}\n\n```{.r .cell-code}\n#' continentplot UI Function\n#'\n#' @description A shiny Module.\n#'\n#' @param id,input,output,session Internal parameters for {shiny}.\n#'\n#' @noRd \n#'\n#' @importFrom shiny NS tagList \nmod_continentplot_ui <- function(id){\n ns <- NS(id)\n tagList(\n plotOutput(ns(\"barplot\"), # this calls to object continentplot that is made in the server page\n height = 350)\n )\n}\n \n#' continentplot Server Functions\n#'\n#' @noRd \nmod_continentplot_server <- function(id, volcano, selected_volcanoes){\n \n # kind of helpful\n stopifnot(is.reactive(selected_volcanoes))\n \n moduleServer( id, function(input, output, session){\n ns <- session$ns\n \n output$barplot <- renderPlot({\n \n # create basic barplot\n barplot <- ggplot2::ggplot(data = volcano,\n ggplot2::aes(x=continent,\n fill = volcano_type_consolidated))+\n # update theme and axis labels:\n ggplot2::theme_bw()+\n ggplot2::theme(plot.background = ggplot2::element_rect(color=\"transparent\",fill = \"transparent\"),\n panel.background = ggplot2::element_rect(color=\"transparent\",fill=\"transparent\"),\n panel.border = ggplot2::element_rect(color=\"transparent\",fill=\"transparent\"))+\n ggplot2::labs(x=NULL, y=NULL, title = NULL) +\n ggplot2::theme(axis.text.x = ggplot2::element_text(angle=45,hjust=1))\n \n \n # IF a selected_volcanoes() object exists, update the blank ggplot. \n # basically this makes it not mess up when nothing is selected\n \n barplot <- barplot +\n ggplot2::geom_bar(data = selected_volcanoes(), show.legend = F) +\n ggplot2::scale_fill_manual(values = RColorBrewer::brewer.pal(9,\"Set1\"), drop=F) +\n ggplot2::scale_x_discrete(drop=F)\n \n \n # print the plot\n barplot\n \n }) # end renderplot command\n \n \n })\n}\n \n## To be copied in the UI\n# mod_continentplot_ui(\"continentplot_1\")\n \n## To be copied in the server\n# mod_continentplot_server(\"continentplot_1\")\n```\n:::\n\n\nthe test\n\n\n::: {.cell}\n\n```{.r .cell-code}\ntest_that(\"volano barplot works\", {\n \n testthat::skip_if_not(interactive())\n \n \n ui <- fluidPage(\n ## To be copied in the UI\n mod_continentplot_ui(\"continentplot_1\"),\n tableOutput(\"table\")\n )\n \n server <- function(input, output) {\n ## To be copied in the server\n volcano_data <- readRDS(\"data/volcanoes.rds\")\n volcano_recent <- subset(volcano_data, last_eruption_year > 2000)\n mod_continentplot_server(\"continentplot_1\",\n volcano = volcano_data,\n selected_volcanoes = reactive(volcano_recent))\n }\n \n shinyApp(ui = ui, server = server)\n})\n```\n:::\n",
"supporting": [],
"filters": [
"rmarkdown/pagebreak.lua"
diff --git a/.quarto/_freeze/site_libs/plotly-binding-4.10.0/plotly.js b/.quarto/_freeze/site_libs/plotly-binding-4.10.0/plotly.js
index 1155269..aaca427 100644
--- a/.quarto/_freeze/site_libs/plotly-binding-4.10.0/plotly.js
+++ b/.quarto/_freeze/site_libs/plotly-binding-4.10.0/plotly.js
@@ -616,9 +616,9 @@ TraceManager.prototype.updateFilter = function(group, keys) {
traces.push(trace);
}
}
- this.gd.data = traces;
}
+ this.gd.data = traces;
Plotly.redraw(this.gd);
// NOTE: we purposely do _not_ restore selection(s), since on filter,
diff --git a/.quarto/_freeze/site_libs/plotly-main-2.5.1/plotly-latest.min.js b/.quarto/_freeze/site_libs/plotly-main-2.5.1/plotly-latest.min.js
index 27bfdaa..d6b2f17 100644
--- a/.quarto/_freeze/site_libs/plotly-main-2.5.1/plotly-latest.min.js
+++ b/.quarto/_freeze/site_libs/plotly-main-2.5.1/plotly-latest.min.js
@@ -1,69 +1,62 @@
/**
-* plotly.js v2.11.1
-* Copyright 2012-2022, Plotly, Inc.
+* plotly.js v2.5.1
+* Copyright 2012-2021, Plotly, Inc.
* All rights reserved.
* Licensed under the MIT license
*/
-!function(t){if("object"==typeof exports&&"undefined"!=typeof module)module.exports=t();else if("function"==typeof define&&define.amd)define([],t);else{("undefined"!=typeof window?window:"undefined"!=typeof global?global:"undefined"!=typeof self?self:this).Plotly=t()}}((function(){return function t(e,r,n){function i(o,s){if(!r[o]){if(!e[o]){var l="function"==typeof require&&require;if(!s&&l)return l(o,!0);if(a)return a(o,!0);var c=new Error("Cannot find module '"+o+"'");throw c.code="MODULE_NOT_FOUND",c}var u=r[o]={exports:{}};e[o][0].call(u.exports,(function(t){return i(e[o][1][t]||t)}),u,u.exports,t,e,r,n)}return r[o].exports}for(var a="function"==typeof require&&require,o=0;o:not(.watermark)":"opacity:0;-webkit-transition:opacity .3s ease 0s;-moz-transition:opacity .3s ease 0s;-ms-transition:opacity .3s ease 0s;-o-transition:opacity .3s ease 0s;transition:opacity .3s ease 0s;","X:hover .modebar--hover .modebar-group":"opacity:1;","X .modebar-group":"float:left;display:inline-block;box-sizing:border-box;padding-left:8px;position:relative;vertical-align:middle;white-space:nowrap;","X .modebar-btn":"position:relative;font-size:16px;padding:3px 4px;height:22px;cursor:pointer;line-height:normal;box-sizing:border-box;","X .modebar-btn svg":"position:relative;top:2px;","X .modebar.vertical":"display:flex;flex-direction:column;flex-wrap:wrap;align-content:flex-end;max-height:100%;","X .modebar.vertical svg":"top:-1px;","X .modebar.vertical .modebar-group":"display:block;float:none;padding-left:0px;padding-bottom:8px;","X .modebar.vertical .modebar-group .modebar-btn":"display:block;text-align:center;","X [data-title]:before,X [data-title]:after":"position:absolute;-webkit-transform:translate3d(0, 0, 0);-moz-transform:translate3d(0, 0, 0);-ms-transform:translate3d(0, 0, 0);-o-transform:translate3d(0, 0, 0);transform:translate3d(0, 0, 0);display:none;opacity:0;z-index:1001;pointer-events:none;top:110%;right:50%;","X [data-title]:hover:before,X [data-title]:hover:after":"display:block;opacity:1;","X [data-title]:before":'content:"";position:absolute;background:transparent;border:6px solid transparent;z-index:1002;margin-top:-12px;border-bottom-color:#69738a;margin-right:-6px;',"X [data-title]:after":"content:attr(data-title);background:#69738a;color:#fff;padding:8px 10px;font-size:12px;line-height:12px;white-space:nowrap;margin-right:-18px;border-radius:2px;","X .vertical [data-title]:before,X .vertical [data-title]:after":"top:0%;right:200%;","X .vertical [data-title]:before":"border:6px solid transparent;border-left-color:#69738a;margin-top:8px;margin-right:-30px;","X .select-outline":"fill:none;stroke-width:1;shape-rendering:crispEdges;","X .select-outline-1":"stroke:#fff;","X .select-outline-2":"stroke:#000;stroke-dasharray:2px 2px;",Y:'font-family:"Open Sans",verdana,arial,sans-serif;position:fixed;top:50px;right:20px;z-index:10000;font-size:10pt;max-width:180px;',"Y p":"margin:0;","Y .notifier-note":"min-width:180px;max-width:250px;border:1px solid #fff;z-index:3000;margin:0;background-color:#8c97af;background-color:rgba(140,151,175,.9);color:#fff;padding:10px;overflow-wrap:break-word;word-wrap:break-word;-ms-hyphens:auto;-webkit-hyphens:auto;hyphens:auto;","Y .notifier-close":"color:#fff;opacity:.8;float:right;padding:0 5px;background:none;border:none;font-size:20px;font-weight:bold;line-height:20px;","Y .notifier-close:hover":"color:#444;text-decoration:none;cursor:pointer;"};for(var a in i){var o=a.replace(/^,/," ,").replace(/X/g,".js-plotly-plot .plotly").replace(/Y/g,".plotly-notifier");n.addStyleRule(o,i[a])}},{"../src/lib":498}],2:[function(t,e,r){"use strict";e.exports=t("../src/transforms/aggregate")},{"../src/transforms/aggregate":1113}],3:[function(t,e,r){"use strict";e.exports=t("../src/traces/bar")},{"../src/traces/bar":651}],4:[function(t,e,r){"use strict";e.exports=t("../src/traces/barpolar")},{"../src/traces/barpolar":664}],5:[function(t,e,r){"use strict";e.exports=t("../src/traces/box")},{"../src/traces/box":674}],6:[function(t,e,r){"use strict";e.exports=t("../src/components/calendars")},{"../src/components/calendars":359}],7:[function(t,e,r){"use strict";e.exports=t("../src/traces/candlestick")},{"../src/traces/candlestick":683}],8:[function(t,e,r){"use strict";e.exports=t("../src/traces/carpet")},{"../src/traces/carpet":702}],9:[function(t,e,r){"use strict";e.exports=t("../src/traces/choropleth")},{"../src/traces/choropleth":716}],10:[function(t,e,r){"use strict";e.exports=t("../src/traces/choroplethmapbox")},{"../src/traces/choroplethmapbox":723}],11:[function(t,e,r){"use strict";e.exports=t("../src/traces/cone")},{"../src/traces/cone":729}],12:[function(t,e,r){"use strict";e.exports=t("../src/traces/contour")},{"../src/traces/contour":744}],13:[function(t,e,r){"use strict";e.exports=t("../src/traces/contourcarpet")},{"../src/traces/contourcarpet":755}],14:[function(t,e,r){"use strict";e.exports=t("../src/core")},{"../src/core":476}],15:[function(t,e,r){"use strict";e.exports=t("../src/traces/densitymapbox")},{"../src/traces/densitymapbox":763}],16:[function(t,e,r){"use strict";e.exports=t("../src/transforms/filter")},{"../src/transforms/filter":1114}],17:[function(t,e,r){"use strict";e.exports=t("../src/traces/funnel")},{"../src/traces/funnel":773}],18:[function(t,e,r){"use strict";e.exports=t("../src/traces/funnelarea")},{"../src/traces/funnelarea":782}],19:[function(t,e,r){"use strict";e.exports=t("../src/transforms/groupby")},{"../src/transforms/groupby":1115}],20:[function(t,e,r){"use strict";e.exports=t("../src/traces/heatmap")},{"../src/traces/heatmap":795}],21:[function(t,e,r){"use strict";e.exports=t("../src/traces/heatmapgl")},{"../src/traces/heatmapgl":806}],22:[function(t,e,r){"use strict";e.exports=t("../src/traces/histogram")},{"../src/traces/histogram":818}],23:[function(t,e,r){"use strict";e.exports=t("../src/traces/histogram2d")},{"../src/traces/histogram2d":824}],24:[function(t,e,r){"use strict";e.exports=t("../src/traces/histogram2dcontour")},{"../src/traces/histogram2dcontour":828}],25:[function(t,e,r){"use strict";e.exports=t("../src/traces/icicle")},{"../src/traces/icicle":834}],26:[function(t,e,r){"use strict";e.exports=t("../src/traces/image")},{"../src/traces/image":847}],27:[function(t,e,r){"use strict";var n=t("./core");n.register([t("./bar"),t("./box"),t("./heatmap"),t("./histogram"),t("./histogram2d"),t("./histogram2dcontour"),t("./contour"),t("./scatterternary"),t("./violin"),t("./funnel"),t("./waterfall"),t("./image"),t("./pie"),t("./sunburst"),t("./treemap"),t("./icicle"),t("./funnelarea"),t("./scatter3d"),t("./surface"),t("./isosurface"),t("./volume"),t("./mesh3d"),t("./cone"),t("./streamtube"),t("./scattergeo"),t("./choropleth"),t("./scattergl"),t("./splom"),t("./pointcloud"),t("./heatmapgl"),t("./parcoords"),t("./parcats"),t("./scattermapbox"),t("./choroplethmapbox"),t("./densitymapbox"),t("./sankey"),t("./indicator"),t("./table"),t("./carpet"),t("./scattercarpet"),t("./contourcarpet"),t("./ohlc"),t("./candlestick"),t("./scatterpolar"),t("./scatterpolargl"),t("./barpolar"),t("./scattersmith"),t("./aggregate"),t("./filter"),t("./groupby"),t("./sort"),t("./calendars")]),e.exports=n},{"./aggregate":2,"./bar":3,"./barpolar":4,"./box":5,"./calendars":6,"./candlestick":7,"./carpet":8,"./choropleth":9,"./choroplethmapbox":10,"./cone":11,"./contour":12,"./contourcarpet":13,"./core":14,"./densitymapbox":15,"./filter":16,"./funnel":17,"./funnelarea":18,"./groupby":19,"./heatmap":20,"./heatmapgl":21,"./histogram":22,"./histogram2d":23,"./histogram2dcontour":24,"./icicle":25,"./image":26,"./indicator":28,"./isosurface":29,"./mesh3d":30,"./ohlc":31,"./parcats":32,"./parcoords":33,"./pie":34,"./pointcloud":35,"./sankey":36,"./scatter3d":37,"./scattercarpet":38,"./scattergeo":39,"./scattergl":40,"./scattermapbox":41,"./scatterpolar":42,"./scatterpolargl":43,"./scattersmith":44,"./scatterternary":45,"./sort":46,"./splom":47,"./streamtube":48,"./sunburst":49,"./surface":50,"./table":51,"./treemap":52,"./violin":53,"./volume":54,"./waterfall":55}],28:[function(t,e,r){"use strict";e.exports=t("../src/traces/indicator")},{"../src/traces/indicator":855}],29:[function(t,e,r){"use strict";e.exports=t("../src/traces/isosurface")},{"../src/traces/isosurface":861}],30:[function(t,e,r){"use strict";e.exports=t("../src/traces/mesh3d")},{"../src/traces/mesh3d":866}],31:[function(t,e,r){"use strict";e.exports=t("../src/traces/ohlc")},{"../src/traces/ohlc":871}],32:[function(t,e,r){"use strict";e.exports=t("../src/traces/parcats")},{"../src/traces/parcats":880}],33:[function(t,e,r){"use strict";e.exports=t("../src/traces/parcoords")},{"../src/traces/parcoords":891}],34:[function(t,e,r){"use strict";e.exports=t("../src/traces/pie")},{"../src/traces/pie":902}],35:[function(t,e,r){"use strict";e.exports=t("../src/traces/pointcloud")},{"../src/traces/pointcloud":911}],36:[function(t,e,r){"use strict";e.exports=t("../src/traces/sankey")},{"../src/traces/sankey":917}],37:[function(t,e,r){"use strict";e.exports=t("../src/traces/scatter3d")},{"../src/traces/scatter3d":955}],38:[function(t,e,r){"use strict";e.exports=t("../src/traces/scattercarpet")},{"../src/traces/scattercarpet":962}],39:[function(t,e,r){"use strict";e.exports=t("../src/traces/scattergeo")},{"../src/traces/scattergeo":970}],40:[function(t,e,r){"use strict";e.exports=t("../src/traces/scattergl")},{"../src/traces/scattergl":984}],41:[function(t,e,r){"use strict";e.exports=t("../src/traces/scattermapbox")},{"../src/traces/scattermapbox":994}],42:[function(t,e,r){"use strict";e.exports=t("../src/traces/scatterpolar")},{"../src/traces/scatterpolar":1002}],43:[function(t,e,r){"use strict";e.exports=t("../src/traces/scatterpolargl")},{"../src/traces/scatterpolargl":1010}],44:[function(t,e,r){"use strict";e.exports=t("../src/traces/scattersmith")},{"../src/traces/scattersmith":1017}],45:[function(t,e,r){"use strict";e.exports=t("../src/traces/scatterternary")},{"../src/traces/scatterternary":1025}],46:[function(t,e,r){"use strict";e.exports=t("../src/transforms/sort")},{"../src/transforms/sort":1117}],47:[function(t,e,r){"use strict";e.exports=t("../src/traces/splom")},{"../src/traces/splom":1035}],48:[function(t,e,r){"use strict";e.exports=t("../src/traces/streamtube")},{"../src/traces/streamtube":1043}],49:[function(t,e,r){"use strict";e.exports=t("../src/traces/sunburst")},{"../src/traces/sunburst":1051}],50:[function(t,e,r){"use strict";e.exports=t("../src/traces/surface")},{"../src/traces/surface":1060}],51:[function(t,e,r){"use strict";e.exports=t("../src/traces/table")},{"../src/traces/table":1068}],52:[function(t,e,r){"use strict";e.exports=t("../src/traces/treemap")},{"../src/traces/treemap":1079}],53:[function(t,e,r){"use strict";e.exports=t("../src/traces/violin")},{"../src/traces/violin":1092}],54:[function(t,e,r){"use strict";e.exports=t("../src/traces/volume")},{"../src/traces/volume":1100}],55:[function(t,e,r){"use strict";e.exports=t("../src/traces/waterfall")},{"../src/traces/waterfall":1108}],56:[function(t,e,r){!function(n,i){"object"==typeof r&&void 0!==e?i(r,t("d3-array"),t("d3-collection"),t("d3-shape"),t("elementary-circuits-directed-graph")):i(n.d3=n.d3||{},n.d3,n.d3,n.d3,null)}(this,(function(t,e,r,n,i){"use strict";function a(t){return t.target.depth}function o(t,e){return t.sourceLinks.length?t.depth:e-1}function s(t){return function(){return t}}i=i&&i.hasOwnProperty("default")?i.default:i;var l="function"==typeof Symbol&&"symbol"==typeof Symbol.iterator?function(t){return typeof t}:function(t){return t&&"function"==typeof Symbol&&t.constructor===Symbol&&t!==Symbol.prototype?"symbol":typeof t};function c(t,e){return f(t.source,e.source)||t.index-e.index}function u(t,e){return f(t.target,e.target)||t.index-e.index}function f(t,e){return t.partOfCycle===e.partOfCycle?t.y0-e.y0:"top"===t.circularLinkType||"bottom"===e.circularLinkType?-1:1}function h(t){return t.value}function p(t){return(t.y0+t.y1)/2}function d(t){return p(t.source)}function m(t){return p(t.target)}function g(t){return t.index}function v(t){return t.nodes}function y(t){return t.links}function x(t,e){var r=t.get(e);if(!r)throw new Error("missing: "+e);return r}function b(t,e){return e(t)}function _(t,e,r){var n=0;if(null===r){for(var a=[],o=0;o1||i>1)}function M(t,e,r){return t.sort(E),t.forEach((function(n,i){var a,o,s=0;if(q(n,r)&&A(n))n.circularPathData.verticalBuffer=s+n.width/2;else{for(var l=0;lo.source.column)){var c=t[l].circularPathData.verticalBuffer+t[l].width/2+e;s=c>s?c:s}n.circularPathData.verticalBuffer=s+n.width/2}})),t}function S(t,r,i,a){var o=e.min(t.links,(function(t){return t.source.y0}));t.links.forEach((function(t){t.circular&&(t.circularPathData={})})),M(t.links.filter((function(t){return"top"==t.circularLinkType})),r,a),M(t.links.filter((function(t){return"bottom"==t.circularLinkType})),r,a),t.links.forEach((function(e){if(e.circular){if(e.circularPathData.arcRadius=e.width+10,e.circularPathData.leftNodeBuffer=5,e.circularPathData.rightNodeBuffer=5,e.circularPathData.sourceWidth=e.source.x1-e.source.x0,e.circularPathData.sourceX=e.source.x0+e.circularPathData.sourceWidth,e.circularPathData.targetX=e.target.x0,e.circularPathData.sourceY=e.y0,e.circularPathData.targetY=e.y1,q(e,a)&&A(e))e.circularPathData.leftSmallArcRadius=10+e.width/2,e.circularPathData.leftLargeArcRadius=10+e.width/2,e.circularPathData.rightSmallArcRadius=10+e.width/2,e.circularPathData.rightLargeArcRadius=10+e.width/2,"bottom"==e.circularLinkType?(e.circularPathData.verticalFullExtent=e.source.y1+25+e.circularPathData.verticalBuffer,e.circularPathData.verticalLeftInnerExtent=e.circularPathData.verticalFullExtent-e.circularPathData.leftLargeArcRadius,e.circularPathData.verticalRightInnerExtent=e.circularPathData.verticalFullExtent-e.circularPathData.rightLargeArcRadius):(e.circularPathData.verticalFullExtent=e.source.y0-25-e.circularPathData.verticalBuffer,e.circularPathData.verticalLeftInnerExtent=e.circularPathData.verticalFullExtent+e.circularPathData.leftLargeArcRadius,e.circularPathData.verticalRightInnerExtent=e.circularPathData.verticalFullExtent+e.circularPathData.rightLargeArcRadius);else{var s=e.source.column,l=e.circularLinkType,c=t.links.filter((function(t){return t.source.column==s&&t.circularLinkType==l}));"bottom"==e.circularLinkType?c.sort(C):c.sort(L);var u=0;c.forEach((function(t,n){t.circularLinkID==e.circularLinkID&&(e.circularPathData.leftSmallArcRadius=10+e.width/2+u,e.circularPathData.leftLargeArcRadius=10+e.width/2+n*r+u),u+=t.width})),s=e.target.column,c=t.links.filter((function(t){return t.target.column==s&&t.circularLinkType==l})),"bottom"==e.circularLinkType?c.sort(I):c.sort(P),u=0,c.forEach((function(t,n){t.circularLinkID==e.circularLinkID&&(e.circularPathData.rightSmallArcRadius=10+e.width/2+u,e.circularPathData.rightLargeArcRadius=10+e.width/2+n*r+u),u+=t.width})),"bottom"==e.circularLinkType?(e.circularPathData.verticalFullExtent=Math.max(i,e.source.y1,e.target.y1)+25+e.circularPathData.verticalBuffer,e.circularPathData.verticalLeftInnerExtent=e.circularPathData.verticalFullExtent-e.circularPathData.leftLargeArcRadius,e.circularPathData.verticalRightInnerExtent=e.circularPathData.verticalFullExtent-e.circularPathData.rightLargeArcRadius):(e.circularPathData.verticalFullExtent=o-25-e.circularPathData.verticalBuffer,e.circularPathData.verticalLeftInnerExtent=e.circularPathData.verticalFullExtent+e.circularPathData.leftLargeArcRadius,e.circularPathData.verticalRightInnerExtent=e.circularPathData.verticalFullExtent+e.circularPathData.rightLargeArcRadius)}e.circularPathData.leftInnerExtent=e.circularPathData.sourceX+e.circularPathData.leftNodeBuffer,e.circularPathData.rightInnerExtent=e.circularPathData.targetX-e.circularPathData.rightNodeBuffer,e.circularPathData.leftFullExtent=e.circularPathData.sourceX+e.circularPathData.leftLargeArcRadius+e.circularPathData.leftNodeBuffer,e.circularPathData.rightFullExtent=e.circularPathData.targetX-e.circularPathData.rightLargeArcRadius-e.circularPathData.rightNodeBuffer}if(e.circular)e.path=function(t){var e="";e="top"==t.circularLinkType?"M"+t.circularPathData.sourceX+" "+t.circularPathData.sourceY+" L"+t.circularPathData.leftInnerExtent+" "+t.circularPathData.sourceY+" A"+t.circularPathData.leftLargeArcRadius+" "+t.circularPathData.leftSmallArcRadius+" 0 0 0 "+t.circularPathData.leftFullExtent+" "+(t.circularPathData.sourceY-t.circularPathData.leftSmallArcRadius)+" L"+t.circularPathData.leftFullExtent+" "+t.circularPathData.verticalLeftInnerExtent+" A"+t.circularPathData.leftLargeArcRadius+" "+t.circularPathData.leftLargeArcRadius+" 0 0 0 "+t.circularPathData.leftInnerExtent+" "+t.circularPathData.verticalFullExtent+" L"+t.circularPathData.rightInnerExtent+" "+t.circularPathData.verticalFullExtent+" A"+t.circularPathData.rightLargeArcRadius+" "+t.circularPathData.rightLargeArcRadius+" 0 0 0 "+t.circularPathData.rightFullExtent+" "+t.circularPathData.verticalRightInnerExtent+" L"+t.circularPathData.rightFullExtent+" "+(t.circularPathData.targetY-t.circularPathData.rightSmallArcRadius)+" A"+t.circularPathData.rightLargeArcRadius+" "+t.circularPathData.rightSmallArcRadius+" 0 0 0 "+t.circularPathData.rightInnerExtent+" "+t.circularPathData.targetY+" L"+t.circularPathData.targetX+" "+t.circularPathData.targetY:"M"+t.circularPathData.sourceX+" "+t.circularPathData.sourceY+" L"+t.circularPathData.leftInnerExtent+" "+t.circularPathData.sourceY+" A"+t.circularPathData.leftLargeArcRadius+" "+t.circularPathData.leftSmallArcRadius+" 0 0 1 "+t.circularPathData.leftFullExtent+" "+(t.circularPathData.sourceY+t.circularPathData.leftSmallArcRadius)+" L"+t.circularPathData.leftFullExtent+" "+t.circularPathData.verticalLeftInnerExtent+" A"+t.circularPathData.leftLargeArcRadius+" "+t.circularPathData.leftLargeArcRadius+" 0 0 1 "+t.circularPathData.leftInnerExtent+" "+t.circularPathData.verticalFullExtent+" L"+t.circularPathData.rightInnerExtent+" "+t.circularPathData.verticalFullExtent+" A"+t.circularPathData.rightLargeArcRadius+" "+t.circularPathData.rightLargeArcRadius+" 0 0 1 "+t.circularPathData.rightFullExtent+" "+t.circularPathData.verticalRightInnerExtent+" L"+t.circularPathData.rightFullExtent+" "+(t.circularPathData.targetY+t.circularPathData.rightSmallArcRadius)+" A"+t.circularPathData.rightLargeArcRadius+" "+t.circularPathData.rightSmallArcRadius+" 0 0 1 "+t.circularPathData.rightInnerExtent+" "+t.circularPathData.targetY+" L"+t.circularPathData.targetX+" "+t.circularPathData.targetY;return e}(e);else{var f=n.linkHorizontal().source((function(t){return[t.source.x0+(t.source.x1-t.source.x0),t.y0]})).target((function(t){return[t.target.x0,t.y1]}));e.path=f(e)}}))}function E(t,e){return O(t)==O(e)?"bottom"==t.circularLinkType?C(t,e):L(t,e):O(e)-O(t)}function L(t,e){return t.y0-e.y0}function C(t,e){return e.y0-t.y0}function P(t,e){return t.y1-e.y1}function I(t,e){return e.y1-t.y1}function O(t){return t.target.column-t.source.column}function z(t){return t.target.x0-t.source.x1}function D(t,e){var r=T(t),n=z(e)/Math.tan(r);return"up"==H(t)?t.y1+n:t.y1-n}function R(t,e){var r=T(t),n=z(e)/Math.tan(r);return"up"==H(t)?t.y1-n:t.y1+n}function F(t,e,r,n){t.links.forEach((function(i){if(!i.circular&&i.target.column-i.source.column>1){var a=i.source.column+1,o=i.target.column-1,s=1,l=o-a+1;for(s=1;a<=o;a++,s++)t.nodes.forEach((function(o){if(o.column==a){var c,u=s/(l+1),f=Math.pow(1-u,3),h=3*u*Math.pow(1-u,2),p=3*Math.pow(u,2)*(1-u),d=Math.pow(u,3),m=f*i.y0+h*i.y0+p*i.y1+d*i.y1,g=m-i.width/2,v=m+i.width/2;g>o.y0&&go.y0&&vo.y1)&&(c=v-o.y0+10,o=N(o,c,e,r),t.nodes.forEach((function(t){b(t,n)!=b(o,n)&&t.column==o.column&&t.y0o.y1&&N(t,c,e,r)})))}}))}}))}function B(t,e){return t.y0>e.y0&&t.y0e.y0&&t.y1e.y1)}function N(t,e,r,n){return t.y0+e>=r&&t.y1+e<=n&&(t.y0=t.y0+e,t.y1=t.y1+e,t.targetLinks.forEach((function(t){t.y1=t.y1+e})),t.sourceLinks.forEach((function(t){t.y0=t.y0+e}))),t}function j(t,e,r,n){t.nodes.forEach((function(i){n&&i.y+(i.y1-i.y0)>e&&(i.y=i.y-(i.y+(i.y1-i.y0)-e));var a=t.links.filter((function(t){return b(t.source,r)==b(i,r)})),o=a.length;o>1&&a.sort((function(t,e){if(!t.circular&&!e.circular){if(t.target.column==e.target.column)return t.y1-e.y1;if(!V(t,e))return t.y1-e.y1;if(t.target.column>e.target.column){var r=R(e,t);return t.y1-r}if(e.target.column>t.target.column)return R(t,e)-e.y1}return t.circular&&!e.circular?"top"==t.circularLinkType?-1:1:e.circular&&!t.circular?"top"==e.circularLinkType?1:-1:t.circular&&e.circular?t.circularLinkType===e.circularLinkType&&"top"==t.circularLinkType?t.target.column===e.target.column?t.target.y1-e.target.y1:e.target.column-t.target.column:t.circularLinkType===e.circularLinkType&&"bottom"==t.circularLinkType?t.target.column===e.target.column?e.target.y1-t.target.y1:t.target.column-e.target.column:"top"==t.circularLinkType?-1:1:void 0}));var s=i.y0;a.forEach((function(t){t.y0=s+t.width/2,s+=t.width})),a.forEach((function(t,e){if("bottom"==t.circularLinkType){for(var r=e+1,n=0;r1&&n.sort((function(t,e){if(!t.circular&&!e.circular){if(t.source.column==e.source.column)return t.y0-e.y0;if(!V(t,e))return t.y0-e.y0;if(e.source.column0?"up":"down"}function q(t,e){return b(t.source,e)==b(t.target,e)}function G(t,r,n){var i=t.nodes,a=t.links,o=!1,s=!1;if(a.forEach((function(t){"top"==t.circularLinkType?o=!0:"bottom"==t.circularLinkType&&(s=!0)})),0==o||0==s){var l=e.min(i,(function(t){return t.y0})),c=(n-r)/(e.max(i,(function(t){return t.y1}))-l);i.forEach((function(t){var e=(t.y1-t.y0)*c;t.y0=(t.y0-l)*c,t.y1=t.y0+e})),a.forEach((function(t){t.y0=(t.y0-l)*c,t.y1=(t.y1-l)*c,t.width=t.width*c}))}}t.sankeyCircular=function(){var t,n,i=0,a=0,b=1,T=1,A=24,M=g,E=o,L=v,C=y,P=32,I=2,O=null;function z(){var t={nodes:L.apply(null,arguments),links:C.apply(null,arguments)};D(t),_(t,M,O),R(t),B(t),w(t,M),N(t,P,M),V(t);for(var e=4,r=0;r0?r+25+10:r,bottom:n=n>0?n+25+10:n,left:a=a>0?a+25+10:a,right:i=i>0?i+25+10:i}}(o),f=function(t,r){var n=e.max(t.nodes,(function(t){return t.column})),o=b-i,s=T-a,l=o/(o+r.right+r.left),c=s/(s+r.top+r.bottom);return i=i*l+r.left,b=0==r.right?b:b*l,a=a*c+r.top,T*=c,t.nodes.forEach((function(t){t.x0=i+t.column*((b-i-A)/n),t.x1=t.x0+A})),c}(o,u);l*=f,o.links.forEach((function(t){t.width=t.value*l})),c.forEach((function(t){var e=t.length;t.forEach((function(t,n){t.depth==c.length-1&&1==e||0==t.depth&&1==e?(t.y0=T/2-t.value*l,t.y1=t.y0+t.value*l):t.partOfCycle?0==k(t,r)?(t.y0=T/2+n,t.y1=t.y0+t.value*l):"top"==t.circularLinkType?(t.y0=a+n,t.y1=t.y0+t.value*l):(t.y0=T-t.value*l-n,t.y1=t.y0+t.value*l):0==u.top||0==u.bottom?(t.y0=(T-a)/e*n,t.y1=t.y0+t.value*l):(t.y0=(T-a)/2-e/2+n,t.y1=t.y0+t.value*l)}))}))}(l),y();for(var u=1,g=s;g>0;--g)v(u*=.99,l),y();function v(t,r){var n=c.length;c.forEach((function(i){var a=i.length,o=i[0].depth;i.forEach((function(i){var s;if(i.sourceLinks.length||i.targetLinks.length)if(i.partOfCycle&&k(i,r)>0);else if(0==o&&1==a)s=i.y1-i.y0,i.y0=T/2-s/2,i.y1=T/2+s/2;else if(o==n-1&&1==a)s=i.y1-i.y0,i.y0=T/2-s/2,i.y1=T/2+s/2;else{var l=e.mean(i.sourceLinks,m),c=e.mean(i.targetLinks,d),u=((l&&c?(l+c)/2:l||c)-p(i))*t;i.y0+=u,i.y1+=u}}))}))}function y(){c.forEach((function(e){var r,n,i,o=a,s=e.length;for(e.sort(f),i=0;i0&&(r.y0+=n,r.y1+=n),o=r.y1+t;if((n=o-t-T)>0)for(o=r.y0-=n,r.y1-=n,i=s-2;i>=0;--i)(n=(r=e[i]).y1+t-o)>0&&(r.y0-=n,r.y1-=n),o=r.y0}))}}function V(t){t.nodes.forEach((function(t){t.sourceLinks.sort(u),t.targetLinks.sort(c)})),t.nodes.forEach((function(t){var e=t.y0,r=e,n=t.y1,i=n;t.sourceLinks.forEach((function(t){t.circular?(t.y0=n-t.width/2,n-=t.width):(t.y0=e+t.width/2,e+=t.width)})),t.targetLinks.forEach((function(t){t.circular?(t.y1=i-t.width/2,i-=t.width):(t.y1=r+t.width/2,r+=t.width)}))}))}return z.nodeId=function(t){return arguments.length?(M="function"==typeof t?t:s(t),z):M},z.nodeAlign=function(t){return arguments.length?(E="function"==typeof t?t:s(t),z):E},z.nodeWidth=function(t){return arguments.length?(A=+t,z):A},z.nodePadding=function(e){return arguments.length?(t=+e,z):t},z.nodes=function(t){return arguments.length?(L="function"==typeof t?t:s(t),z):L},z.links=function(t){return arguments.length?(C="function"==typeof t?t:s(t),z):C},z.size=function(t){return arguments.length?(i=a=0,b=+t[0],T=+t[1],z):[b-i,T-a]},z.extent=function(t){return arguments.length?(i=+t[0][0],b=+t[1][0],a=+t[0][1],T=+t[1][1],z):[[i,a],[b,T]]},z.iterations=function(t){return arguments.length?(P=+t,z):P},z.circularLinkGap=function(t){return arguments.length?(I=+t,z):I},z.nodePaddingRatio=function(t){return arguments.length?(n=+t,z):n},z.sortNodes=function(t){return arguments.length?(O=t,z):O},z.update=function(t){return w(t,M),V(t),t.links.forEach((function(t){t.circular&&(t.circularLinkType=t.y0+t.y1a&&(b=a);var o=e.min(i,(function(t){return(y-n-(t.length-1)*b)/e.sum(t,u)}));i.forEach((function(t){t.forEach((function(t,e){t.y1=(t.y0=e)+t.value*o}))})),t.links.forEach((function(t){t.width=t.value*o}))}(),d();for(var a=1,o=A;o>0;--o)l(a*=.99),d(),s(a),d();function s(t){i.forEach((function(r){r.forEach((function(r){if(r.targetLinks.length){var n=(e.sum(r.targetLinks,h)/e.sum(r.targetLinks,u)-f(r))*t;r.y0+=n,r.y1+=n}}))}))}function l(t){i.slice().reverse().forEach((function(r){r.forEach((function(r){if(r.sourceLinks.length){var n=(e.sum(r.sourceLinks,p)/e.sum(r.sourceLinks,u)-f(r))*t;r.y0+=n,r.y1+=n}}))}))}function d(){i.forEach((function(t){var e,r,i,a=n,o=t.length;for(t.sort(c),i=0;i0&&(e.y0+=r,e.y1+=r),a=e.y1+b;if((r=a-b-y)>0)for(a=e.y0-=r,e.y1-=r,i=o-2;i>=0;--i)(r=(e=t[i]).y1+b-a)>0&&(e.y0-=r,e.y1-=r),a=e.y0}))}}function P(t){t.nodes.forEach((function(t){t.sourceLinks.sort(l),t.targetLinks.sort(s)})),t.nodes.forEach((function(t){var e=t.y0,r=e;t.sourceLinks.forEach((function(t){t.y0=e+t.width/2,e+=t.width})),t.targetLinks.forEach((function(t){t.y1=r+t.width/2,r+=t.width}))}))}return M.update=function(t){return P(t),t},M.nodeId=function(t){return arguments.length?(_="function"==typeof t?t:o(t),M):_},M.nodeAlign=function(t){return arguments.length?(w="function"==typeof t?t:o(t),M):w},M.nodeWidth=function(t){return arguments.length?(x=+t,M):x},M.nodePadding=function(t){return arguments.length?(b=+t,M):b},M.nodes=function(t){return arguments.length?(T="function"==typeof t?t:o(t),M):T},M.links=function(t){return arguments.length?(k="function"==typeof t?t:o(t),M):k},M.size=function(e){return arguments.length?(t=n=0,i=+e[0],y=+e[1],M):[i-t,y-n]},M.extent=function(e){return arguments.length?(t=+e[0][0],i=+e[1][0],n=+e[0][1],y=+e[1][1],M):[[t,n],[i,y]]},M.iterations=function(t){return arguments.length?(A=+t,M):A},M},t.sankeyCenter=function(t){return t.targetLinks.length?t.depth:t.sourceLinks.length?e.min(t.sourceLinks,i)-1:0},t.sankeyLeft=function(t){return t.depth},t.sankeyRight=function(t,e){return e-1-t.height},t.sankeyJustify=a,t.sankeyLinkHorizontal=function(){return n.linkHorizontal().source(y).target(x)},Object.defineProperty(t,"__esModule",{value:!0})}))},{"d3-array":102,"d3-collection":103,"d3-shape":114}],58:[function(t,e,r){(function(){var t={version:"3.8.0"},r=[].slice,n=function(t){return r.call(t)},i=self.document;function a(t){return t&&(t.ownerDocument||t.document||t).documentElement}function o(t){return t&&(t.ownerDocument&&t.ownerDocument.defaultView||t.document&&t||t.defaultView)}if(i)try{n(i.documentElement.childNodes)[0].nodeType}catch(t){n=function(t){for(var e=t.length,r=new Array(e);e--;)r[e]=t[e];return r}}if(Date.now||(Date.now=function(){return+new Date}),i)try{i.createElement("DIV").style.setProperty("opacity",0,"")}catch(t){var s=this.Element.prototype,l=s.setAttribute,c=s.setAttributeNS,u=this.CSSStyleDeclaration.prototype,f=u.setProperty;s.setAttribute=function(t,e){l.call(this,t,e+"")},s.setAttributeNS=function(t,e,r){c.call(this,t,e,r+"")},u.setProperty=function(t,e,r){f.call(this,t,e+"",r)}}function h(t,e){return te?1:t>=e?0:NaN}function p(t){return null===t?NaN:+t}function d(t){return!isNaN(t)}function m(t){return{left:function(e,r,n,i){for(arguments.length<3&&(n=0),arguments.length<4&&(i=e.length);n>>1;t(e[a],r)<0?n=a+1:i=a}return n},right:function(e,r,n,i){for(arguments.length<3&&(n=0),arguments.length<4&&(i=e.length);n>>1;t(e[a],r)>0?i=a:n=a+1}return n}}}t.ascending=h,t.descending=function(t,e){return et?1:e>=t?0:NaN},t.min=function(t,e){var r,n,i=-1,a=t.length;if(1===arguments.length){for(;++i=n){r=n;break}for(;++in&&(r=n)}else{for(;++i=n){r=n;break}for(;++in&&(r=n)}return r},t.max=function(t,e){var r,n,i=-1,a=t.length;if(1===arguments.length){for(;++i=n){r=n;break}for(;++ir&&(r=n)}else{for(;++i=n){r=n;break}for(;++ir&&(r=n)}return r},t.extent=function(t,e){var r,n,i,a=-1,o=t.length;if(1===arguments.length){for(;++a=n){r=i=n;break}for(;++an&&(r=n),i=n){r=i=n;break}for(;++an&&(r=n),i1)return o/(l-1)},t.deviation=function(){var e=t.variance.apply(this,arguments);return e?Math.sqrt(e):e};var g=m(h);function v(t){return t.length}t.bisectLeft=g.left,t.bisect=t.bisectRight=g.right,t.bisector=function(t){return m(1===t.length?function(e,r){return h(t(e),r)}:t)},t.shuffle=function(t,e,r){(a=arguments.length)<3&&(r=t.length,a<2&&(e=0));for(var n,i,a=r-e;a;)i=Math.random()*a--|0,n=t[a+e],t[a+e]=t[i+e],t[i+e]=n;return t},t.permute=function(t,e){for(var r=e.length,n=new Array(r);r--;)n[r]=t[e[r]];return n},t.pairs=function(t){for(var e=0,r=t.length-1,n=t[0],i=new Array(r<0?0:r);e=0;)for(e=(n=t[i]).length;--e>=0;)r[--o]=n[e];return r};var y=Math.abs;function x(t){for(var e=1;t*e%1;)e*=10;return e}function b(t,e){for(var r in e)Object.defineProperty(t.prototype,r,{value:e[r],enumerable:!1})}function _(){this._=Object.create(null)}t.range=function(t,e,r){if(arguments.length<3&&(r=1,arguments.length<2&&(e=t,t=0)),(e-t)/r==1/0)throw new Error("infinite range");var n,i=[],a=x(y(r)),o=-1;if(t*=a,e*=a,(r*=a)<0)for(;(n=t+r*++o)>e;)i.push(n/a);else for(;(n=t+r*++o)=i.length)return r?r.call(n,a):e?a.sort(e):a;for(var l,c,u,f,h=-1,p=a.length,d=i[s++],m=new _;++h=i.length)return e;var n=[],o=a[r++];return e.forEach((function(e,i){n.push({key:e,values:t(i,r)})})),o?n.sort((function(t,e){return o(t.key,e.key)})):n}(o(t.map,e,0),0)},n.key=function(t){return i.push(t),n},n.sortKeys=function(t){return a[i.length-1]=t,n},n.sortValues=function(t){return e=t,n},n.rollup=function(t){return r=t,n},n},t.set=function(t){var e=new L;if(t)for(var r=0,n=t.length;r=0&&(n=t.slice(r+1),t=t.slice(0,r)),t)return arguments.length<2?this[t].on(n):this[t].on(n,e);if(2===arguments.length){if(null==e)for(t in this)this.hasOwnProperty(t)&&this[t].on(n,null);return this}},t.event=null,t.requote=function(t){return t.replace(j,"\\$&")};var j=/[\\\^\$\*\+\?\|\[\]\(\)\.\{\}]/g,U={}.__proto__?function(t,e){t.__proto__=e}:function(t,e){for(var r in e)t[r]=e[r]};function V(t){return U(t,Y),t}var H=function(t,e){return e.querySelector(t)},q=function(t,e){return e.querySelectorAll(t)},G=function(t,e){var r=t.matches||t[I(t,"matchesSelector")];return(G=function(t,e){return r.call(t,e)})(t,e)};"function"==typeof Sizzle&&(H=function(t,e){return Sizzle(t,e)[0]||null},q=Sizzle,G=Sizzle.matchesSelector),t.selection=function(){return t.select(i.documentElement)};var Y=t.selection.prototype=[];function W(t){return"function"==typeof t?t:function(){return H(t,this)}}function X(t){return"function"==typeof t?t:function(){return q(t,this)}}Y.select=function(t){var e,r,n,i,a=[];t=W(t);for(var o=-1,s=this.length;++o=0&&"xmlns"!==(r=t.slice(0,e))&&(t=t.slice(e+1)),J.hasOwnProperty(r)?{space:J[r],local:t}:t}},Y.attr=function(e,r){if(arguments.length<2){if("string"==typeof e){var n=this.node();return(e=t.ns.qualify(e)).local?n.getAttributeNS(e.space,e.local):n.getAttribute(e)}for(r in e)this.each(K(r,e[r]));return this}return this.each(K(e,r))},Y.classed=function(t,e){if(arguments.length<2){if("string"==typeof t){var r=this.node(),n=(t=tt(t)).length,i=-1;if(e=r.classList){for(;++i=0;)(r=n[i])&&(a&&a!==r.nextSibling&&a.parentNode.insertBefore(r,a),a=r);return this},Y.sort=function(t){t=ct.apply(this,arguments);for(var e=-1,r=this.length;++e=e&&(e=i+1);!(o=s[e])&&++e0&&(e=e.slice(0,o));var l=mt.get(e);function c(){var t=this[a];t&&(this.removeEventListener(e,t,t.$),delete this[a])}return l&&(e=l,s=vt),o?r?function(){var t=s(r,n(arguments));c.call(this),this.addEventListener(e,this[a]=t,t.$=i),t._=r}:c:r?z:function(){var r,n=new RegExp("^__on([^.]+)"+t.requote(e)+"$");for(var i in this)if(r=i.match(n)){var a=this[i];this.removeEventListener(r[1],a,a.$),delete this[i]}}}t.selection.enter=ft,t.selection.enter.prototype=ht,ht.append=Y.append,ht.empty=Y.empty,ht.node=Y.node,ht.call=Y.call,ht.size=Y.size,ht.select=function(t){for(var e,r,n,i,a,o=[],s=-1,l=this.length;++s1?Et:t<-1?-Et:Math.asin(t)}function It(t){return((t=Math.exp(t))+1/t)/2}var Ot=Math.SQRT2;t.interpolateZoom=function(t,e){var r,n,i=t[0],a=t[1],o=t[2],s=e[0],l=e[1],c=e[2],u=s-i,f=l-a,h=u*u+f*f;if(h<1e-12)n=Math.log(c/o)/Ot,r=function(t){return[i+t*u,a+t*f,o*Math.exp(Ot*t*n)]};else{var p=Math.sqrt(h),d=(c*c-o*o+4*h)/(2*o*2*p),m=(c*c-o*o-4*h)/(2*c*2*p),g=Math.log(Math.sqrt(d*d+1)-d),v=Math.log(Math.sqrt(m*m+1)-m);n=(v-g)/Ot,r=function(t){var e,r=t*n,s=It(g),l=o/(2*p)*(s*(e=Ot*r+g,((e=Math.exp(2*e))-1)/(e+1))-function(t){return((t=Math.exp(t))-1/t)/2}(g));return[i+l*u,a+l*f,o*s/It(Ot*r+g)]}}return r.duration=1e3*n,r},t.behavior.zoom=function(){var e,r,n,a,s,l,c,u,f,h={x:0,y:0,k:1},p=[960,500],d=Rt,m=250,g=0,v="mousedown.zoom",y="mousemove.zoom",x="mouseup.zoom",b="touchstart.zoom",_=N(w,"zoomstart","zoom","zoomend");function w(t){t.on(v,P).on(Dt+".zoom",O).on("dblclick.zoom",z).on(b,I)}function T(t){return[(t[0]-h.x)/h.k,(t[1]-h.y)/h.k]}function k(t){h.k=Math.max(d[0],Math.min(d[1],t))}function A(t,e){e=function(t){return[t[0]*h.k+h.x,t[1]*h.k+h.y]}(e),h.x+=t[0]-e[0],h.y+=t[1]-e[1]}function M(e,n,i,a){e.__chart__={x:h.x,y:h.y,k:h.k},k(Math.pow(2,a)),A(r=n,i),e=t.select(e),m>0&&(e=e.transition().duration(m)),e.call(w.event)}function S(){c&&c.domain(l.range().map((function(t){return(t-h.x)/h.k})).map(l.invert)),f&&f.domain(u.range().map((function(t){return(t-h.y)/h.k})).map(u.invert))}function E(t){g++||t({type:"zoomstart"})}function L(t){S(),t({type:"zoom",scale:h.k,translate:[h.x,h.y]})}function C(t){--g||(t({type:"zoomend"}),r=null)}function P(){var e=this,r=_.of(e,arguments),n=0,i=t.select(o(e)).on(y,l).on(x,c),a=T(t.mouse(e)),s=bt(e);function l(){n=1,A(t.mouse(e),a),L(r)}function c(){i.on(y,null).on(x,null),s(n),C(r)}Di.call(e),E(r)}function I(){var e,r=this,n=_.of(r,arguments),i={},a=0,o=".zoom-"+t.event.changedTouches[0].identifier,l="touchmove"+o,c="touchend"+o,u=[],f=t.select(r),p=bt(r);function d(){var n=t.touches(r);return e=h.k,n.forEach((function(t){t.identifier in i&&(i[t.identifier]=T(t))})),n}function m(){var e=t.event.target;t.select(e).on(l,g).on(c,y),u.push(e);for(var n=t.event.changedTouches,o=0,f=n.length;o1){v=p[0];var x=p[1],b=v[0]-x[0],_=v[1]-x[1];a=b*b+_*_}}function g(){var o,l,c,u,f=t.touches(r);Di.call(r);for(var h=0,p=f.length;h360?t-=360:t<0&&(t+=360),t<60?n+(i-n)*t/60:t<180?i:t<240?n+(i-n)*(240-t)/60:n}(t))}return t=isNaN(t)?0:(t%=360)<0?t+360:t,e=isNaN(e)||e<0?0:e>1?1:e,n=2*(r=r<0?0:r>1?1:r)-(i=r<=.5?r*(1+e):r+e-r*e),new Qt(a(t+120),a(t),a(t-120))}function Ut(e,r,n){return this instanceof Ut?(this.h=+e,this.c=+r,void(this.l=+n)):arguments.length<2?e instanceof Ut?new Ut(e.h,e.c,e.l):Xt(e instanceof qt?e.l:(e=ae((e=t.rgb(e)).r,e.g,e.b)).l,e.a,e.b):new Ut(e,r,n)}Nt.brighter=function(t){return t=Math.pow(.7,arguments.length?t:1),new Bt(this.h,this.s,this.l/t)},Nt.darker=function(t){return t=Math.pow(.7,arguments.length?t:1),new Bt(this.h,this.s,t*this.l)},Nt.rgb=function(){return jt(this.h,this.s,this.l)},t.hcl=Ut;var Vt=Ut.prototype=new Ft;function Ht(t,e,r){return isNaN(t)&&(t=0),isNaN(e)&&(e=0),new qt(r,Math.cos(t*=Lt)*e,Math.sin(t)*e)}function qt(t,e,r){return this instanceof qt?(this.l=+t,this.a=+e,void(this.b=+r)):arguments.length<2?t instanceof qt?new qt(t.l,t.a,t.b):t instanceof Ut?Ht(t.h,t.c,t.l):ae((t=Qt(t)).r,t.g,t.b):new qt(t,e,r)}Vt.brighter=function(t){return new Ut(this.h,this.c,Math.min(100,this.l+Gt*(arguments.length?t:1)))},Vt.darker=function(t){return new Ut(this.h,this.c,Math.max(0,this.l-Gt*(arguments.length?t:1)))},Vt.rgb=function(){return Ht(this.h,this.c,this.l).rgb()},t.lab=qt;var Gt=18,Yt=qt.prototype=new Ft;function Wt(t,e,r){var n=(t+16)/116,i=n+e/500,a=n-r/200;return new Qt(Kt(3.2404542*(i=.95047*Zt(i))-1.5371385*(n=1*Zt(n))-.4985314*(a=1.08883*Zt(a))),Kt(-.969266*i+1.8760108*n+.041556*a),Kt(.0556434*i-.2040259*n+1.0572252*a))}function Xt(t,e,r){return t>0?new Ut(Math.atan2(r,e)*Ct,Math.sqrt(e*e+r*r),t):new Ut(NaN,NaN,t)}function Zt(t){return t>.206893034?t*t*t:(t-4/29)/7.787037}function Jt(t){return t>.008856?Math.pow(t,1/3):7.787037*t+4/29}function Kt(t){return Math.round(255*(t<=.00304?12.92*t:1.055*Math.pow(t,1/2.4)-.055))}function Qt(t,e,r){return this instanceof Qt?(this.r=~~t,this.g=~~e,void(this.b=~~r)):arguments.length<2?t instanceof Qt?new Qt(t.r,t.g,t.b):ne(""+t,Qt,jt):new Qt(t,e,r)}function $t(t){return new Qt(t>>16,t>>8&255,255&t)}function te(t){return $t(t)+""}Yt.brighter=function(t){return new qt(Math.min(100,this.l+Gt*(arguments.length?t:1)),this.a,this.b)},Yt.darker=function(t){return new qt(Math.max(0,this.l-Gt*(arguments.length?t:1)),this.a,this.b)},Yt.rgb=function(){return Wt(this.l,this.a,this.b)},t.rgb=Qt;var ee=Qt.prototype=new Ft;function re(t){return t<16?"0"+Math.max(0,t).toString(16):Math.min(255,t).toString(16)}function ne(t,e,r){var n,i,a,o=0,s=0,l=0;if(n=/([a-z]+)\((.*)\)/.exec(t=t.toLowerCase()))switch(i=n[2].split(","),n[1]){case"hsl":return r(parseFloat(i[0]),parseFloat(i[1])/100,parseFloat(i[2])/100);case"rgb":return e(se(i[0]),se(i[1]),se(i[2]))}return(a=le.get(t))?e(a.r,a.g,a.b):(null==t||"#"!==t.charAt(0)||isNaN(a=parseInt(t.slice(1),16))||(4===t.length?(o=(3840&a)>>4,o|=o>>4,s=240&a,s|=s>>4,l=15&a,l|=l<<4):7===t.length&&(o=(16711680&a)>>16,s=(65280&a)>>8,l=255&a)),e(o,s,l))}function ie(t,e,r){var n,i,a=Math.min(t/=255,e/=255,r/=255),o=Math.max(t,e,r),s=o-a,l=(o+a)/2;return s?(i=l<.5?s/(o+a):s/(2-o-a),n=t==o?(e-r)/s+(e0&&l<1?0:n),new Bt(n,i,l)}function ae(t,e,r){var n=Jt((.4124564*(t=oe(t))+.3575761*(e=oe(e))+.1804375*(r=oe(r)))/.95047),i=Jt((.2126729*t+.7151522*e+.072175*r)/1);return qt(116*i-16,500*(n-i),200*(i-Jt((.0193339*t+.119192*e+.9503041*r)/1.08883)))}function oe(t){return(t/=255)<=.04045?t/12.92:Math.pow((t+.055)/1.055,2.4)}function se(t){var e=parseFloat(t);return"%"===t.charAt(t.length-1)?Math.round(2.55*e):e}ee.brighter=function(t){t=Math.pow(.7,arguments.length?t:1);var e=this.r,r=this.g,n=this.b,i=30;return e||r||n?(e&&e=200&&e<300||304===e){try{t=i.call(o,c)}catch(t){return void s.error.call(o,t)}s.load.call(o,t)}else s.error.call(o,c)}return self.XDomainRequest&&!("withCredentials"in c)&&/^(http(s)?:)?\/\//.test(e)&&(c=new XDomainRequest),"onload"in c?c.onload=c.onerror=f:c.onreadystatechange=function(){c.readyState>3&&f()},c.onprogress=function(e){var r=t.event;t.event=e;try{s.progress.call(o,c)}finally{t.event=r}},o.header=function(t,e){return t=(t+"").toLowerCase(),arguments.length<2?l[t]:(null==e?delete l[t]:l[t]=e+"",o)},o.mimeType=function(t){return arguments.length?(r=null==t?null:t+"",o):r},o.responseType=function(t){return arguments.length?(u=t,o):u},o.response=function(t){return i=t,o},["get","post"].forEach((function(t){o[t]=function(){return o.send.apply(o,[t].concat(n(arguments)))}})),o.send=function(t,n,i){if(2===arguments.length&&"function"==typeof n&&(i=n,n=null),c.open(t,e,!0),null==r||"accept"in l||(l.accept=r+",*/*"),c.setRequestHeader)for(var a in l)c.setRequestHeader(a,l[a]);return null!=r&&c.overrideMimeType&&c.overrideMimeType(r),null!=u&&(c.responseType=u),null!=i&&o.on("error",i).on("load",(function(t){i(null,t)})),s.beforesend.call(o,c),c.send(null==n?null:n),o},o.abort=function(){return c.abort(),o},t.rebind(o,s,"on"),null==a?o:o.get(function(t){return 1===t.length?function(e,r){t(null==e?r:null)}:t}(a))}le.forEach((function(t,e){le.set(t,$t(e))})),t.functor=ce,t.xhr=ue(C),t.dsv=function(t,e){var r=new RegExp('["'+t+"\n]"),n=t.charCodeAt(0);function i(t,r,n){arguments.length<3&&(n=r,r=null);var i=fe(t,e,null==r?a:o(r),n);return i.row=function(t){return arguments.length?i.response(null==(r=t)?a:o(t)):r},i}function a(t){return i.parse(t.responseText)}function o(t){return function(e){return i.parse(e.responseText,t)}}function s(e){return e.map(l).join(t)}function l(t){return r.test(t)?'"'+t.replace(/\"/g,'""')+'"':t}return i.parse=function(t,e){var r;return i.parseRows(t,(function(t,n){if(r)return r(t,n-1);var i=function(e){for(var r={},n=t.length,i=0;i=l)return o;if(i)return i=!1,a;var e=c;if(34===t.charCodeAt(e)){for(var r=e;r++24?(isFinite(e)&&(clearTimeout(me),me=setTimeout(ye,e)),de=0):(de=1,ge(ye))}function xe(){for(var t=Date.now(),e=he;e;)t>=e.t&&e.c(t-e.t)&&(e.c=null),e=e.n;return t}function be(){for(var t,e=he,r=1/0;e;)e.c?(e.t1&&(e=t[a[o-2]],r=t[a[o-1]],n=t[s],(r[0]-e[0])*(n[1]-e[1])-(r[1]-e[1])*(n[0]-e[0])<=0);)--o;a[o++]=s}return a.slice(0,o)}function ke(t,e){return t[0]-e[0]||t[1]-e[1]}t.timer=function(){ve.apply(this,arguments)},t.timer.flush=function(){xe(),be()},t.round=function(t,e){return e?Math.round(t*(e=Math.pow(10,e)))/e:Math.round(t)},t.geom={},t.geom.hull=function(t){var e=_e,r=we;if(arguments.length)return n(t);function n(t){if(t.length<3)return[];var n,i=ce(e),a=ce(r),o=t.length,s=[],l=[];for(n=0;n=0;--n)p.push(t[s[c[n]][2]]);for(n=+f;nkt)s=s.L;else{if(!((i=a-Ve(s,o))>kt)){n>-kt?(e=s.P,r=s):i>-kt?(e=s,r=s.N):e=r=s;break}if(!s.R){e=s;break}s=s.R}var l=Fe(t);if(Pe.insert(e,l),e||r){if(e===r)return We(e),r=Fe(e.site),Pe.insert(l,r),l.edge=r.edge=Je(e.site,l.site),Ye(e),void Ye(r);if(r){We(e),We(r);var c=e.site,u=c.x,f=c.y,h=t.x-u,p=t.y-f,d=r.site,m=d.x-u,g=d.y-f,v=2*(h*g-p*m),y=h*h+p*p,x=m*m+g*g,b={x:(g*y-p*x)/v+u,y:(h*x-m*y)/v+f};Qe(r.edge,c,d,b),l.edge=Je(c,t,null,b),r.edge=Je(t,d,null,b),Ye(e),Ye(r)}else l.edge=Je(e.site,l.site)}}function Ue(t,e){var r=t.site,n=r.x,i=r.y,a=i-e;if(!a)return n;var o=t.P;if(!o)return-1/0;var s=(r=o.site).x,l=r.y,c=l-e;if(!c)return s;var u=s-n,f=1/a-1/c,h=u/c;return f?(-h+Math.sqrt(h*h-2*f*(u*u/(-2*c)-l+c/2+i-a/2)))/f+n:(n+s)/2}function Ve(t,e){var r=t.N;if(r)return Ue(r,e);var n=t.site;return n.y===e?n.x:1/0}function He(t){this.site=t,this.edges=[]}function qe(t,e){return e.angle-t.angle}function Ge(){er(this),this.x=this.y=this.arc=this.site=this.cy=null}function Ye(t){var e=t.P,r=t.N;if(e&&r){var n=e.site,i=t.site,a=r.site;if(n!==a){var o=i.x,s=i.y,l=n.x-o,c=n.y-s,u=a.x-o,f=2*(l*(g=a.y-s)-c*u);if(!(f>=-1e-12)){var h=l*l+c*c,p=u*u+g*g,d=(g*h-c*p)/f,m=(l*p-u*h)/f,g=m+s,v=De.pop()||new Ge;v.arc=t,v.site=i,v.x=d+o,v.y=g+Math.sqrt(d*d+m*m),v.cy=g,t.circle=v;for(var y=null,x=Oe._;x;)if(v.y=s)return;if(h>d){if(a){if(a.y>=c)return}else a={x:g,y:l};r={x:g,y:c}}else{if(a){if(a.y1)if(h>d){if(a){if(a.y>=c)return}else a={x:(l-i)/n,y:l};r={x:(c-i)/n,y:c}}else{if(a){if(a.y=s)return}else a={x:o,y:n*o+i};r={x:s,y:n*s+i}}else{if(a){if(a.x0)){if(e/=h,h<0){if(e0){if(e>f)return;e>u&&(u=e)}if(e=i-l,h||!(e<0)){if(e/=h,h<0){if(e>f)return;e>u&&(u=e)}else if(h>0){if(e0)){if(e/=p,p<0){if(e0){if(e>f)return;e>u&&(u=e)}if(e=a-c,p||!(e<0)){if(e/=p,p<0){if(e>f)return;e>u&&(u=e)}else if(p>0){if(e0&&(t.a={x:l+u*h,y:c+u*p}),f<1&&(t.b={x:l+f*h,y:c+f*p}),t}}}}}),l=o.length;l--;)(!Xe(e=o[l],t)||!s(e)||y(e.a.x-e.b.x)kt||y(i-r)>kt)&&(s.splice(o,0,new $e(Ke(a.site,u,y(n-f)kt?{x:f,y:y(e-f)kt?{x:y(r-d)kt?{x:h,y:y(e-h)kt?{x:y(r-p)=r&&c.x<=i&&c.y>=n&&c.y<=o?[[r,o],[i,o],[i,n],[r,n]]:[]).point=t[s]})),e}function s(t){return t.map((function(t,e){return{x:Math.round(n(t,e)/kt)*kt,y:Math.round(i(t,e)/kt)*kt,i:e}}))}return o.links=function(t){return ar(s(t)).edges.filter((function(t){return t.l&&t.r})).map((function(e){return{source:t[e.l.i],target:t[e.r.i]}}))},o.triangles=function(t){var e=[];return ar(s(t)).cells.forEach((function(r,n){for(var i,a,o,s,l=r.site,c=r.edges.sort(qe),u=-1,f=c.length,h=c[f-1].edge,p=h.l===l?h.r:h.l;++ua||f>o||h=_)<<1|e>=b,T=w+4;wa&&(i=e.slice(a,i),s[o]?s[o]+=i:s[++o]=i),(r=r[0])===(n=n[0])?s[o]?s[o]+=n:s[++o]=n:(s[++o]=null,l.push({i:o,x:dr(r,n)})),a=vr.lastIndex;return am&&(m=l.x),l.y>g&&(g=l.y),c.push(l.x),u.push(l.y);else for(f=0;fm&&(m=b),_>g&&(g=_),c.push(b),u.push(_)}var w=m-p,T=g-d;function k(t,e,r,n,i,a,o,s){if(!isNaN(r)&&!isNaN(n))if(t.leaf){var l=t.x,c=t.y;if(null!=l)if(y(l-r)+y(c-n)<.01)A(t,e,r,n,i,a,o,s);else{var u=t.point;t.x=t.y=t.point=null,A(t,u,l,c,i,a,o,s),A(t,e,r,n,i,a,o,s)}else t.x=r,t.y=n,t.point=e}else A(t,e,r,n,i,a,o,s)}function A(t,e,r,n,i,a,o,s){var l=.5*(i+o),c=.5*(a+s),u=r>=l,f=n>=c,h=f<<1|u;t.leaf=!1,u?i=l:o=l,f?a=c:s=c,k(t=t.nodes[h]||(t.nodes[h]={leaf:!0,nodes:[],point:null,x:null,y:null}),e,r,n,i,a,o,s)}w>T?g=d+w:m=p+T;var M={leaf:!0,nodes:[],point:null,x:null,y:null,add:function(t){k(M,t,+v(t,++f),+x(t,f),p,d,m,g)},visit:function(t){ur(t,M,p,d,m,g)},find:function(t){return fr(M,t[0],t[1],p,d,m,g)}};if(f=-1,null==e){for(;++f=0&&!(n=t.interpolators[i](e,r)););return n}function xr(t,e){var r,n=[],i=[],a=t.length,o=e.length,s=Math.min(t.length,e.length);for(r=0;r=1?1:t(e)}}function kr(t){return function(e){return 1-t(1-e)}}function Ar(t){return function(e){return.5*(e<.5?t(2*e):2-t(2-2*e))}}function Mr(t){return t*t}function Sr(t){return t*t*t}function Er(t){if(t<=0)return 0;if(t>=1)return 1;var e=t*t,r=e*t;return 4*(t<.5?r:3*(t-e)+r-.75)}function Lr(t){return 1-Math.cos(t*Et)}function Cr(t){return Math.pow(2,10*(t-1))}function Pr(t){return 1-Math.sqrt(1-t*t)}function Ir(t){return t<1/2.75?7.5625*t*t:t<2/2.75?7.5625*(t-=1.5/2.75)*t+.75:t<2.5/2.75?7.5625*(t-=2.25/2.75)*t+.9375:7.5625*(t-=2.625/2.75)*t+.984375}function Or(t,e){return e-=t,function(r){return Math.round(t+e*r)}}function zr(t){var e,r,n,i=[t.a,t.b],a=[t.c,t.d],o=Rr(i),s=Dr(i,a),l=Rr(((e=a)[0]+=(n=-s)*(r=i)[0],e[1]+=n*r[1],e))||0;i[0]*a[1]=0?t.slice(0,e):t,i=e>=0?t.slice(e+1):"in";return n=_r.get(n)||br,Tr((i=wr.get(i)||C)(n.apply(null,r.call(arguments,1))))},t.interpolateHcl=function(e,r){e=t.hcl(e),r=t.hcl(r);var n=e.h,i=e.c,a=e.l,o=r.h-n,s=r.c-i,l=r.l-a;isNaN(s)&&(s=0,i=isNaN(i)?r.c:i);isNaN(o)?(o=0,n=isNaN(n)?r.h:n):o>180?o-=360:o<-180&&(o+=360);return function(t){return Ht(n+o*t,i+s*t,a+l*t)+""}},t.interpolateHsl=function(e,r){e=t.hsl(e),r=t.hsl(r);var n=e.h,i=e.s,a=e.l,o=r.h-n,s=r.s-i,l=r.l-a;isNaN(s)&&(s=0,i=isNaN(i)?r.s:i);isNaN(o)?(o=0,n=isNaN(n)?r.h:n):o>180?o-=360:o<-180&&(o+=360);return function(t){return jt(n+o*t,i+s*t,a+l*t)+""}},t.interpolateLab=function(e,r){e=t.lab(e),r=t.lab(r);var n=e.l,i=e.a,a=e.b,o=r.l-n,s=r.a-i,l=r.b-a;return function(t){return Wt(n+o*t,i+s*t,a+l*t)+""}},t.interpolateRound=Or,t.transform=function(e){var r=i.createElementNS(t.ns.prefix.svg,"g");return(t.transform=function(t){if(null!=t){r.setAttribute("transform",t);var e=r.transform.baseVal.consolidate()}return new zr(e?e.matrix:Fr)})(e)},zr.prototype.toString=function(){return"translate("+this.translate+")rotate("+this.rotate+")skewX("+this.skew+")scale("+this.scale+")"};var Fr={a:1,b:0,c:0,d:1,e:0,f:0};function Br(t){return t.length?t.pop()+",":""}function Nr(e,r){var n=[],i=[];return e=t.transform(e),r=t.transform(r),function(t,e,r,n){if(t[0]!==e[0]||t[1]!==e[1]){var i=r.push("translate(",null,",",null,")");n.push({i:i-4,x:dr(t[0],e[0])},{i:i-2,x:dr(t[1],e[1])})}else(e[0]||e[1])&&r.push("translate("+e+")")}(e.translate,r.translate,n,i),function(t,e,r,n){t!==e?(t-e>180?e+=360:e-t>180&&(t+=360),n.push({i:r.push(Br(r)+"rotate(",null,")")-2,x:dr(t,e)})):e&&r.push(Br(r)+"rotate("+e+")")}(e.rotate,r.rotate,n,i),function(t,e,r,n){t!==e?n.push({i:r.push(Br(r)+"skewX(",null,")")-2,x:dr(t,e)}):e&&r.push(Br(r)+"skewX("+e+")")}(e.skew,r.skew,n,i),function(t,e,r,n){if(t[0]!==e[0]||t[1]!==e[1]){var i=r.push(Br(r)+"scale(",null,",",null,")");n.push({i:i-4,x:dr(t[0],e[0])},{i:i-2,x:dr(t[1],e[1])})}else 1===e[0]&&1===e[1]||r.push(Br(r)+"scale("+e+")")}(e.scale,r.scale,n,i),e=r=null,function(t){for(var e,r=-1,a=i.length;++r0?n=t:(e.c=null,e.t=NaN,e=null,l.end({type:"end",alpha:n=0})):t>0&&(l.start({type:"start",alpha:n=t}),e=ve(s.tick)),s):n},s.start=function(){var t,e,r,n=v.length,l=y.length,u=c[0],d=c[1];for(t=0;t=0;)r.push(i[n])}function $r(t,e){for(var r=[t],n=[];null!=(t=r.pop());)if(n.push(t),(a=t.children)&&(i=a.length))for(var i,a,o=-1;++o=0;)o.push(u=c[l]),u.parent=a,u.depth=a.depth+1;r&&(a.value=0),a.children=c}else r&&(a.value=+r.call(n,a,a.depth)||0),delete a.children;return $r(i,(function(e){var n,i;t&&(n=e.children)&&n.sort(t),r&&(i=e.parent)&&(i.value+=e.value)})),s}return n.sort=function(e){return arguments.length?(t=e,n):t},n.children=function(t){return arguments.length?(e=t,n):e},n.value=function(t){return arguments.length?(r=t,n):r},n.revalue=function(t){return r&&(Qr(t,(function(t){t.children&&(t.value=0)})),$r(t,(function(t){var e;t.children||(t.value=+r.call(n,t,t.depth)||0),(e=t.parent)&&(e.value+=t.value)}))),t},n},t.layout.partition=function(){var e=t.layout.hierarchy(),r=[1,1];function n(t,n){var i=e.call(this,t,n);return function t(e,r,n,i){var a=e.children;if(e.x=r,e.y=e.depth*i,e.dx=n,e.dy=i,a&&(o=a.length)){var o,s,l,c=-1;for(n=e.value?n/e.value:0;++cs&&(s=n),o.push(n)}for(r=0;ri&&(n=r,i=e);return n}function dn(t){return t.reduce(mn,0)}function mn(t,e){return t+e[1]}function gn(t,e){return vn(t,Math.ceil(Math.log(e.length)/Math.LN2+1))}function vn(t,e){for(var r=-1,n=+t[0],i=(t[1]-n)/e,a=[];++r<=e;)a[r]=i*r+n;return a}function yn(e){return[t.min(e),t.max(e)]}function xn(t,e){return t.value-e.value}function bn(t,e){var r=t._pack_next;t._pack_next=e,e._pack_prev=t,e._pack_next=r,r._pack_prev=e}function _n(t,e){t._pack_next=e,e._pack_prev=t}function wn(t,e){var r=e.x-t.x,n=e.y-t.y,i=t.r+e.r;return.999*i*i>r*r+n*n}function Tn(t){if((e=t.children)&&(l=e.length)){var e,r,n,i,a,o,s,l,c=1/0,u=-1/0,f=1/0,h=-1/0;if(e.forEach(kn),(r=e[0]).x=-r.r,r.y=0,x(r),l>1&&((n=e[1]).x=n.r,n.y=0,x(n),l>2))for(Mn(r,n,i=e[2]),x(i),bn(r,i),r._pack_prev=i,bn(i,n),n=r._pack_next,a=3;a0)for(o=-1;++o=f[0]&&l<=f[1]&&((s=c[t.bisect(h,l,1,d)-1]).y+=m,s.push(a[o]));return c}return a.value=function(t){return arguments.length?(r=t,a):r},a.range=function(t){return arguments.length?(n=ce(t),a):n},a.bins=function(t){return arguments.length?(i="number"==typeof t?function(e){return vn(e,t)}:ce(t),a):i},a.frequency=function(t){return arguments.length?(e=!!t,a):e},a},t.layout.pack=function(){var e,r=t.layout.hierarchy().sort(xn),n=0,i=[1,1];function a(t,a){var o=r.call(this,t,a),s=o[0],l=i[0],c=i[1],u=null==e?Math.sqrt:"function"==typeof e?e:function(){return e};if(s.x=s.y=0,$r(s,(function(t){t.r=+u(t.value)})),$r(s,Tn),n){var f=n*(e?1:Math.max(2*s.r/l,2*s.r/c))/2;$r(s,(function(t){t.r+=f})),$r(s,Tn),$r(s,(function(t){t.r-=f}))}return function t(e,r,n,i){var a=e.children;if(e.x=r+=i*e.x,e.y=n+=i*e.y,e.r*=i,a)for(var o=-1,s=a.length;++op.x&&(p=t),t.depth>d.depth&&(d=t)}));var m=r(h,p)/2-h.x,g=n[0]/(p.x+r(p,h)/2+m),v=n[1]/(d.depth||1);Qr(u,(function(t){t.x=(t.x+m)*g,t.y=t.depth*v}))}return c}function o(t){var e=t.children,n=t.parent.children,i=t.i?n[t.i-1]:null;if(e.length){!function(t){var e,r=0,n=0,i=t.children,a=i.length;for(;--a>=0;)(e=i[a]).z+=r,e.m+=r,r+=e.s+(n+=e.c)}(t);var a=(e[0].z+e[e.length-1].z)/2;i?(t.z=i.z+r(t._,i._),t.m=t.z-a):t.z=a}else i&&(t.z=i.z+r(t._,i._));t.parent.A=function(t,e,n){if(e){for(var i,a=t,o=t,s=e,l=a.parent.children[0],c=a.m,u=o.m,f=s.m,h=l.m;s=Ln(s),a=En(a),s&&a;)l=En(l),(o=Ln(o)).a=t,(i=s.z+f-a.z-c+r(s._,a._))>0&&(Cn(Pn(s,t,n),t,i),c+=i,u+=i),f+=s.m,c+=a.m,h+=l.m,u+=o.m;s&&!Ln(o)&&(o.t=s,o.m+=f-u),a&&!En(l)&&(l.t=a,l.m+=c-h,n=t)}return n}(t,i,t.parent.A||n[0])}function s(t){t._.x=t.z+t.parent.m,t.m+=t.parent.m}function l(t){t.x*=n[0],t.y=t.depth*n[1]}return a.separation=function(t){return arguments.length?(r=t,a):r},a.size=function(t){return arguments.length?(i=null==(n=t)?l:null,a):i?null:n},a.nodeSize=function(t){return arguments.length?(i=null==(n=t)?null:l,a):i?n:null},Kr(a,e)},t.layout.cluster=function(){var e=t.layout.hierarchy().sort(null).value(null),r=Sn,n=[1,1],i=!1;function a(a,o){var s,l=e.call(this,a,o),c=l[0],u=0;$r(c,(function(e){var n=e.children;n&&n.length?(e.x=function(t){return t.reduce((function(t,e){return t+e.x}),0)/t.length}(n),e.y=function(e){return 1+t.max(e,(function(t){return t.y}))}(n)):(e.x=s?u+=r(e,s):0,e.y=0,s=e)}));var f=function t(e){var r=e.children;return r&&r.length?t(r[0]):e}(c),h=function t(e){var r,n=e.children;return n&&(r=n.length)?t(n[r-1]):e}(c),p=f.x-r(f,h)/2,d=h.x+r(h,f)/2;return $r(c,i?function(t){t.x=(t.x-c.x)*n[0],t.y=(c.y-t.y)*n[1]}:function(t){t.x=(t.x-p)/(d-p)*n[0],t.y=(1-(c.y?t.y/c.y:1))*n[1]}),l}return a.separation=function(t){return arguments.length?(r=t,a):r},a.size=function(t){return arguments.length?(i=null==(n=t),a):i?null:n},a.nodeSize=function(t){return arguments.length?(i=null!=(n=t),a):i?n:null},Kr(a,e)},t.layout.treemap=function(){var e,r=t.layout.hierarchy(),n=Math.round,i=[1,1],a=null,o=In,s=!1,l="squarify",c=.5*(1+Math.sqrt(5));function u(t,e){for(var r,n,i=-1,a=t.length;++i0;)s.push(r=c[i-1]),s.area+=r.area,"squarify"!==l||(n=p(s,m))<=h?(c.pop(),h=n):(s.area-=s.pop().area,d(s,m,a,!1),m=Math.min(a.dx,a.dy),s.length=s.area=0,h=1/0);s.length&&(d(s,m,a,!0),s.length=s.area=0),e.forEach(f)}}function h(t){var e=t.children;if(e&&e.length){var r,n=o(t),i=e.slice(),a=[];for(u(i,n.dx*n.dy/t.value),a.area=0;r=i.pop();)a.push(r),a.area+=r.area,null!=r.z&&(d(a,r.z?n.dx:n.dy,n,!i.length),a.length=a.area=0);e.forEach(h)}}function p(t,e){for(var r,n=t.area,i=0,a=1/0,o=-1,s=t.length;++oi&&(i=r));return e*=e,(n*=n)?Math.max(e*i*c/n,n/(e*a*c)):1/0}function d(t,e,r,i){var a,o=-1,s=t.length,l=r.x,c=r.y,u=e?n(t.area/e):0;if(e==r.dx){for((i||u>r.dy)&&(u=r.dy);++or.dx)&&(u=r.dx);++o1);return t+e*r*Math.sqrt(-2*Math.log(i)/i)}},logNormal:function(){var e=t.random.normal.apply(t,arguments);return function(){return Math.exp(e())}},bates:function(e){var r=t.random.irwinHall(e);return function(){return r()/e}},irwinHall:function(t){return function(){for(var e=0,r=0;r2?jn:Rn,s=i?Ur:jr;return a=t(e,r,s,n),o=t(r,e,s,yr),l}function l(t){return a(t)}return l.invert=function(t){return o(t)},l.domain=function(t){return arguments.length?(e=t.map(Number),s()):e},l.range=function(t){return arguments.length?(r=t,s()):r},l.rangeRound=function(t){return l.range(t).interpolate(Or)},l.clamp=function(t){return arguments.length?(i=t,s()):i},l.interpolate=function(t){return arguments.length?(n=t,s()):n},l.ticks=function(t){return qn(e,t)},l.tickFormat=function(t,r){return d3_scale_linearTickFormat(e,t,r)},l.nice=function(t){return Vn(e,t),s()},l.copy=function(){return t(e,r,n,i)},s()}([0,1],[0,1],yr,!1)};t.scale.log=function(){return function t(e,r,n,i){function a(t){return(n?Math.log(t<0?0:t):-Math.log(t>0?0:-t))/Math.log(r)}function o(t){return n?Math.pow(r,t):-Math.pow(r,-t)}function s(t){return e(a(t))}return s.invert=function(t){return o(e.invert(t))},s.domain=function(t){return arguments.length?(n=t[0]>=0,e.domain((i=t.map(Number)).map(a)),s):i},s.base=function(t){return arguments.length?(r=+t,e.domain(i.map(a)),s):r},s.nice=function(){var t=Fn(i.map(a),n?Math:Gn);return e.domain(t),i=t.map(o),s},s.ticks=function(){var t=zn(i),e=[],s=t[0],l=t[1],c=Math.floor(a(s)),u=Math.ceil(a(l)),f=r%1?2:r;if(isFinite(u-c)){if(n){for(;c0;h--)e.push(o(c)*h);for(c=0;e[c]l;u--);e=e.slice(c,u)}return e},s.copy=function(){return t(e.copy(),r,n,i)},Un(s,e)}(t.scale.linear().domain([0,1]),10,!0,[1,10])};var Gn={floor:function(t){return-Math.ceil(-t)},ceil:function(t){return-Math.floor(-t)}};function Yn(t){return function(e){return e<0?-Math.pow(-e,t):Math.pow(e,t)}}t.scale.pow=function(){return function t(e,r,n){var i=Yn(r),a=Yn(1/r);function o(t){return e(i(t))}return o.invert=function(t){return a(e.invert(t))},o.domain=function(t){return arguments.length?(e.domain((n=t.map(Number)).map(i)),o):n},o.ticks=function(t){return qn(n,t)},o.tickFormat=function(t,e){return d3_scale_linearTickFormat(n,t,e)},o.nice=function(t){return o.domain(Vn(n,t))},o.exponent=function(t){return arguments.length?(i=Yn(r=t),a=Yn(1/r),e.domain(n.map(i)),o):r},o.copy=function(){return t(e.copy(),r,n)},Un(o,e)}(t.scale.linear(),1,[0,1])},t.scale.sqrt=function(){return t.scale.pow().exponent(.5)},t.scale.ordinal=function(){return function e(r,n){var i,a,o;function s(t){return a[((i.get(t)||("range"===n.t?i.set(t,r.push(t)):NaN))-1)%a.length]}function l(e,n){return t.range(r.length).map((function(t){return e+n*t}))}return s.domain=function(t){if(!arguments.length)return r;r=[],i=new _;for(var e,a=-1,o=t.length;++a0?i[t-1]:r[0],tf?0:1;if(c=St)return l(c,p)+(s?l(s,1-p):"")+"Z";var d,m,g,v,y,x,b,_,w,T,k,A,M=0,S=0,E=[];if((v=(+o.apply(this,arguments)||0)/2)&&(g=n===Qn?Math.sqrt(s*s+c*c):+n.apply(this,arguments),p||(S*=-1),c&&(S=Pt(g/c*Math.sin(v))),s&&(M=Pt(g/s*Math.sin(v)))),c){y=c*Math.cos(u+S),x=c*Math.sin(u+S),b=c*Math.cos(f-S),_=c*Math.sin(f-S);var L=Math.abs(f-u-2*S)<=At?0:1;if(S&&ii(y,x,b,_)===p^L){var C=(u+f)/2;y=c*Math.cos(C),x=c*Math.sin(C),b=_=null}}else y=x=0;if(s){w=s*Math.cos(f-M),T=s*Math.sin(f-M),k=s*Math.cos(u+M),A=s*Math.sin(u+M);var P=Math.abs(u-f+2*M)<=At?0:1;if(M&&ii(w,T,k,A)===1-p^P){var I=(u+f)/2;w=s*Math.cos(I),T=s*Math.sin(I),k=A=null}}else w=T=0;if(h>kt&&(d=Math.min(Math.abs(c-s)/2,+r.apply(this,arguments)))>.001){m=s0?0:1}function ai(t,e,r,n,i){var a=t[0]-e[0],o=t[1]-e[1],s=(i?n:-n)/Math.sqrt(a*a+o*o),l=s*o,c=-s*a,u=t[0]+l,f=t[1]+c,h=e[0]+l,p=e[1]+c,d=(u+h)/2,m=(f+p)/2,g=h-u,v=p-f,y=g*g+v*v,x=r-n,b=u*p-h*f,_=(v<0?-1:1)*Math.sqrt(Math.max(0,x*x*y-b*b)),w=(b*v-g*_)/y,T=(-b*g-v*_)/y,k=(b*v+g*_)/y,A=(-b*g+v*_)/y,M=w-d,S=T-m,E=k-d,L=A-m;return M*M+S*S>E*E+L*L&&(w=k,T=A),[[w-l,T-c],[w*r/x,T*r/x]]}function oi(){return!0}function si(t){var e=_e,r=we,n=oi,i=ci,a=i.key,o=.7;function s(a){var s,l=[],c=[],u=-1,f=a.length,h=ce(e),p=ce(r);function d(){l.push("M",i(t(c),o))}for(;++u1&&i.push("H",n[0]);return i.join("")},"step-before":fi,"step-after":hi,basis:mi,"basis-open":function(t){if(t.length<4)return ci(t);var e,r=[],n=-1,i=t.length,a=[0],o=[0];for(;++n<3;)e=t[n],a.push(e[0]),o.push(e[1]);r.push(gi(xi,a)+","+gi(xi,o)),--n;for(;++n9&&(i=3*e/Math.sqrt(i),o[s]=i*r,o[s+1]=i*n));s=-1;for(;++s<=l;)i=(t[Math.min(l,s+1)][0]-t[Math.max(0,s-1)][0])/(6*(1+o[s]*o[s])),a.push([i||0,o[s]*i||0]);return a}(t))}});function ci(t){return t.length>1?t.join("L"):t+"Z"}function ui(t){return t.join("L")+"Z"}function fi(t){for(var e=0,r=t.length,n=t[0],i=[n[0],",",n[1]];++e1){s=e[1],a=t[l],l++,n+="C"+(i[0]+o[0])+","+(i[1]+o[1])+","+(a[0]-s[0])+","+(a[1]-s[1])+","+a[0]+","+a[1];for(var c=2;cAt)+",1 "+e}function l(t,e,r,n){return"Q 0,0 "+n}return a.radius=function(t){return arguments.length?(r=ce(t),a):r},a.source=function(e){return arguments.length?(t=ce(e),a):t},a.target=function(t){return arguments.length?(e=ce(t),a):e},a.startAngle=function(t){return arguments.length?(n=ce(t),a):n},a.endAngle=function(t){return arguments.length?(i=ce(t),a):i},a},t.svg.diagonal=function(){var t=ki,e=Ai,r=Si;function n(n,i){var a=t.call(this,n,i),o=e.call(this,n,i),s=(a.y+o.y)/2,l=[a,{x:a.x,y:s},{x:o.x,y:s},o];return"M"+(l=l.map(r))[0]+"C"+l[1]+" "+l[2]+" "+l[3]}return n.source=function(e){return arguments.length?(t=ce(e),n):t},n.target=function(t){return arguments.length?(e=ce(t),n):e},n.projection=function(t){return arguments.length?(r=t,n):r},n},t.svg.diagonal.radial=function(){var e=t.svg.diagonal(),r=Si,n=e.projection;return e.projection=function(t){return arguments.length?n(Ei(r=t)):r},e},t.svg.symbol=function(){var t=Ci,e=Li;function r(r,n){return(Ii.get(t.call(this,r,n))||Pi)(e.call(this,r,n))}return r.type=function(e){return arguments.length?(t=ce(e),r):t},r.size=function(t){return arguments.length?(e=ce(t),r):e},r};var Ii=t.map({circle:Pi,cross:function(t){var e=Math.sqrt(t/5)/2;return"M"+-3*e+","+-e+"H"+-e+"V"+-3*e+"H"+e+"V"+-e+"H"+3*e+"V"+e+"H"+e+"V"+3*e+"H"+-e+"V"+e+"H"+-3*e+"Z"},diamond:function(t){var e=Math.sqrt(t/(2*zi)),r=e*zi;return"M0,"+-e+"L"+r+",0 0,"+e+" "+-r+",0Z"},square:function(t){var e=Math.sqrt(t)/2;return"M"+-e+","+-e+"L"+e+","+-e+" "+e+","+e+" "+-e+","+e+"Z"},"triangle-down":function(t){var e=Math.sqrt(t/Oi),r=e*Oi/2;return"M0,"+r+"L"+e+","+-r+" "+-e+","+-r+"Z"},"triangle-up":function(t){var e=Math.sqrt(t/Oi),r=e*Oi/2;return"M0,"+-r+"L"+e+","+r+" "+-e+","+r+"Z"}});t.svg.symbolTypes=Ii.keys();var Oi=Math.sqrt(3),zi=Math.tan(30*Lt);Y.transition=function(t){for(var e,r,n=Bi||++Ui,i=qi(t),a=[],o=Ni||{time:Date.now(),ease:Er,delay:0,duration:250},s=-1,l=this.length;++s0;)c[--h].call(t,o);if(a>=1)return f.event&&f.event.end.call(t,t.__data__,e),--u.count?delete u[n]:delete t[r],1}f||(a=i.time,o=ve((function(t){var e=f.delay;if(o.t=e+a,e<=t)return h(t-e);o.c=h}),0,a),f=u[n]={tween:new _,time:a,timer:o,delay:i.delay,duration:i.duration,ease:i.ease,index:e},i=null,++u.count)}ji.call=Y.call,ji.empty=Y.empty,ji.node=Y.node,ji.size=Y.size,t.transition=function(e,r){return e&&e.transition?Bi?e.transition(r):e:t.selection().transition(e)},t.transition.prototype=ji,ji.select=function(t){var e,r,n,i=this.id,a=this.namespace,o=[];t=W(t);for(var s=-1,l=this.length;++srect,.s>rect").attr("width",s[1]-s[0])}function m(t){t.select(".extent").attr("y",l[0]),t.selectAll(".extent,.e>rect,.w>rect").attr("height",l[1]-l[0])}function g(){var f,g,v=this,y=t.select(t.event.target),x=n.of(v,arguments),b=t.select(v),_=y.datum(),w=!/^(n|s)$/.test(_)&&i,T=!/^(e|w)$/.test(_)&&a,k=y.classed("extent"),A=bt(v),M=t.mouse(v),S=t.select(o(v)).on("keydown.brush",C).on("keyup.brush",P);if(t.event.changedTouches?S.on("touchmove.brush",I).on("touchend.brush",z):S.on("mousemove.brush",I).on("mouseup.brush",z),b.interrupt().selectAll("*").interrupt(),k)M[0]=s[0]-M[0],M[1]=l[0]-M[1];else if(_){var E=+/w$/.test(_),L=+/^n/.test(_);g=[s[1-E]-M[0],l[1-L]-M[1]],M[0]=s[E],M[1]=l[L]}else t.event.altKey&&(f=M.slice());function C(){32==t.event.keyCode&&(k||(f=null,M[0]-=s[1],M[1]-=l[1],k=2),F())}function P(){32==t.event.keyCode&&2==k&&(M[0]+=s[1],M[1]+=l[1],k=0,F())}function I(){var e=t.mouse(v),r=!1;g&&(e[0]+=g[0],e[1]+=g[1]),k||(t.event.altKey?(f||(f=[(s[0]+s[1])/2,(l[0]+l[1])/2]),M[0]=s[+(e[0]>>1;e.dtype||(e.dtype="array"),"string"==typeof e.dtype?d=new(f(e.dtype))(g):e.dtype&&(d=e.dtype,Array.isArray(d)&&(d.length=g));for(var v=0;vr||s>1073741824){for(var h=0;he+n||w>r+n||T=A||a===o)){var s=y[i];void 0===o&&(o=s.length);for(var l=a;l=d&&u<=g&&f>=m&&f<=v&&S.push(c)}var h=x[i],p=h[4*a+0],b=h[4*a+1],M=h[4*a+2],E=h[4*a+3],P=C(h,a+1),I=.5*n,O=i+1;L(e,r,I,O,p,b||M||E||P),L(e,r+I,I,O,b,M||E||P),L(e+I,r,I,O,M,E||P),L(e+I,r+I,I,O,E,P)}}function C(t,e){for(var r=null,n=0;null===r;)if(r=t[4*e+n],++n>t.length)return null;return r}return L(0,0,1,0,0,1),S},d;function E(t,e,r,i,a){for(var o=[],s=0;s0){e+=Math.abs(a(t[0]));for(var r=1;r2){for(s=0;st[0]&&(e[0]=t[0]),e[1]>t[1]&&(e[1]=t[1]),e[2]=0))throw new Error("precision must be a positive number");var r=Math.pow(10,e||0);return Math.round(t*r)/r},r.radiansToLength=f,r.lengthToRadians=h,r.lengthToDegrees=function(t,e){return p(h(t,e))},r.bearingToAzimuth=function(t){var e=t%360;return e<0&&(e+=360),e},r.radiansToDegrees=p,r.degreesToRadians=function(t){return t%360*Math.PI/180},r.convertLength=function(t,e,r){if(void 0===e&&(e="kilometers"),void 0===r&&(r="kilometers"),!(t>=0))throw new Error("length must be a positive number");return f(h(t,e),r)},r.convertArea=function(t,e,n){if(void 0===e&&(e="meters"),void 0===n&&(n="kilometers"),!(t>=0))throw new Error("area must be a positive number");var i=r.areaFactors[e];if(!i)throw new Error("invalid original units");var a=r.areaFactors[n];if(!a)throw new Error("invalid final units");return t/i*a},r.isNumber=d,r.isObject=function(t){return!!t&&t.constructor===Object},r.validateBBox=function(t){if(!t)throw new Error("bbox is required");if(!Array.isArray(t))throw new Error("bbox must be an Array");if(4!==t.length&&6!==t.length)throw new Error("bbox must be an Array of 4 or 6 numbers");t.forEach((function(t){if(!d(t))throw new Error("bbox must only contain numbers")}))},r.validateId=function(t){if(!t)throw new Error("id is required");if(-1===["string","number"].indexOf(typeof t))throw new Error("id must be a number or a string")}},{}],65:[function(t,e,r){"use strict";Object.defineProperty(r,"__esModule",{value:!0});var n=t("@turf/helpers");function i(t,e,r){if(null!==t)for(var n,a,o,s,l,c,u,f,h=0,p=0,d=t.type,m="FeatureCollection"===d,g="Feature"===d,v=m?t.features.length:1,y=0;yc||p>u||d>f)return l=i,c=r,u=p,f=d,void(o=0);var m=n.lineString([l,i],t.properties);if(!1===e(m,r,a,d,o))return!1;o++,l=i}))&&void 0}}}))}function u(t,e){if(!t)throw new Error("geojson is required");l(t,(function(t,r,i){if(null!==t.geometry){var a=t.geometry.type,o=t.geometry.coordinates;switch(a){case"LineString":if(!1===e(t,r,i,0,0))return!1;break;case"Polygon":for(var s=0;si&&(i=t[o]),t[o]:not(.watermark)":"opacity:0;-webkit-transition:opacity .3s ease 0s;-moz-transition:opacity .3s ease 0s;-ms-transition:opacity .3s ease 0s;-o-transition:opacity .3s ease 0s;transition:opacity .3s ease 0s;","X:hover .modebar--hover .modebar-group":"opacity:1;","X .modebar-group":"float:left;display:inline-block;box-sizing:border-box;padding-left:8px;position:relative;vertical-align:middle;white-space:nowrap;","X .modebar-btn":"position:relative;font-size:16px;padding:3px 4px;height:22px;cursor:pointer;line-height:normal;box-sizing:border-box;","X .modebar-btn svg":"position:relative;top:2px;","X .modebar.vertical":"display:flex;flex-direction:column;flex-wrap:wrap;align-content:flex-end;max-height:100%;","X .modebar.vertical svg":"top:-1px;","X .modebar.vertical .modebar-group":"display:block;float:none;padding-left:0px;padding-bottom:8px;","X .modebar.vertical .modebar-group .modebar-btn":"display:block;text-align:center;","X [data-title]:before,X [data-title]:after":"position:absolute;-webkit-transform:translate3d(0, 0, 0);-moz-transform:translate3d(0, 0, 0);-ms-transform:translate3d(0, 0, 0);-o-transform:translate3d(0, 0, 0);transform:translate3d(0, 0, 0);display:none;opacity:0;z-index:1001;pointer-events:none;top:110%;right:50%;","X [data-title]:hover:before,X [data-title]:hover:after":"display:block;opacity:1;","X [data-title]:before":'content:"";position:absolute;background:transparent;border:6px solid transparent;z-index:1002;margin-top:-12px;border-bottom-color:#69738a;margin-right:-6px;',"X [data-title]:after":"content:attr(data-title);background:#69738a;color:#fff;padding:8px 10px;font-size:12px;line-height:12px;white-space:nowrap;margin-right:-18px;border-radius:2px;","X .vertical [data-title]:before,X .vertical [data-title]:after":"top:0%;right:200%;","X .vertical [data-title]:before":"border:6px solid transparent;border-left-color:#69738a;margin-top:8px;margin-right:-30px;","X .select-outline":"fill:none;stroke-width:1;shape-rendering:crispEdges;","X .select-outline-1":"stroke:#fff;","X .select-outline-2":"stroke:#000;stroke-dasharray:2px 2px;",Y:'font-family:"Open Sans",verdana,arial,sans-serif;position:fixed;top:50px;right:20px;z-index:10000;font-size:10pt;max-width:180px;',"Y p":"margin:0;","Y .notifier-note":"min-width:180px;max-width:250px;border:1px solid #fff;z-index:3000;margin:0;background-color:#8c97af;background-color:rgba(140,151,175,.9);color:#fff;padding:10px;overflow-wrap:break-word;word-wrap:break-word;-ms-hyphens:auto;-webkit-hyphens:auto;hyphens:auto;","Y .notifier-close":"color:#fff;opacity:.8;float:right;padding:0 5px;background:none;border:none;font-size:20px;font-weight:bold;line-height:20px;","Y .notifier-close:hover":"color:#444;text-decoration:none;cursor:pointer;"};for(var a in i){var o=a.replace(/^,/," ,").replace(/X/g,".js-plotly-plot .plotly").replace(/Y/g,".plotly-notifier");n.addStyleRule(o,i[a])}},{"../src/lib":776}],2:[function(t,e,r){"use strict";e.exports=t("../src/transforms/aggregate")},{"../src/transforms/aggregate":1372}],3:[function(t,e,r){"use strict";e.exports=t("../src/traces/bar")},{"../src/traces/bar":922}],4:[function(t,e,r){"use strict";e.exports=t("../src/traces/barpolar")},{"../src/traces/barpolar":935}],5:[function(t,e,r){"use strict";e.exports=t("../src/traces/box")},{"../src/traces/box":945}],6:[function(t,e,r){"use strict";e.exports=t("../src/components/calendars")},{"../src/components/calendars":637}],7:[function(t,e,r){"use strict";e.exports=t("../src/traces/candlestick")},{"../src/traces/candlestick":954}],8:[function(t,e,r){"use strict";e.exports=t("../src/traces/carpet")},{"../src/traces/carpet":973}],9:[function(t,e,r){"use strict";e.exports=t("../src/traces/choropleth")},{"../src/traces/choropleth":987}],10:[function(t,e,r){"use strict";e.exports=t("../src/traces/choroplethmapbox")},{"../src/traces/choroplethmapbox":994}],11:[function(t,e,r){"use strict";e.exports=t("../src/traces/cone")},{"../src/traces/cone":1e3}],12:[function(t,e,r){"use strict";e.exports=t("../src/traces/contour")},{"../src/traces/contour":1015}],13:[function(t,e,r){"use strict";e.exports=t("../src/traces/contourcarpet")},{"../src/traces/contourcarpet":1026}],14:[function(t,e,r){"use strict";e.exports=t("../src/core")},{"../src/core":754}],15:[function(t,e,r){"use strict";e.exports=t("../src/traces/densitymapbox")},{"../src/traces/densitymapbox":1034}],16:[function(t,e,r){"use strict";e.exports=t("../src/transforms/filter")},{"../src/transforms/filter":1373}],17:[function(t,e,r){"use strict";e.exports=t("../src/traces/funnel")},{"../src/traces/funnel":1044}],18:[function(t,e,r){"use strict";e.exports=t("../src/traces/funnelarea")},{"../src/traces/funnelarea":1053}],19:[function(t,e,r){"use strict";e.exports=t("../src/transforms/groupby")},{"../src/transforms/groupby":1374}],20:[function(t,e,r){"use strict";e.exports=t("../src/traces/heatmap")},{"../src/traces/heatmap":1066}],21:[function(t,e,r){"use strict";e.exports=t("../src/traces/heatmapgl")},{"../src/traces/heatmapgl":1076}],22:[function(t,e,r){"use strict";e.exports=t("../src/traces/histogram")},{"../src/traces/histogram":1088}],23:[function(t,e,r){"use strict";e.exports=t("../src/traces/histogram2d")},{"../src/traces/histogram2d":1094}],24:[function(t,e,r){"use strict";e.exports=t("../src/traces/histogram2dcontour")},{"../src/traces/histogram2dcontour":1098}],25:[function(t,e,r){"use strict";e.exports=t("../src/traces/icicle")},{"../src/traces/icicle":1104}],26:[function(t,e,r){"use strict";e.exports=t("../src/traces/image")},{"../src/traces/image":1117}],27:[function(t,e,r){"use strict";var n=t("./core");n.register([t("./bar"),t("./box"),t("./heatmap"),t("./histogram"),t("./histogram2d"),t("./histogram2dcontour"),t("./contour"),t("./scatterternary"),t("./violin"),t("./funnel"),t("./waterfall"),t("./image"),t("./pie"),t("./sunburst"),t("./treemap"),t("./icicle"),t("./funnelarea"),t("./scatter3d"),t("./surface"),t("./isosurface"),t("./volume"),t("./mesh3d"),t("./cone"),t("./streamtube"),t("./scattergeo"),t("./choropleth"),t("./scattergl"),t("./splom"),t("./pointcloud"),t("./heatmapgl"),t("./parcoords"),t("./parcats"),t("./scattermapbox"),t("./choroplethmapbox"),t("./densitymapbox"),t("./sankey"),t("./indicator"),t("./table"),t("./carpet"),t("./scattercarpet"),t("./contourcarpet"),t("./ohlc"),t("./candlestick"),t("./scatterpolar"),t("./scatterpolargl"),t("./barpolar"),t("./aggregate"),t("./filter"),t("./groupby"),t("./sort"),t("./calendars")]),e.exports=n},{"./aggregate":2,"./bar":3,"./barpolar":4,"./box":5,"./calendars":6,"./candlestick":7,"./carpet":8,"./choropleth":9,"./choroplethmapbox":10,"./cone":11,"./contour":12,"./contourcarpet":13,"./core":14,"./densitymapbox":15,"./filter":16,"./funnel":17,"./funnelarea":18,"./groupby":19,"./heatmap":20,"./heatmapgl":21,"./histogram":22,"./histogram2d":23,"./histogram2dcontour":24,"./icicle":25,"./image":26,"./indicator":28,"./isosurface":29,"./mesh3d":30,"./ohlc":31,"./parcats":32,"./parcoords":33,"./pie":34,"./pointcloud":35,"./sankey":36,"./scatter3d":37,"./scattercarpet":38,"./scattergeo":39,"./scattergl":40,"./scattermapbox":41,"./scatterpolar":42,"./scatterpolargl":43,"./scatterternary":44,"./sort":45,"./splom":46,"./streamtube":47,"./sunburst":48,"./surface":49,"./table":50,"./treemap":51,"./violin":52,"./volume":53,"./waterfall":54}],28:[function(t,e,r){"use strict";e.exports=t("../src/traces/indicator")},{"../src/traces/indicator":1125}],29:[function(t,e,r){"use strict";e.exports=t("../src/traces/isosurface")},{"../src/traces/isosurface":1131}],30:[function(t,e,r){"use strict";e.exports=t("../src/traces/mesh3d")},{"../src/traces/mesh3d":1136}],31:[function(t,e,r){"use strict";e.exports=t("../src/traces/ohlc")},{"../src/traces/ohlc":1141}],32:[function(t,e,r){"use strict";e.exports=t("../src/traces/parcats")},{"../src/traces/parcats":1150}],33:[function(t,e,r){"use strict";e.exports=t("../src/traces/parcoords")},{"../src/traces/parcoords":1160}],34:[function(t,e,r){"use strict";e.exports=t("../src/traces/pie")},{"../src/traces/pie":1171}],35:[function(t,e,r){"use strict";e.exports=t("../src/traces/pointcloud")},{"../src/traces/pointcloud":1180}],36:[function(t,e,r){"use strict";e.exports=t("../src/traces/sankey")},{"../src/traces/sankey":1186}],37:[function(t,e,r){"use strict";e.exports=t("../src/traces/scatter3d")},{"../src/traces/scatter3d":1224}],38:[function(t,e,r){"use strict";e.exports=t("../src/traces/scattercarpet")},{"../src/traces/scattercarpet":1231}],39:[function(t,e,r){"use strict";e.exports=t("../src/traces/scattergeo")},{"../src/traces/scattergeo":1239}],40:[function(t,e,r){"use strict";e.exports=t("../src/traces/scattergl")},{"../src/traces/scattergl":1252}],41:[function(t,e,r){"use strict";e.exports=t("../src/traces/scattermapbox")},{"../src/traces/scattermapbox":1262}],42:[function(t,e,r){"use strict";e.exports=t("../src/traces/scatterpolar")},{"../src/traces/scatterpolar":1270}],43:[function(t,e,r){"use strict";e.exports=t("../src/traces/scatterpolargl")},{"../src/traces/scatterpolargl":1277}],44:[function(t,e,r){"use strict";e.exports=t("../src/traces/scatterternary")},{"../src/traces/scatterternary":1285}],45:[function(t,e,r){"use strict";e.exports=t("../src/transforms/sort")},{"../src/transforms/sort":1376}],46:[function(t,e,r){"use strict";e.exports=t("../src/traces/splom")},{"../src/traces/splom":1294}],47:[function(t,e,r){"use strict";e.exports=t("../src/traces/streamtube")},{"../src/traces/streamtube":1302}],48:[function(t,e,r){"use strict";e.exports=t("../src/traces/sunburst")},{"../src/traces/sunburst":1310}],49:[function(t,e,r){"use strict";e.exports=t("../src/traces/surface")},{"../src/traces/surface":1319}],50:[function(t,e,r){"use strict";e.exports=t("../src/traces/table")},{"../src/traces/table":1327}],51:[function(t,e,r){"use strict";e.exports=t("../src/traces/treemap")},{"../src/traces/treemap":1338}],52:[function(t,e,r){"use strict";e.exports=t("../src/traces/violin")},{"../src/traces/violin":1351}],53:[function(t,e,r){"use strict";e.exports=t("../src/traces/volume")},{"../src/traces/volume":1359}],54:[function(t,e,r){"use strict";e.exports=t("../src/traces/waterfall")},{"../src/traces/waterfall":1367}],55:[function(t,e,r){"use strict";e.exports=function(t){var e=(t=t||{}).eye||[0,0,1],r=t.center||[0,0,0],s=t.up||[0,1,0],l=t.distanceLimits||[0,1/0],c=t.mode||"turntable",u=n(),f=i(),h=a();return u.setDistanceLimits(l[0],l[1]),u.lookAt(0,e,r,s),f.setDistanceLimits(l[0],l[1]),f.lookAt(0,e,r,s),h.setDistanceLimits(l[0],l[1]),h.lookAt(0,e,r,s),new o({turntable:u,orbit:f,matrix:h},c)};var n=t("turntable-camera-controller"),i=t("orbit-camera-controller"),a=t("matrix-camera-controller");function o(t,e){this._controllerNames=Object.keys(t),this._controllerList=this._controllerNames.map((function(e){return t[e]})),this._mode=e,this._active=t[e],this._active||(this._mode="turntable",this._active=t.turntable),this.modes=this._controllerNames,this.computedMatrix=this._active.computedMatrix,this.computedEye=this._active.computedEye,this.computedUp=this._active.computedUp,this.computedCenter=this._active.computedCenter,this.computedRadius=this._active.computedRadius}var s=o.prototype;s.flush=function(t){for(var e=this._controllerList,r=0;r1||i>1)}function M(t,e,r){return t.sort(E),t.forEach((function(n,i){var a,o,s=0;if(q(n,r)&&A(n))n.circularPathData.verticalBuffer=s+n.width/2;else{for(var l=0;lo.source.column)){var c=t[l].circularPathData.verticalBuffer+t[l].width/2+e;s=c>s?c:s}n.circularPathData.verticalBuffer=s+n.width/2}})),t}function S(t,r,i,a){var o=e.min(t.links,(function(t){return t.source.y0}));t.links.forEach((function(t){t.circular&&(t.circularPathData={})})),M(t.links.filter((function(t){return"top"==t.circularLinkType})),r,a),M(t.links.filter((function(t){return"bottom"==t.circularLinkType})),r,a),t.links.forEach((function(e){if(e.circular){if(e.circularPathData.arcRadius=e.width+10,e.circularPathData.leftNodeBuffer=5,e.circularPathData.rightNodeBuffer=5,e.circularPathData.sourceWidth=e.source.x1-e.source.x0,e.circularPathData.sourceX=e.source.x0+e.circularPathData.sourceWidth,e.circularPathData.targetX=e.target.x0,e.circularPathData.sourceY=e.y0,e.circularPathData.targetY=e.y1,q(e,a)&&A(e))e.circularPathData.leftSmallArcRadius=10+e.width/2,e.circularPathData.leftLargeArcRadius=10+e.width/2,e.circularPathData.rightSmallArcRadius=10+e.width/2,e.circularPathData.rightLargeArcRadius=10+e.width/2,"bottom"==e.circularLinkType?(e.circularPathData.verticalFullExtent=e.source.y1+25+e.circularPathData.verticalBuffer,e.circularPathData.verticalLeftInnerExtent=e.circularPathData.verticalFullExtent-e.circularPathData.leftLargeArcRadius,e.circularPathData.verticalRightInnerExtent=e.circularPathData.verticalFullExtent-e.circularPathData.rightLargeArcRadius):(e.circularPathData.verticalFullExtent=e.source.y0-25-e.circularPathData.verticalBuffer,e.circularPathData.verticalLeftInnerExtent=e.circularPathData.verticalFullExtent+e.circularPathData.leftLargeArcRadius,e.circularPathData.verticalRightInnerExtent=e.circularPathData.verticalFullExtent+e.circularPathData.rightLargeArcRadius);else{var s=e.source.column,l=e.circularLinkType,c=t.links.filter((function(t){return t.source.column==s&&t.circularLinkType==l}));"bottom"==e.circularLinkType?c.sort(C):c.sort(L);var u=0;c.forEach((function(t,n){t.circularLinkID==e.circularLinkID&&(e.circularPathData.leftSmallArcRadius=10+e.width/2+u,e.circularPathData.leftLargeArcRadius=10+e.width/2+n*r+u),u+=t.width})),s=e.target.column,c=t.links.filter((function(t){return t.target.column==s&&t.circularLinkType==l})),"bottom"==e.circularLinkType?c.sort(I):c.sort(P),u=0,c.forEach((function(t,n){t.circularLinkID==e.circularLinkID&&(e.circularPathData.rightSmallArcRadius=10+e.width/2+u,e.circularPathData.rightLargeArcRadius=10+e.width/2+n*r+u),u+=t.width})),"bottom"==e.circularLinkType?(e.circularPathData.verticalFullExtent=Math.max(i,e.source.y1,e.target.y1)+25+e.circularPathData.verticalBuffer,e.circularPathData.verticalLeftInnerExtent=e.circularPathData.verticalFullExtent-e.circularPathData.leftLargeArcRadius,e.circularPathData.verticalRightInnerExtent=e.circularPathData.verticalFullExtent-e.circularPathData.rightLargeArcRadius):(e.circularPathData.verticalFullExtent=o-25-e.circularPathData.verticalBuffer,e.circularPathData.verticalLeftInnerExtent=e.circularPathData.verticalFullExtent+e.circularPathData.leftLargeArcRadius,e.circularPathData.verticalRightInnerExtent=e.circularPathData.verticalFullExtent+e.circularPathData.rightLargeArcRadius)}e.circularPathData.leftInnerExtent=e.circularPathData.sourceX+e.circularPathData.leftNodeBuffer,e.circularPathData.rightInnerExtent=e.circularPathData.targetX-e.circularPathData.rightNodeBuffer,e.circularPathData.leftFullExtent=e.circularPathData.sourceX+e.circularPathData.leftLargeArcRadius+e.circularPathData.leftNodeBuffer,e.circularPathData.rightFullExtent=e.circularPathData.targetX-e.circularPathData.rightLargeArcRadius-e.circularPathData.rightNodeBuffer}if(e.circular)e.path=function(t){var e="";e="top"==t.circularLinkType?"M"+t.circularPathData.sourceX+" "+t.circularPathData.sourceY+" L"+t.circularPathData.leftInnerExtent+" "+t.circularPathData.sourceY+" A"+t.circularPathData.leftLargeArcRadius+" "+t.circularPathData.leftSmallArcRadius+" 0 0 0 "+t.circularPathData.leftFullExtent+" "+(t.circularPathData.sourceY-t.circularPathData.leftSmallArcRadius)+" L"+t.circularPathData.leftFullExtent+" "+t.circularPathData.verticalLeftInnerExtent+" A"+t.circularPathData.leftLargeArcRadius+" "+t.circularPathData.leftLargeArcRadius+" 0 0 0 "+t.circularPathData.leftInnerExtent+" "+t.circularPathData.verticalFullExtent+" L"+t.circularPathData.rightInnerExtent+" "+t.circularPathData.verticalFullExtent+" A"+t.circularPathData.rightLargeArcRadius+" "+t.circularPathData.rightLargeArcRadius+" 0 0 0 "+t.circularPathData.rightFullExtent+" "+t.circularPathData.verticalRightInnerExtent+" L"+t.circularPathData.rightFullExtent+" "+(t.circularPathData.targetY-t.circularPathData.rightSmallArcRadius)+" A"+t.circularPathData.rightLargeArcRadius+" "+t.circularPathData.rightSmallArcRadius+" 0 0 0 "+t.circularPathData.rightInnerExtent+" "+t.circularPathData.targetY+" L"+t.circularPathData.targetX+" "+t.circularPathData.targetY:"M"+t.circularPathData.sourceX+" "+t.circularPathData.sourceY+" L"+t.circularPathData.leftInnerExtent+" "+t.circularPathData.sourceY+" A"+t.circularPathData.leftLargeArcRadius+" "+t.circularPathData.leftSmallArcRadius+" 0 0 1 "+t.circularPathData.leftFullExtent+" "+(t.circularPathData.sourceY+t.circularPathData.leftSmallArcRadius)+" L"+t.circularPathData.leftFullExtent+" "+t.circularPathData.verticalLeftInnerExtent+" A"+t.circularPathData.leftLargeArcRadius+" "+t.circularPathData.leftLargeArcRadius+" 0 0 1 "+t.circularPathData.leftInnerExtent+" "+t.circularPathData.verticalFullExtent+" L"+t.circularPathData.rightInnerExtent+" "+t.circularPathData.verticalFullExtent+" A"+t.circularPathData.rightLargeArcRadius+" "+t.circularPathData.rightLargeArcRadius+" 0 0 1 "+t.circularPathData.rightFullExtent+" "+t.circularPathData.verticalRightInnerExtent+" L"+t.circularPathData.rightFullExtent+" "+(t.circularPathData.targetY+t.circularPathData.rightSmallArcRadius)+" A"+t.circularPathData.rightLargeArcRadius+" "+t.circularPathData.rightSmallArcRadius+" 0 0 1 "+t.circularPathData.rightInnerExtent+" "+t.circularPathData.targetY+" L"+t.circularPathData.targetX+" "+t.circularPathData.targetY;return e}(e);else{var f=n.linkHorizontal().source((function(t){return[t.source.x0+(t.source.x1-t.source.x0),t.y0]})).target((function(t){return[t.target.x0,t.y1]}));e.path=f(e)}}))}function E(t,e){return O(t)==O(e)?"bottom"==t.circularLinkType?C(t,e):L(t,e):O(e)-O(t)}function L(t,e){return t.y0-e.y0}function C(t,e){return e.y0-t.y0}function P(t,e){return t.y1-e.y1}function I(t,e){return e.y1-t.y1}function O(t){return t.target.column-t.source.column}function z(t){return t.target.x0-t.source.x1}function D(t,e){var r=T(t),n=z(e)/Math.tan(r);return"up"==H(t)?t.y1+n:t.y1-n}function R(t,e){var r=T(t),n=z(e)/Math.tan(r);return"up"==H(t)?t.y1-n:t.y1+n}function F(t,e,r,n){t.links.forEach((function(i){if(!i.circular&&i.target.column-i.source.column>1){var a=i.source.column+1,o=i.target.column-1,s=1,l=o-a+1;for(s=1;a<=o;a++,s++)t.nodes.forEach((function(o){if(o.column==a){var c,u=s/(l+1),f=Math.pow(1-u,3),h=3*u*Math.pow(1-u,2),p=3*Math.pow(u,2)*(1-u),d=Math.pow(u,3),m=f*i.y0+h*i.y0+p*i.y1+d*i.y1,g=m-i.width/2,v=m+i.width/2;g>o.y0&&go.y0&&vo.y1)&&(c=v-o.y0+10,o=N(o,c,e,r),t.nodes.forEach((function(t){b(t,n)!=b(o,n)&&t.column==o.column&&t.y0o.y1&&N(t,c,e,r)})))}}))}}))}function B(t,e){return t.y0>e.y0&&t.y0e.y0&&t.y1e.y1)}function N(t,e,r,n){return t.y0+e>=r&&t.y1+e<=n&&(t.y0=t.y0+e,t.y1=t.y1+e,t.targetLinks.forEach((function(t){t.y1=t.y1+e})),t.sourceLinks.forEach((function(t){t.y0=t.y0+e}))),t}function j(t,e,r,n){t.nodes.forEach((function(i){n&&i.y+(i.y1-i.y0)>e&&(i.y=i.y-(i.y+(i.y1-i.y0)-e));var a=t.links.filter((function(t){return b(t.source,r)==b(i,r)})),o=a.length;o>1&&a.sort((function(t,e){if(!t.circular&&!e.circular){if(t.target.column==e.target.column)return t.y1-e.y1;if(!V(t,e))return t.y1-e.y1;if(t.target.column>e.target.column){var r=R(e,t);return t.y1-r}if(e.target.column>t.target.column)return R(t,e)-e.y1}return t.circular&&!e.circular?"top"==t.circularLinkType?-1:1:e.circular&&!t.circular?"top"==e.circularLinkType?1:-1:t.circular&&e.circular?t.circularLinkType===e.circularLinkType&&"top"==t.circularLinkType?t.target.column===e.target.column?t.target.y1-e.target.y1:e.target.column-t.target.column:t.circularLinkType===e.circularLinkType&&"bottom"==t.circularLinkType?t.target.column===e.target.column?e.target.y1-t.target.y1:t.target.column-e.target.column:"top"==t.circularLinkType?-1:1:void 0}));var s=i.y0;a.forEach((function(t){t.y0=s+t.width/2,s+=t.width})),a.forEach((function(t,e){if("bottom"==t.circularLinkType){for(var r=e+1,n=0;r1&&n.sort((function(t,e){if(!t.circular&&!e.circular){if(t.source.column==e.source.column)return t.y0-e.y0;if(!V(t,e))return t.y0-e.y0;if(e.source.column0?"up":"down"}function q(t,e){return b(t.source,e)==b(t.target,e)}function G(t,r,n){var i=t.nodes,a=t.links,o=!1,s=!1;if(a.forEach((function(t){"top"==t.circularLinkType?o=!0:"bottom"==t.circularLinkType&&(s=!0)})),0==o||0==s){var l=e.min(i,(function(t){return t.y0})),c=(n-r)/(e.max(i,(function(t){return t.y1}))-l);i.forEach((function(t){var e=(t.y1-t.y0)*c;t.y0=(t.y0-l)*c,t.y1=t.y0+e})),a.forEach((function(t){t.y0=(t.y0-l)*c,t.y1=(t.y1-l)*c,t.width=t.width*c}))}}t.sankeyCircular=function(){var t,n,i=0,a=0,b=1,T=1,A=24,M=g,E=o,L=v,C=y,P=32,I=2,O=null;function z(){var t={nodes:L.apply(null,arguments),links:C.apply(null,arguments)};D(t),_(t,M,O),R(t),B(t),w(t,M),N(t,P,M),V(t);for(var e=4,r=0;r0?r+25+10:r,bottom:n=n>0?n+25+10:n,left:a=a>0?a+25+10:a,right:i=i>0?i+25+10:i}}(o),f=function(t,r){var n=e.max(t.nodes,(function(t){return t.column})),o=b-i,s=T-a,l=o/(o+r.right+r.left),c=s/(s+r.top+r.bottom);return i=i*l+r.left,b=0==r.right?b:b*l,a=a*c+r.top,T*=c,t.nodes.forEach((function(t){t.x0=i+t.column*((b-i-A)/n),t.x1=t.x0+A})),c}(o,u);l*=f,o.links.forEach((function(t){t.width=t.value*l})),c.forEach((function(t){var e=t.length;t.forEach((function(t,n){t.depth==c.length-1&&1==e||0==t.depth&&1==e?(t.y0=T/2-t.value*l,t.y1=t.y0+t.value*l):t.partOfCycle?0==k(t,r)?(t.y0=T/2+n,t.y1=t.y0+t.value*l):"top"==t.circularLinkType?(t.y0=a+n,t.y1=t.y0+t.value*l):(t.y0=T-t.value*l-n,t.y1=t.y0+t.value*l):0==u.top||0==u.bottom?(t.y0=(T-a)/e*n,t.y1=t.y0+t.value*l):(t.y0=(T-a)/2-e/2+n,t.y1=t.y0+t.value*l)}))}))}(l),y();for(var u=1,g=s;g>0;--g)v(u*=.99,l),y();function v(t,r){var n=c.length;c.forEach((function(i){var a=i.length,o=i[0].depth;i.forEach((function(i){var s;if(i.sourceLinks.length||i.targetLinks.length)if(i.partOfCycle&&k(i,r)>0);else if(0==o&&1==a)s=i.y1-i.y0,i.y0=T/2-s/2,i.y1=T/2+s/2;else if(o==n-1&&1==a)s=i.y1-i.y0,i.y0=T/2-s/2,i.y1=T/2+s/2;else{var l=e.mean(i.sourceLinks,m),c=e.mean(i.targetLinks,d),u=((l&&c?(l+c)/2:l||c)-p(i))*t;i.y0+=u,i.y1+=u}}))}))}function y(){c.forEach((function(e){var r,n,i,o=a,s=e.length;for(e.sort(f),i=0;i0&&(r.y0+=n,r.y1+=n),o=r.y1+t;if((n=o-t-T)>0)for(o=r.y0-=n,r.y1-=n,i=s-2;i>=0;--i)(n=(r=e[i]).y1+t-o)>0&&(r.y0-=n,r.y1-=n),o=r.y0}))}}function V(t){t.nodes.forEach((function(t){t.sourceLinks.sort(u),t.targetLinks.sort(c)})),t.nodes.forEach((function(t){var e=t.y0,r=e,n=t.y1,i=n;t.sourceLinks.forEach((function(t){t.circular?(t.y0=n-t.width/2,n-=t.width):(t.y0=e+t.width/2,e+=t.width)})),t.targetLinks.forEach((function(t){t.circular?(t.y1=i-t.width/2,i-=t.width):(t.y1=r+t.width/2,r+=t.width)}))}))}return z.nodeId=function(t){return arguments.length?(M="function"==typeof t?t:s(t),z):M},z.nodeAlign=function(t){return arguments.length?(E="function"==typeof t?t:s(t),z):E},z.nodeWidth=function(t){return arguments.length?(A=+t,z):A},z.nodePadding=function(e){return arguments.length?(t=+e,z):t},z.nodes=function(t){return arguments.length?(L="function"==typeof t?t:s(t),z):L},z.links=function(t){return arguments.length?(C="function"==typeof t?t:s(t),z):C},z.size=function(t){return arguments.length?(i=a=0,b=+t[0],T=+t[1],z):[b-i,T-a]},z.extent=function(t){return arguments.length?(i=+t[0][0],b=+t[1][0],a=+t[0][1],T=+t[1][1],z):[[i,a],[b,T]]},z.iterations=function(t){return arguments.length?(P=+t,z):P},z.circularLinkGap=function(t){return arguments.length?(I=+t,z):I},z.nodePaddingRatio=function(t){return arguments.length?(n=+t,z):n},z.sortNodes=function(t){return arguments.length?(O=t,z):O},z.update=function(t){return w(t,M),V(t),t.links.forEach((function(t){t.circular&&(t.circularLinkType=t.y0+t.y1a&&(b=a);var o=e.min(i,(function(t){return(y-n-(t.length-1)*b)/e.sum(t,u)}));i.forEach((function(t){t.forEach((function(t,e){t.y1=(t.y0=e)+t.value*o}))})),t.links.forEach((function(t){t.width=t.value*o}))}(),d();for(var a=1,o=A;o>0;--o)l(a*=.99),d(),s(a),d();function s(t){i.forEach((function(r){r.forEach((function(r){if(r.targetLinks.length){var n=(e.sum(r.targetLinks,h)/e.sum(r.targetLinks,u)-f(r))*t;r.y0+=n,r.y1+=n}}))}))}function l(t){i.slice().reverse().forEach((function(r){r.forEach((function(r){if(r.sourceLinks.length){var n=(e.sum(r.sourceLinks,p)/e.sum(r.sourceLinks,u)-f(r))*t;r.y0+=n,r.y1+=n}}))}))}function d(){i.forEach((function(t){var e,r,i,a=n,o=t.length;for(t.sort(c),i=0;i0&&(e.y0+=r,e.y1+=r),a=e.y1+b;if((r=a-b-y)>0)for(a=e.y0-=r,e.y1-=r,i=o-2;i>=0;--i)(r=(e=t[i]).y1+b-a)>0&&(e.y0-=r,e.y1-=r),a=e.y0}))}}function P(t){t.nodes.forEach((function(t){t.sourceLinks.sort(l),t.targetLinks.sort(s)})),t.nodes.forEach((function(t){var e=t.y0,r=e;t.sourceLinks.forEach((function(t){t.y0=e+t.width/2,e+=t.width})),t.targetLinks.forEach((function(t){t.y1=r+t.width/2,r+=t.width}))}))}return M.update=function(t){return P(t),t},M.nodeId=function(t){return arguments.length?(_="function"==typeof t?t:o(t),M):_},M.nodeAlign=function(t){return arguments.length?(w="function"==typeof t?t:o(t),M):w},M.nodeWidth=function(t){return arguments.length?(x=+t,M):x},M.nodePadding=function(t){return arguments.length?(b=+t,M):b},M.nodes=function(t){return arguments.length?(T="function"==typeof t?t:o(t),M):T},M.links=function(t){return arguments.length?(k="function"==typeof t?t:o(t),M):k},M.size=function(e){return arguments.length?(t=n=0,i=+e[0],y=+e[1],M):[i-t,y-n]},M.extent=function(e){return arguments.length?(t=+e[0][0],i=+e[1][0],n=+e[0][1],y=+e[1][1],M):[[t,n],[i,y]]},M.iterations=function(t){return arguments.length?(A=+t,M):A},M},t.sankeyCenter=function(t){return t.targetLinks.length?t.depth:t.sourceLinks.length?e.min(t.sourceLinks,i)-1:0},t.sankeyLeft=function(t){return t.depth},t.sankeyRight=function(t,e){return e-1-t.height},t.sankeyJustify=a,t.sankeyLinkHorizontal=function(){return n.linkHorizontal().source(y).target(x)},Object.defineProperty(t,"__esModule",{value:!0})}))},{"d3-array":155,"d3-collection":156,"d3-shape":167}],58:[function(t,e,r){(function(){var t={version:"3.8.0"},r=[].slice,n=function(t){return r.call(t)},i=self.document;function a(t){return t&&(t.ownerDocument||t.document||t).documentElement}function o(t){return t&&(t.ownerDocument&&t.ownerDocument.defaultView||t.document&&t||t.defaultView)}if(i)try{n(i.documentElement.childNodes)[0].nodeType}catch(t){n=function(t){for(var e=t.length,r=new Array(e);e--;)r[e]=t[e];return r}}if(Date.now||(Date.now=function(){return+new Date}),i)try{i.createElement("DIV").style.setProperty("opacity",0,"")}catch(t){var s=this.Element.prototype,l=s.setAttribute,c=s.setAttributeNS,u=this.CSSStyleDeclaration.prototype,f=u.setProperty;s.setAttribute=function(t,e){l.call(this,t,e+"")},s.setAttributeNS=function(t,e,r){c.call(this,t,e,r+"")},u.setProperty=function(t,e,r){f.call(this,t,e+"",r)}}function h(t,e){return te?1:t>=e?0:NaN}function p(t){return null===t?NaN:+t}function d(t){return!isNaN(t)}function m(t){return{left:function(e,r,n,i){for(arguments.length<3&&(n=0),arguments.length<4&&(i=e.length);n>>1;t(e[a],r)<0?n=a+1:i=a}return n},right:function(e,r,n,i){for(arguments.length<3&&(n=0),arguments.length<4&&(i=e.length);n>>1;t(e[a],r)>0?i=a:n=a+1}return n}}}t.ascending=h,t.descending=function(t,e){return et?1:e>=t?0:NaN},t.min=function(t,e){var r,n,i=-1,a=t.length;if(1===arguments.length){for(;++i=n){r=n;break}for(;++in&&(r=n)}else{for(;++i=n){r=n;break}for(;++in&&(r=n)}return r},t.max=function(t,e){var r,n,i=-1,a=t.length;if(1===arguments.length){for(;++i=n){r=n;break}for(;++ir&&(r=n)}else{for(;++i=n){r=n;break}for(;++ir&&(r=n)}return r},t.extent=function(t,e){var r,n,i,a=-1,o=t.length;if(1===arguments.length){for(;++a=n){r=i=n;break}for(;++an&&(r=n),i=n){r=i=n;break}for(;++an&&(r=n),i1)return o/(l-1)},t.deviation=function(){var e=t.variance.apply(this,arguments);return e?Math.sqrt(e):e};var g=m(h);function v(t){return t.length}t.bisectLeft=g.left,t.bisect=t.bisectRight=g.right,t.bisector=function(t){return m(1===t.length?function(e,r){return h(t(e),r)}:t)},t.shuffle=function(t,e,r){(a=arguments.length)<3&&(r=t.length,a<2&&(e=0));for(var n,i,a=r-e;a;)i=Math.random()*a--|0,n=t[a+e],t[a+e]=t[i+e],t[i+e]=n;return t},t.permute=function(t,e){for(var r=e.length,n=new Array(r);r--;)n[r]=t[e[r]];return n},t.pairs=function(t){for(var e=0,r=t.length-1,n=t[0],i=new Array(r<0?0:r);e=0;)for(e=(n=t[i]).length;--e>=0;)r[--o]=n[e];return r};var y=Math.abs;function x(t){for(var e=1;t*e%1;)e*=10;return e}function b(t,e){for(var r in e)Object.defineProperty(t.prototype,r,{value:e[r],enumerable:!1})}function _(){this._=Object.create(null)}t.range=function(t,e,r){if(arguments.length<3&&(r=1,arguments.length<2&&(e=t,t=0)),(e-t)/r==1/0)throw new Error("infinite range");var n,i=[],a=x(y(r)),o=-1;if(t*=a,e*=a,(r*=a)<0)for(;(n=t+r*++o)>e;)i.push(n/a);else for(;(n=t+r*++o)=i.length)return r?r.call(n,a):e?a.sort(e):a;for(var l,c,u,f,h=-1,p=a.length,d=i[s++],m=new _;++h=i.length)return e;var n=[],o=a[r++];return e.forEach((function(e,i){n.push({key:e,values:t(i,r)})})),o?n.sort((function(t,e){return o(t.key,e.key)})):n}(o(t.map,e,0),0)},n.key=function(t){return i.push(t),n},n.sortKeys=function(t){return a[i.length-1]=t,n},n.sortValues=function(t){return e=t,n},n.rollup=function(t){return r=t,n},n},t.set=function(t){var e=new L;if(t)for(var r=0,n=t.length;r=0&&(n=t.slice(r+1),t=t.slice(0,r)),t)return arguments.length<2?this[t].on(n):this[t].on(n,e);if(2===arguments.length){if(null==e)for(t in this)this.hasOwnProperty(t)&&this[t].on(n,null);return this}},t.event=null,t.requote=function(t){return t.replace(j,"\\$&")};var j=/[\\\^\$\*\+\?\|\[\]\(\)\.\{\}]/g,U={}.__proto__?function(t,e){t.__proto__=e}:function(t,e){for(var r in e)t[r]=e[r]};function V(t){return U(t,Y),t}var H=function(t,e){return e.querySelector(t)},q=function(t,e){return e.querySelectorAll(t)},G=function(t,e){var r=t.matches||t[I(t,"matchesSelector")];return(G=function(t,e){return r.call(t,e)})(t,e)};"function"==typeof Sizzle&&(H=function(t,e){return Sizzle(t,e)[0]||null},q=Sizzle,G=Sizzle.matchesSelector),t.selection=function(){return t.select(i.documentElement)};var Y=t.selection.prototype=[];function W(t){return"function"==typeof t?t:function(){return H(t,this)}}function X(t){return"function"==typeof t?t:function(){return q(t,this)}}Y.select=function(t){var e,r,n,i,a=[];t=W(t);for(var o=-1,s=this.length;++o=0&&"xmlns"!==(r=t.slice(0,e))&&(t=t.slice(e+1)),J.hasOwnProperty(r)?{space:J[r],local:t}:t}},Y.attr=function(e,r){if(arguments.length<2){if("string"==typeof e){var n=this.node();return(e=t.ns.qualify(e)).local?n.getAttributeNS(e.space,e.local):n.getAttribute(e)}for(r in e)this.each(K(r,e[r]));return this}return this.each(K(e,r))},Y.classed=function(t,e){if(arguments.length<2){if("string"==typeof t){var r=this.node(),n=(t=tt(t)).length,i=-1;if(e=r.classList){for(;++i=0;)(r=n[i])&&(a&&a!==r.nextSibling&&a.parentNode.insertBefore(r,a),a=r);return this},Y.sort=function(t){t=ct.apply(this,arguments);for(var e=-1,r=this.length;++e=e&&(e=i+1);!(o=s[e])&&++e0&&(e=e.slice(0,o));var l=mt.get(e);function c(){var t=this[a];t&&(this.removeEventListener(e,t,t.$),delete this[a])}return l&&(e=l,s=vt),o?r?function(){var t=s(r,n(arguments));c.call(this),this.addEventListener(e,this[a]=t,t.$=i),t._=r}:c:r?z:function(){var r,n=new RegExp("^__on([^.]+)"+t.requote(e)+"$");for(var i in this)if(r=i.match(n)){var a=this[i];this.removeEventListener(r[1],a,a.$),delete this[i]}}}t.selection.enter=ft,t.selection.enter.prototype=ht,ht.append=Y.append,ht.empty=Y.empty,ht.node=Y.node,ht.call=Y.call,ht.size=Y.size,ht.select=function(t){for(var e,r,n,i,a,o=[],s=-1,l=this.length;++s1?Et:t<-1?-Et:Math.asin(t)}function It(t){return((t=Math.exp(t))+1/t)/2}var Ot=Math.SQRT2;t.interpolateZoom=function(t,e){var r,n,i=t[0],a=t[1],o=t[2],s=e[0],l=e[1],c=e[2],u=s-i,f=l-a,h=u*u+f*f;if(h<1e-12)n=Math.log(c/o)/Ot,r=function(t){return[i+t*u,a+t*f,o*Math.exp(Ot*t*n)]};else{var p=Math.sqrt(h),d=(c*c-o*o+4*h)/(2*o*2*p),m=(c*c-o*o-4*h)/(2*c*2*p),g=Math.log(Math.sqrt(d*d+1)-d),v=Math.log(Math.sqrt(m*m+1)-m);n=(v-g)/Ot,r=function(t){var e,r=t*n,s=It(g),l=o/(2*p)*(s*(e=Ot*r+g,((e=Math.exp(2*e))-1)/(e+1))-function(t){return((t=Math.exp(t))-1/t)/2}(g));return[i+l*u,a+l*f,o*s/It(Ot*r+g)]}}return r.duration=1e3*n,r},t.behavior.zoom=function(){var e,r,n,a,s,l,c,u,f,h={x:0,y:0,k:1},p=[960,500],d=Rt,m=250,g=0,v="mousedown.zoom",y="mousemove.zoom",x="mouseup.zoom",b="touchstart.zoom",_=N(w,"zoomstart","zoom","zoomend");function w(t){t.on(v,P).on(Dt+".zoom",O).on("dblclick.zoom",z).on(b,I)}function T(t){return[(t[0]-h.x)/h.k,(t[1]-h.y)/h.k]}function k(t){h.k=Math.max(d[0],Math.min(d[1],t))}function A(t,e){e=function(t){return[t[0]*h.k+h.x,t[1]*h.k+h.y]}(e),h.x+=t[0]-e[0],h.y+=t[1]-e[1]}function M(e,n,i,a){e.__chart__={x:h.x,y:h.y,k:h.k},k(Math.pow(2,a)),A(r=n,i),e=t.select(e),m>0&&(e=e.transition().duration(m)),e.call(w.event)}function S(){c&&c.domain(l.range().map((function(t){return(t-h.x)/h.k})).map(l.invert)),f&&f.domain(u.range().map((function(t){return(t-h.y)/h.k})).map(u.invert))}function E(t){g++||t({type:"zoomstart"})}function L(t){S(),t({type:"zoom",scale:h.k,translate:[h.x,h.y]})}function C(t){--g||(t({type:"zoomend"}),r=null)}function P(){var e=this,r=_.of(e,arguments),n=0,i=t.select(o(e)).on(y,l).on(x,c),a=T(t.mouse(e)),s=bt(e);function l(){n=1,A(t.mouse(e),a),L(r)}function c(){i.on(y,null).on(x,null),s(n),C(r)}Di.call(e),E(r)}function I(){var e,r=this,n=_.of(r,arguments),i={},a=0,o=".zoom-"+t.event.changedTouches[0].identifier,l="touchmove"+o,c="touchend"+o,u=[],f=t.select(r),p=bt(r);function d(){var n=t.touches(r);return e=h.k,n.forEach((function(t){t.identifier in i&&(i[t.identifier]=T(t))})),n}function m(){var e=t.event.target;t.select(e).on(l,g).on(c,y),u.push(e);for(var n=t.event.changedTouches,o=0,f=n.length;o1){v=p[0];var x=p[1],b=v[0]-x[0],_=v[1]-x[1];a=b*b+_*_}}function g(){var o,l,c,u,f=t.touches(r);Di.call(r);for(var h=0,p=f.length;h360?t-=360:t<0&&(t+=360),t<60?n+(i-n)*t/60:t<180?i:t<240?n+(i-n)*(240-t)/60:n}(t))}return t=isNaN(t)?0:(t%=360)<0?t+360:t,e=isNaN(e)||e<0?0:e>1?1:e,n=2*(r=r<0?0:r>1?1:r)-(i=r<=.5?r*(1+e):r+e-r*e),new Qt(a(t+120),a(t),a(t-120))}function Ut(e,r,n){return this instanceof Ut?(this.h=+e,this.c=+r,void(this.l=+n)):arguments.length<2?e instanceof Ut?new Ut(e.h,e.c,e.l):Xt(e instanceof qt?e.l:(e=ae((e=t.rgb(e)).r,e.g,e.b)).l,e.a,e.b):new Ut(e,r,n)}Nt.brighter=function(t){return t=Math.pow(.7,arguments.length?t:1),new Bt(this.h,this.s,this.l/t)},Nt.darker=function(t){return t=Math.pow(.7,arguments.length?t:1),new Bt(this.h,this.s,t*this.l)},Nt.rgb=function(){return jt(this.h,this.s,this.l)},t.hcl=Ut;var Vt=Ut.prototype=new Ft;function Ht(t,e,r){return isNaN(t)&&(t=0),isNaN(e)&&(e=0),new qt(r,Math.cos(t*=Lt)*e,Math.sin(t)*e)}function qt(t,e,r){return this instanceof qt?(this.l=+t,this.a=+e,void(this.b=+r)):arguments.length<2?t instanceof qt?new qt(t.l,t.a,t.b):t instanceof Ut?Ht(t.h,t.c,t.l):ae((t=Qt(t)).r,t.g,t.b):new qt(t,e,r)}Vt.brighter=function(t){return new Ut(this.h,this.c,Math.min(100,this.l+Gt*(arguments.length?t:1)))},Vt.darker=function(t){return new Ut(this.h,this.c,Math.max(0,this.l-Gt*(arguments.length?t:1)))},Vt.rgb=function(){return Ht(this.h,this.c,this.l).rgb()},t.lab=qt;var Gt=18,Yt=qt.prototype=new Ft;function Wt(t,e,r){var n=(t+16)/116,i=n+e/500,a=n-r/200;return new Qt(Kt(3.2404542*(i=.95047*Zt(i))-1.5371385*(n=1*Zt(n))-.4985314*(a=1.08883*Zt(a))),Kt(-.969266*i+1.8760108*n+.041556*a),Kt(.0556434*i-.2040259*n+1.0572252*a))}function Xt(t,e,r){return t>0?new Ut(Math.atan2(r,e)*Ct,Math.sqrt(e*e+r*r),t):new Ut(NaN,NaN,t)}function Zt(t){return t>.206893034?t*t*t:(t-4/29)/7.787037}function Jt(t){return t>.008856?Math.pow(t,1/3):7.787037*t+4/29}function Kt(t){return Math.round(255*(t<=.00304?12.92*t:1.055*Math.pow(t,1/2.4)-.055))}function Qt(t,e,r){return this instanceof Qt?(this.r=~~t,this.g=~~e,void(this.b=~~r)):arguments.length<2?t instanceof Qt?new Qt(t.r,t.g,t.b):ne(""+t,Qt,jt):new Qt(t,e,r)}function $t(t){return new Qt(t>>16,t>>8&255,255&t)}function te(t){return $t(t)+""}Yt.brighter=function(t){return new qt(Math.min(100,this.l+Gt*(arguments.length?t:1)),this.a,this.b)},Yt.darker=function(t){return new qt(Math.max(0,this.l-Gt*(arguments.length?t:1)),this.a,this.b)},Yt.rgb=function(){return Wt(this.l,this.a,this.b)},t.rgb=Qt;var ee=Qt.prototype=new Ft;function re(t){return t<16?"0"+Math.max(0,t).toString(16):Math.min(255,t).toString(16)}function ne(t,e,r){var n,i,a,o=0,s=0,l=0;if(n=/([a-z]+)\((.*)\)/.exec(t=t.toLowerCase()))switch(i=n[2].split(","),n[1]){case"hsl":return r(parseFloat(i[0]),parseFloat(i[1])/100,parseFloat(i[2])/100);case"rgb":return e(se(i[0]),se(i[1]),se(i[2]))}return(a=le.get(t))?e(a.r,a.g,a.b):(null==t||"#"!==t.charAt(0)||isNaN(a=parseInt(t.slice(1),16))||(4===t.length?(o=(3840&a)>>4,o|=o>>4,s=240&a,s|=s>>4,l=15&a,l|=l<<4):7===t.length&&(o=(16711680&a)>>16,s=(65280&a)>>8,l=255&a)),e(o,s,l))}function ie(t,e,r){var n,i,a=Math.min(t/=255,e/=255,r/=255),o=Math.max(t,e,r),s=o-a,l=(o+a)/2;return s?(i=l<.5?s/(o+a):s/(2-o-a),n=t==o?(e-r)/s+(e0&&l<1?0:n),new Bt(n,i,l)}function ae(t,e,r){var n=Jt((.4124564*(t=oe(t))+.3575761*(e=oe(e))+.1804375*(r=oe(r)))/.95047),i=Jt((.2126729*t+.7151522*e+.072175*r)/1);return qt(116*i-16,500*(n-i),200*(i-Jt((.0193339*t+.119192*e+.9503041*r)/1.08883)))}function oe(t){return(t/=255)<=.04045?t/12.92:Math.pow((t+.055)/1.055,2.4)}function se(t){var e=parseFloat(t);return"%"===t.charAt(t.length-1)?Math.round(2.55*e):e}ee.brighter=function(t){t=Math.pow(.7,arguments.length?t:1);var e=this.r,r=this.g,n=this.b,i=30;return e||r||n?(e&&e=200&&e<300||304===e){try{t=i.call(o,c)}catch(t){return void s.error.call(o,t)}s.load.call(o,t)}else s.error.call(o,c)}return self.XDomainRequest&&!("withCredentials"in c)&&/^(http(s)?:)?\/\//.test(e)&&(c=new XDomainRequest),"onload"in c?c.onload=c.onerror=f:c.onreadystatechange=function(){c.readyState>3&&f()},c.onprogress=function(e){var r=t.event;t.event=e;try{s.progress.call(o,c)}finally{t.event=r}},o.header=function(t,e){return t=(t+"").toLowerCase(),arguments.length<2?l[t]:(null==e?delete l[t]:l[t]=e+"",o)},o.mimeType=function(t){return arguments.length?(r=null==t?null:t+"",o):r},o.responseType=function(t){return arguments.length?(u=t,o):u},o.response=function(t){return i=t,o},["get","post"].forEach((function(t){o[t]=function(){return o.send.apply(o,[t].concat(n(arguments)))}})),o.send=function(t,n,i){if(2===arguments.length&&"function"==typeof n&&(i=n,n=null),c.open(t,e,!0),null==r||"accept"in l||(l.accept=r+",*/*"),c.setRequestHeader)for(var a in l)c.setRequestHeader(a,l[a]);return null!=r&&c.overrideMimeType&&c.overrideMimeType(r),null!=u&&(c.responseType=u),null!=i&&o.on("error",i).on("load",(function(t){i(null,t)})),s.beforesend.call(o,c),c.send(null==n?null:n),o},o.abort=function(){return c.abort(),o},t.rebind(o,s,"on"),null==a?o:o.get(function(t){return 1===t.length?function(e,r){t(null==e?r:null)}:t}(a))}le.forEach((function(t,e){le.set(t,$t(e))})),t.functor=ce,t.xhr=ue(C),t.dsv=function(t,e){var r=new RegExp('["'+t+"\n]"),n=t.charCodeAt(0);function i(t,r,n){arguments.length<3&&(n=r,r=null);var i=fe(t,e,null==r?a:o(r),n);return i.row=function(t){return arguments.length?i.response(null==(r=t)?a:o(t)):r},i}function a(t){return i.parse(t.responseText)}function o(t){return function(e){return i.parse(e.responseText,t)}}function s(e){return e.map(l).join(t)}function l(t){return r.test(t)?'"'+t.replace(/\"/g,'""')+'"':t}return i.parse=function(t,e){var r;return i.parseRows(t,(function(t,n){if(r)return r(t,n-1);var i=function(e){for(var r={},n=t.length,i=0;i=l)return o;if(i)return i=!1,a;var e=c;if(34===t.charCodeAt(e)){for(var r=e;r++24?(isFinite(e)&&(clearTimeout(me),me=setTimeout(ye,e)),de=0):(de=1,ge(ye))}function xe(){for(var t=Date.now(),e=he;e;)t>=e.t&&e.c(t-e.t)&&(e.c=null),e=e.n;return t}function be(){for(var t,e=he,r=1/0;e;)e.c?(e.t1&&(e=t[a[o-2]],r=t[a[o-1]],n=t[s],(r[0]-e[0])*(n[1]-e[1])-(r[1]-e[1])*(n[0]-e[0])<=0);)--o;a[o++]=s}return a.slice(0,o)}function ke(t,e){return t[0]-e[0]||t[1]-e[1]}t.timer=function(){ve.apply(this,arguments)},t.timer.flush=function(){xe(),be()},t.round=function(t,e){return e?Math.round(t*(e=Math.pow(10,e)))/e:Math.round(t)},t.geom={},t.geom.hull=function(t){var e=_e,r=we;if(arguments.length)return n(t);function n(t){if(t.length<3)return[];var n,i=ce(e),a=ce(r),o=t.length,s=[],l=[];for(n=0;n