diff --git a/DESCRIPTION b/DESCRIPTION index 10c19cfc..28ff21df 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: migraph Title: Inferential Methods for Multimodal and Other Networks -Version: 1.6.0 -Date: 2026-04-04 +Version: 1.6.1 +Date: 2026-04-14 Description: A set of tools for testing networks. It includes functions for univariate and multivariate conditional uniform graph and quadratic assignment procedure testing, diff --git a/NEWS.md b/NEWS.md index b095cbd7..612d868f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,24 @@ +# migraph 1.6.1 + +2026-04-13 + +## Package + +- Fixed logo sizing and location +- Added tests for `predict()` methods +- Added testing for `{netrics}` tutorials + +## Tutorials + +- Fixed `run_tute()` and `extract_tute()` to identify and use tutorials in `{netrics}` +- Updated diversity tutorial with new netrics names +- Updated diffusion tutorial with new netrics names +- Updated ergm tutorial with new netrics names + +## Testing + +- Fixed how `test_fit()` handles diffusion models and non-equal length step results + # migraph 1.6.0 2026-04-04 diff --git a/R/model_distrib.R b/R/model_distrib.R index 9fb39165..40874cbd 100644 --- a/R/model_distrib.R +++ b/R/model_distrib.R @@ -57,10 +57,16 @@ test_distribution <- function(diff_model1, diff_model2){ #' @export test_fit <- function(diff_model, diff_models){ # make into method? x <- diff_model + if(is_graph(x)) x <- as_diffusion(x) y <- diff_models sim <- `0` <- NULL - sims <- y %>% dplyr::select(sim, t, I) - sims <- as.data.frame.matrix(stats::xtabs(I ~ sim + t, sims)) # tidyr::pivot_wider replacement + sims <- y %>% dplyr::select(sim, time, I) + if(max(x$time) < max(sims$time)){ + x <- dplyr::bind_rows(x, + dplyr::tibble(time = (max(x$time)+1):max(sims$time), + S = x$S[nrow(x)], I = x$I[nrow(x)])) + } + sims <- as.data.frame.matrix(stats::xtabs(I ~ sim + time, sims)) # tidyr::pivot_wider replacement sims <- sims[,colSums(stats::cov(sims))!=0] mah <- stats::mahalanobis(x$I[-1], colMeans(sims), stats::cov(sims)) pval <- pchisq(mah, df=length(x$I[-1]), lower.tail=FALSE) diff --git a/R/tutorial_run.R b/R/tutorial_run.R index 3c1af167..efad953c 100644 --- a/R/tutorial_run.R +++ b/R/tutorial_run.R @@ -18,7 +18,7 @@ #' @name tutorials NULL -stocnet <- c("manynet", "migraph", "autograph") +stocnet <- c("manynet", "migraph", "autograph", "netrics") #' @rdname tutorials #' @export @@ -33,12 +33,15 @@ run_tute <- function(tute) { dplyr::as_tibble(learnr::available_tutorials(package = avail_pkgs[p]), silent = TRUE) %>% dplyr::select(1:3) }) - dplyr::bind_rows(tutelist) %>% dplyr::arrange(name) %>% print() + dplyr::bind_rows(tutelist) %>% + dplyr::arrange(dplyr::across(dplyr::any_of("name"))) %>% + print() manynet::snet_info("You can run a tutorial by typing e.g `run_tute('tutorial1')` or `run_tute('Data')` into the console.") } else { try(learnr::run_tutorial(tute, "manynet"), silent = TRUE) - try(learnr::run_tutorial(tute, "migraph"), silent = TRUE) try(learnr::run_tutorial(tute, "autograph"), silent = TRUE) + try(learnr::run_tutorial(tute, "netrics"), silent = TRUE) + try(learnr::run_tutorial(tute, "migraph"), silent = TRUE) manynet::snet_info("Didn't find a direct match, so looking for close matches...") tutelist <- lapply(manynet::snet_progress_along(avail_pkgs, name = "Checking tutorials in stocnet packages"), function(p){ @@ -71,7 +74,9 @@ extract_tute <- function(tute) { dplyr::as_tibble(learnr::available_tutorials(package = avail_pkgs[p]), silent = TRUE) %>% dplyr::select(1:3) }) - dplyr::bind_rows(tutelist) %>% dplyr::arrange(name) %>% print() + dplyr::bind_rows(tutelist) %>% + dplyr::arrange(dplyr::across(dplyr::any_of("name"))) %>% + print() manynet::snet_info("You can extract the code from one of these tutorials by typing e.g `extract_tute('tutorial1')` into the console.") } else { thisRequires("knitr") @@ -80,9 +85,13 @@ extract_tute <- function(tute) { thisRequires("autograph") pth <- gsub("manynet", "autograph", pth) } + if(!dir.exists(pth)) { + thisRequires("netrics") + pth <- gsub("autograph", "netrics", pth) + } if(!dir.exists(pth)) { thisRequires("migraph") - pth <- gsub("autograph", "migraph", pth) + pth <- gsub("netrics", "migraph", pth) } knitr::purl(file.path(pth, list.files(pth, pattern = "*.Rmd")), documentation = 1) diff --git a/inst/migraph.png b/inst/migraph.png new file mode 100644 index 00000000..53e7af52 Binary files /dev/null and b/inst/migraph.png differ diff --git a/inst/tutorials/tutorial7/diffusion.Rmd b/inst/tutorials/tutorial7/diffusion.Rmd index b64be7e5..c5042758 100644 --- a/inst/tutorials/tutorial7/diffusion.Rmd +++ b/inst/tutorials/tutorial7/diffusion.Rmd @@ -172,18 +172,18 @@ and `graphs()` (at least by default) only graphs the first and last step. But there is an easier way. -Play these same diffusions again, this time nesting the call within `net_infection_complete()`. +Play these same diffusions again, this time nesting the call within `net_by_infection_complete()`. ```{r completeinfection, exercise = TRUE, purl = FALSE, fig.width=9} -net_infection_complete(play_diffusion(create_ring(32, width = 2))) -net_infection_complete(play_diffusion(generate_random(32, 0.15))) -net_infection_complete(play_diffusion(generate_scalefree(32, 0.025))) -net_infection_complete(play_diffusion(generate_smallworld(32, 0.025))) +net_by_infection_complete(play_diffusion(create_ring(32, width = 2))) +net_by_infection_complete(play_diffusion(generate_random(32, 0.15))) +net_by_infection_complete(play_diffusion(generate_scalefree(32, 0.025))) +net_by_infection_complete(play_diffusion(generate_smallworld(32, 0.025))) ``` ```{r struct-interp, echo = FALSE, purl = FALSE} question("Does the structure of the network matter for whether and when a diffusion process completes?", - answer("No", message = "Take a closer look at the `net_infection_complete()` results. Are they all the same?"), + answer("No", message = "Take a closer look at the `net_by_infection_complete()` results. Are they all the same?"), answer("Yes", correct = TRUE, message = "We can see that the different structures have varying outcomes in terms of when the diffusion completes."), random_answer_order = TRUE, allow_retry = TRUE @@ -203,7 +203,7 @@ You can start the infection in California by specifying `seeds = 5`. us_diff <- play_diffusion(irps_usgeo, seeds = 5) plot(us_diff) graphr(us_diff) -net_infection_complete(us_diff) +net_by_infection_complete(us_diff) ``` What's happening here? Can you interpret this? @@ -483,9 +483,9 @@ We could use these on degree centrality, or perhaps some other kind of centralit sf <- generate_scalefree(32, 0.025) sf %>% as_tidygraph() %>% - mutate(degree = ifelse(node_is_max(node_degree(sf)) == TRUE, "max", - ifelse(node_is_min(node_degree(sf)) == TRUE, "min", "others"))) %>% - graphr(node_color = "degree") + guides(color = "legend") + labs(color = "degree") + mutate(degree = ifelse(node_is_max(node_by_degree(sf)) == TRUE, "max", + ifelse(node_is_min(node_by_degree(sf)) == TRUE, "min", "others"))) %>% + graphr(node_color = "degree") + guides(color = "legend") ``` ```{r scale, exercise = TRUE, purl = FALSE, exercise.setup="sf", fig.width=9} @@ -495,11 +495,11 @@ sf %>% ```{r scale-solution} plot(play_diffusion(sf, seeds = 10, steps = 10)) plot(play_diffusion(sf, seeds = node_is_random(sf), steps = 10)) -plot(play_diffusion(sf, seeds = node_is_max(node_degree(sf)), steps = 10)) -plot(play_diffusion(sf, seeds = node_is_min(node_degree(sf)), steps = 10)) +plot(play_diffusion(sf, seeds = node_is_max(node_by_degree(sf)), steps = 10)) +plot(play_diffusion(sf, seeds = node_is_min(node_by_degree(sf)), steps = 10)) # visualise diffusion in scalefree network -graphs(play_diffusion(sf, seeds = node_is_min(node_degree(sf)), steps = 10)) +graphs(play_diffusion(sf, seeds = node_is_min(node_by_degree(sf)), steps = 10)) graphs(play_diffusion(sf, seeds = 16, steps = 10), waves = 1:3) ``` @@ -713,14 +713,14 @@ It can be interpreted as follows: - Where $R_0$ = 1, the 'disease' will continue as endemic, if conditions allow. So how can we establish the $R_0$ here? -We can use `net_reproduction()`. +We can use `net_by_reproduction()`. ```{r r0, exercise = TRUE, exercise.setup = "diffusions", fig.width=9} rd_diff <- play_diffusion(rando, transmissibility = 0.25, recovery = 0.05) plot(rd_diff) # R-nought -net_reproduction(rd_diff) -net_infection_total(rd_diff) +net_by_reproduction(rd_diff) +net_by_infection_total(rd_diff) ``` ```{r r0-interp, echo = FALSE, purl = FALSE} @@ -762,13 +762,13 @@ the `r gloss("Herd Immunity Threshold", "hit")` or HIT. HIT indicates the threshold at which the reduction of susceptible members of the network means that infections will no longer keep increasing, allowing herd immunity to be achieved. -`net_immunity()` gives us the proportion of the population that would need +`net_by_immunity()` gives us the proportion of the population that would need to be recovered or vaccinated for the network to have herd immunity. ```{r immunity, exercise = TRUE, exercise.setup = "r0"} # Herd Immunity Threshold -net_immunity(rd_diff) -net_immunity(rd_diff, normalized = FALSE) +net_by_immunity(rd_diff) +net_by_immunity(rd_diff, normalized = FALSE) ``` In this model, the HIT score indicates a good proportion of nodes in the network @@ -780,7 +780,7 @@ Ok, so let's try this strategy. rd_diff_vacc <- play_diffusion(rando, transmissibility = 0.25, recovery = 0.05, immune = 2:9) plot(rd_diff_vacc) -net_infection_total(rd_diff_vacc) +net_by_infection_total(rd_diff_vacc) ``` We can see that we more rapidly reach a situation in which vaccinated and @@ -968,12 +968,12 @@ Which are the highest eigenvector centrality nodes in this network? ``` ```{r eigen-hint} -node_eigenvector(ison_networkers) +node_by_eigenvector(ison_networkers) ison_networkers %>% - mutate(who_to_convince = node_is_max(node_eigenvector(ison_networkers))) %>% + mutate(who_to_convince = node_is_max(node_by_eigenvector(ison_networkers))) %>% graphr(node_color = who_to_convince) beliefs2 <- rep(0, net_nodes(ison_networkers)) -beliefs2[node_is_max(node_eigenvector(ison_networkers))] <- 1 +beliefs2[node_is_max(node_by_eigenvector(ison_networkers))] <- 1 ison_networkers %>% mutate(beliefs = beliefs2) %>% graphr(node_color = "beliefs") (netlearn2 <- play_learning(ison_networkers, beliefs2)) plot(netlearn2) diff --git a/inst/tutorials/tutorial7/diffusion.html b/inst/tutorials/tutorial7/diffusion.html index 7a9ee72a..9459e1bf 100644 --- a/inst/tutorials/tutorial7/diffusion.html +++ b/inst/tutorials/tutorial7/diffusion.html @@ -13,7 +13,7 @@ - + Diffusion and Learning @@ -291,14 +291,14 @@

Varying network structure

But there is an easier way. Play these same diffusions again, this time nesting the call within -net_infection_complete().

+net_by_infection_complete().

-
net_infection_complete(play_diffusion(create_ring(32, width = 2)))
-net_infection_complete(play_diffusion(generate_random(32, 0.15)))
-net_infection_complete(play_diffusion(generate_scalefree(32, 0.025)))
-net_infection_complete(play_diffusion(generate_smallworld(32, 0.025)))
+
net_by_infection_complete(play_diffusion(create_ring(32, width = 2)))
+net_by_infection_complete(play_diffusion(generate_random(32, 0.15)))
+net_by_infection_complete(play_diffusion(generate_scalefree(32, 0.025)))
+net_by_infection_complete(play_diffusion(generate_smallworld(32, 0.025)))
@@ -326,7 +326,7 @@

Free play: US States

us_diff <- play_diffusion(irps_usgeo, seeds = 5)
 plot(us_diff)
 graphr(us_diff)
-net_infection_complete(us_diff)
+net_by_infection_complete(us_diff)

What’s happening here? Can you interpret this?

@@ -631,9 +631,9 @@

Choosing where to seed

sf <- generate_scalefree(32, 0.025)
 sf %>%
   as_tidygraph() %>%
-  mutate(degree = ifelse(node_is_max(node_degree(sf)) == TRUE, "max",
-                      ifelse(node_is_min(node_degree(sf)) == TRUE, "min", "others"))) %>%
-  graphr(node_color = "degree") + guides(color = "legend") + labs(color = "degree")
+ mutate(degree = ifelse(node_is_max(node_by_degree(sf)) == TRUE, "max", + ifelse(node_is_min(node_by_degree(sf)) == TRUE, "min", "others"))) %>% + graphr(node_color = "degree") + guides(color = "legend")
Choosing where to seed data-lines="0" data-pipe="|>"> 
plot(play_diffusion(sf, seeds = 10, steps = 10))
 plot(play_diffusion(sf, seeds = node_is_random(sf), steps = 10))
-plot(play_diffusion(sf, seeds = node_is_max(node_degree(sf)), steps = 10))
-plot(play_diffusion(sf, seeds = node_is_min(node_degree(sf)), steps = 10))
+plot(play_diffusion(sf, seeds = node_is_max(node_by_degree(sf)), steps = 10))
+plot(play_diffusion(sf, seeds = node_is_min(node_by_degree(sf)), steps = 10))
 
 # visualise diffusion in scalefree network
-graphs(play_diffusion(sf, seeds = node_is_min(node_degree(sf)), steps = 10))
+graphs(play_diffusion(sf, seeds = node_is_min(node_by_degree(sf)), steps = 10))
 graphs(play_diffusion(sf, seeds = 16, steps = 10), waves = 1:3)
@@ -884,15 +884,15 @@

Make it stop

- Where \(R_0\) = 1, the ‘disease’ will continue as endemic, if conditions allow.

So how can we establish the \(R_0\) -here? We can use net_reproduction().

+here? We can use net_by_reproduction().

rd_diff <- play_diffusion(rando, transmissibility = 0.25, recovery = 0.05)
 plot(rd_diff)
 # R-nought
-net_reproduction(rd_diff)
-net_infection_total(rd_diff)
+net_by_reproduction(rd_diff) +net_by_infection_total(rd_diff)
@@ -928,15 +928,15 @@

How many people do we need to vaccinate?

Herd Immunity Threshold or HIT. HIT indicates the threshold at which the reduction of susceptible members of the network means that infections will no longer keep increasing, allowing herd -immunity to be achieved. net_immunity() gives us the +immunity to be achieved. net_by_immunity() gives us the proportion of the population that would need to be recovered or vaccinated for the network to have herd immunity.

# Herd Immunity Threshold
-net_immunity(rd_diff)
-net_immunity(rd_diff, normalized = FALSE)
+net_by_immunity(rd_diff) +net_by_immunity(rd_diff, normalized = FALSE)

In this model, the HIT score indicates a good proportion of nodes in @@ -950,7 +950,7 @@

How many people do we need to vaccinate?

rd_diff_vacc <- play_diffusion(rando, transmissibility = 0.25, recovery = 0.05, 
                                immune = 2:9)
 plot(rd_diff_vacc)
-net_infection_total(rd_diff_vacc)
+net_by_infection_total(rd_diff_vacc)

We can see that we more rapidly reach a situation in which vaccinated @@ -1118,12 +1118,12 @@

Free play: Networkers

-
node_eigenvector(ison_networkers)
+
node_by_eigenvector(ison_networkers)
 ison_networkers %>% 
-  mutate(who_to_convince = node_is_max(node_eigenvector(ison_networkers))) %>% 
+  mutate(who_to_convince = node_is_max(node_by_eigenvector(ison_networkers))) %>% 
   graphr(node_color = who_to_convince)
 beliefs2 <- rep(0, net_nodes(ison_networkers))
-beliefs2[node_is_max(node_eigenvector(ison_networkers))] <- 1
+beliefs2[node_is_max(node_by_eigenvector(ison_networkers))] <- 1
 ison_networkers %>% mutate(beliefs = beliefs2) %>% graphr(node_color = "beliefs")
 (netlearn2 <- play_learning(ison_networkers, beliefs2))
 plot(netlearn2)

@@ -1536,7 +1536,7 @@ 
Glossary

 learnr:::store_exercise_cache(structure(list(label = "completeinfection", global_setup = structure(c("library(learnr)", 
 "library(migraph)", "clear_glossary()", "knitr::opts_chunk$set(echo = FALSE)"
 ), chunk_opts = list(label = "setup", include = FALSE)), setup = NULL, 
-    chunks = list(list(label = "completeinfection", code = "net_infection_complete(play_diffusion(create_ring(32, width = 2)))\nnet_infection_complete(play_diffusion(generate_random(32, 0.15)))\nnet_infection_complete(play_diffusion(generate_scalefree(32, 0.025)))\nnet_infection_complete(play_diffusion(generate_smallworld(32, 0.025)))", 
+    chunks = list(list(label = "completeinfection", code = "net_by_infection_complete(play_diffusion(create_ring(32, width = 2)))\nnet_by_infection_complete(play_diffusion(generate_random(32, 0.15)))\nnet_by_infection_complete(play_diffusion(generate_scalefree(32, 0.025)))\nnet_by_infection_complete(play_diffusion(generate_smallworld(32, 0.025)))", 
         opts = list(label = "\"completeinfection\"", exercise = "TRUE", 
             purl = "FALSE", fig.width = "9"), engine = "r")), 
     code_check = NULL, error_check = NULL, check = NULL, solution = NULL, 
@@ -1557,10 +1557,10 @@ 
Glossary

         message = TRUE, render = NULL, ref.label = NULL, child = NULL, 
         engine = "r", split = FALSE, include = TRUE, purl = FALSE, 
         max.print = 1000, label = "completeinfection", exercise = TRUE, 
-        code = c("net_infection_complete(play_diffusion(create_ring(32, width = 2)))", 
-        "net_infection_complete(play_diffusion(generate_random(32, 0.15)))", 
-        "net_infection_complete(play_diffusion(generate_scalefree(32, 0.025)))", 
-        "net_infection_complete(play_diffusion(generate_smallworld(32, 0.025)))"
+        code = c("net_by_infection_complete(play_diffusion(create_ring(32, width = 2)))", 
+        "net_by_infection_complete(play_diffusion(generate_random(32, 0.15)))", 
+        "net_by_infection_complete(play_diffusion(generate_scalefree(32, 0.025)))", 
+        "net_by_infection_complete(play_diffusion(generate_smallworld(32, 0.025)))"
         ), out.width.px = 864, out.height.px = 384, params.src = "completeinfection, exercise = TRUE, purl = FALSE, fig.width=9", 
         fig.num = 0, exercise.df_print = "paged", exercise.checker = "NULL"), 
     engine = "r", version = "4"), class = c("r", "tutorial_exercise"
@@ -1570,11 +1570,11 @@ 
Glossary

 
 
@@ -1676,19 +1676,19 @@ 
Glossary

 
  
@@ -1746,10 +1746,10 @@ 
Glossary

 
 
@@ -1810,10 +1810,10 @@ 
Glossary

 
  
@@ -1998,10 +1998,10 @@ 
Glossary

 
 
@@ -2104,10 +2104,10 @@ 
Glossary

 
  
@@ -2172,10 +2172,10 @@ 
Glossary

 
 
@@ -2202,7 +2202,7 @@ 
Glossary

 learnr:::store_exercise_cache(structure(list(label = "sf", global_setup = structure(c("library(learnr)", 
 "library(migraph)", "clear_glossary()", "knitr::opts_chunk$set(echo = FALSE)"
 ), chunk_opts = list(label = "setup", include = FALSE)), setup = NULL, 
-    chunks = list(list(label = "sf", code = "sf <- generate_scalefree(32, 0.025)\nsf %>%\n  as_tidygraph() %>%\n  mutate(degree = ifelse(node_is_max(node_degree(sf)) == TRUE, \"max\",\n                      ifelse(node_is_min(node_degree(sf)) == TRUE, \"min\", \"others\"))) %>%\n  graphr(node_color = \"degree\") + guides(color = \"legend\") + labs(color = \"degree\")", 
+    chunks = list(list(label = "sf", code = "sf <- generate_scalefree(32, 0.025)\nsf %>%\n  as_tidygraph() %>%\n  mutate(degree = ifelse(node_is_max(node_by_degree(sf)) == TRUE, \"max\",\n                      ifelse(node_is_min(node_by_degree(sf)) == TRUE, \"min\", \"others\"))) %>%\n  graphr(node_color = \"degree\") + guides(color = \"legend\")", 
         opts = list(label = "\"sf\"", exercise = "TRUE", fig.width = "9"), 
         engine = "r")), code_check = NULL, error_check = NULL, 
     check = NULL, solution = NULL, tests = NULL, options = list(
@@ -2222,9 +2222,9 @@ 
Glossary

         message = TRUE, render = NULL, ref.label = NULL, child = NULL, 
         engine = "r", split = FALSE, include = TRUE, purl = TRUE, 
         max.print = 1000, label = "sf", exercise = TRUE, code = c("sf <- generate_scalefree(32, 0.025)", 
-        "sf %>%", "  as_tidygraph() %>%", "  mutate(degree = ifelse(node_is_max(node_degree(sf)) == TRUE, \"max\",", 
-        "                      ifelse(node_is_min(node_degree(sf)) == TRUE, \"min\", \"others\"))) %>%", 
-        "  graphr(node_color = \"degree\") + guides(color = \"legend\") + labs(color = \"degree\")"
+        "sf %>%", "  as_tidygraph() %>%", "  mutate(degree = ifelse(node_is_max(node_by_degree(sf)) == TRUE, \"max\",", 
+        "                      ifelse(node_is_min(node_by_degree(sf)) == TRUE, \"min\", \"others\"))) %>%", 
+        "  graphr(node_color = \"degree\") + guides(color = \"legend\")"
         ), out.width.px = 864, out.height.px = 384, params.src = "sf, exercise=TRUE, fig.width=9", 
         fig.num = 0, exercise.df_print = "paged", exercise.checker = "NULL"), 
     engine = "r", version = "4"), class = c("r", "tutorial_exercise"
@@ -2242,17 +2242,17 @@ 
Glossary

 
  
@@ -2325,8 +2325,8 @@ 
Glossary

 
 
@@ -2634,16 +2634,16 @@ 
Glossary

 
  
@@ -2719,7 +2719,7 @@ 
Glossary

     chunks = list(list(label = "diffusions", code = "rando <- generate_random(32, 0.1)\ngraphr(rando)\nplot(play_diffusions(rando, transmissibility = 0.5, times = 5, steps = 10))", 
         opts = list(label = "\"diffusions\"", exercise = "TRUE", 
             fig.width = "9"), engine = "r"), list(label = "r0", 
-        code = "rd_diff <- play_diffusion(rando, transmissibility = 0.25, recovery = 0.05)\nplot(rd_diff)\n# R-nought\nnet_reproduction(rd_diff)\nnet_infection_total(rd_diff)", 
+        code = "rd_diff <- play_diffusion(rando, transmissibility = 0.25, recovery = 0.05)\nplot(rd_diff)\n# R-nought\nnet_by_reproduction(rd_diff)\nnet_by_infection_total(rd_diff)", 
         opts = list(label = "\"r0\"", exercise = "TRUE", exercise.setup = "\"diffusions\"", 
             fig.width = "9"), engine = "r")), code_check = NULL, 
     error_check = NULL, check = NULL, solution = NULL, tests = NULL, 
@@ -2741,8 +2741,8 @@ 
Glossary

         engine = "r", split = FALSE, include = TRUE, purl = TRUE, 
         max.print = 1000, label = "r0", exercise = TRUE, exercise.setup = "diffusions", 
         code = c("rd_diff <- play_diffusion(rando, transmissibility = 0.25, recovery = 0.05)", 
-        "plot(rd_diff)", "# R-nought", "net_reproduction(rd_diff)", 
-        "net_infection_total(rd_diff)"), out.width.px = 864, 
+        "plot(rd_diff)", "# R-nought", "net_by_reproduction(rd_diff)", 
+        "net_by_infection_total(rd_diff)"), out.width.px = 864, 
         out.height.px = 384, params.src = "r0, exercise = TRUE, exercise.setup = \"diffusions\", fig.width=9", 
         fig.num = 0, exercise.df_print = "paged", exercise.checker = "NULL"), 
     engine = "r", version = "4"), class = c("r", "tutorial_exercise"
@@ -2752,16 +2752,16 @@ 
Glossary

 
 
@@ -2781,17 +2781,17 @@ 
Glossary

 
  
@@ -2819,14 +2819,14 @@ 
Glossary

 
 
@@ -3006,20 +3006,20 @@ 
Glossary

 
  
@@ -3081,27 +3081,27 @@ 
Glossary

 
 
@@ -3160,12 +3160,12 @@ 
Glossary
diff --git a/inst/tutorials/tutorial8/diversity.Rmd b/inst/tutorials/tutorial8/diversity.Rmd index d15e1ed2..b0906e65 100644 --- a/inst/tutorials/tutorial8/diversity.Rmd +++ b/inst/tutorials/tutorial8/diversity.Rmd @@ -173,15 +173,15 @@ net_node_attributes(marvel_friends) ``` ```{r rich-hint, purl = FALSE} -net_richness(____, ____) +net_by_richness(____, ____) ``` ```{r rich-solution} -net_richness(marvel_friends, "Gender") -net_richness(marvel_friends, "PowerOrigin") -net_richness(marvel_friends, "Attractive") -net_richness(marvel_friends, "Rich") -net_richness(marvel_friends, "Intellect") +net_by_richness(marvel_friends, "Gender") +net_by_richness(marvel_friends, "PowerOrigin") +net_by_richness(marvel_friends, "Attractive") +net_by_richness(marvel_friends, "Rich") +net_by_richness(marvel_friends, "Intellect") ``` ```{r richness-question, echo=FALSE, purl = FALSE} @@ -226,15 +226,15 @@ Obtain the network diversity scores for the five attributes used above. ``` ```{r blau-hint, purl = FALSE} -net_diversity(____, ____) +net_by_diversity(____, ____) ``` ```{r blau-solution} -net_diversity(marvel_friends, "Gender") -net_diversity(marvel_friends, "PowerOrigin") -net_diversity(marvel_friends, "Attractive") -net_diversity(marvel_friends, "Rich") -net_diversity(marvel_friends, "Intellect") +net_by_diversity(marvel_friends, "Gender") +net_by_diversity(marvel_friends, "PowerOrigin") +net_by_diversity(marvel_friends, "Attractive") +net_by_diversity(marvel_friends, "Rich") +net_by_diversity(marvel_friends, "Intellect") ``` Looks like there is more diversity in terms of where these characters got @@ -255,9 +255,9 @@ over_membership(.data, FUN, ..., membership) ``` ```{r crossref-solution} -over_membership(marvel_friends, net_diversity, "Gender", +over_membership(marvel_friends, net_by_diversity, "Gender", membership = "PowerOrigin") -over_membership(marvel_friends, net_diversity, "Intellect", +over_membership(marvel_friends, net_by_diversity, "Intellect", membership = "Gender") ``` @@ -285,7 +285,7 @@ $$\frac{E-I}{E+I}$$ where $E$ is the number of ties present between a variable's categories (i.e. external), and $I$ is the number of ties present within a variable's categories (i.e. internal). As such, an EI index of -1 suggests perfect homophily, whereas an EI index of +1 suggests perfect `r gloss("heterophily.","heterophily")` -(This is why the function is called `net_heterophily()`). +(This is why the function is called `net_by_heterophily()`). Check how homophilic three variables in the network are, "Gender", "PowerOrigin", and "Attractive". @@ -296,13 +296,13 @@ Please assign the results so that we can use them later. ``` ```{r ei-hint, purl = FALSE} -net_heterophily(____, ____) +net_by_heterophily(____, ____) ``` ```{r ei-solution} -(obs.gender <- net_heterophily(marvel_friends, "Gender")) -(obs.powers <- net_heterophily(marvel_friends, "PowerOrigin")) -(obs.attract <- net_heterophily(marvel_friends, "Attractive")) +(obs.gender <- net_by_heterophily(marvel_friends, "Gender")) +(obs.powers <- net_by_heterophily(marvel_friends, "PowerOrigin")) +(obs.attract <- net_by_heterophily(marvel_friends, "Attractive")) ``` ```{r homophily-present, echo=FALSE, purl = FALSE} @@ -354,13 +354,13 @@ plot(rand.____) ```{r rando-hint-3, purl = FALSE} rand.gender <- test_random(marvel_friends, - net_heterophily, attribute = "Gender", + net_by_heterophily, attribute = "Gender", times = 1000) rand.power <- test_random(marvel_friends, - net_heterophily, attribute = "PowerOrigin", + net_by_heterophily, attribute = "PowerOrigin", times = 1000) rand.attract <- test_random(marvel_friends, - net_heterophily, attribute = "Attractive", + net_by_heterophily, attribute = "Attractive", times = 1000) plot(rand.gender) + ggtitle("CUG test results for 'Gender' attribute") plot(rand.power) + ggtitle("CUG test results for 'PowerOrigin' attribute") @@ -369,13 +369,13 @@ plot(rand.attract) + ggtitle("CUG test results for 'Attractive' attribute") ```{r rando-solution} rand.gender <- test_random(marvel_friends, - net_heterophily, attribute = "Gender", + net_by_heterophily, attribute = "Gender", times = 1000) rand.power <- test_random(marvel_friends, - net_heterophily, attribute = "PowerOrigin", + net_by_heterophily, attribute = "PowerOrigin", times = 1000) rand.attract <- test_random(marvel_friends, - net_heterophily, attribute = "Attractive", + net_by_heterophily, attribute = "Attractive", times = 1000) plot(rand.gender) + ggtitle("CUG test results for 'Gender' attribute") plot(rand.power) + ggtitle("CUG test results for 'PowerOrigin' attribute") @@ -438,7 +438,7 @@ Let's first plot the observed data and some permuted data next to each other. ``` ```{r perm-hint, purl = FALSE} -graphr(generate_permutation(____, with_attr = TRUE), ____) +graphr(to_permuted(____, with_attr = TRUE), ____) ``` ```{r perm-solution} @@ -446,7 +446,7 @@ old <- graphr(marvel_friends, labels = FALSE, node_size = 6, node_color = "PowerOrigin", node_shape = "Gender") + ggtitle("Original network") -new <- graphr(generate_permutation(marvel_friends, with_attr = TRUE), +new <- graphr(to_permuted(marvel_friends, with_attr = TRUE), labels = FALSE, node_size = 6, node_color = "PowerOrigin", node_shape = "Gender") + ggtitle("Permuted network") @@ -487,10 +487,10 @@ test_permutation(____, FUN = ____, attribute = ____, ```{r testperm-solution} (perm.gender <- test_permutation(marvel_friends, - net_heterophily, attribute = "Gender", + net_by_heterophily, attribute = "Gender", times = 1000)) (perm.power <- test_permutation(marvel_friends, - net_heterophily, attribute = "PowerOrigin", + net_by_heterophily, attribute = "PowerOrigin", times = 1000)) (plot(rand.gender) + ggtitle("CUG test results for 'Gender' attribute") + diff --git a/inst/tutorials/tutorial8/diversity.html b/inst/tutorials/tutorial8/diversity.html index 9dbe332e..9dceb6fb 100644 --- a/inst/tutorials/tutorial8/diversity.html +++ b/inst/tutorials/tutorial8/diversity.html @@ -13,7 +13,7 @@ - + Diversity and Regression @@ -137,11 +137,11 @@

Initial visualisation

For this session, we’ll explore a couple of different datasets. First, let’s examine homogeneity/ -heterogeneity in the Marvel relationships dataset from -{manynet}, ison_marvel_relationships. The -dataset is quite complicated, so to make this simpler, let’s concentrate -on:

+heterogeneity in the Marvel dataset from +{manynet}, fict_marvel. The dataset is quite +complicated, so to make this simpler, let’s concentrate on: