-
Notifications
You must be signed in to change notification settings - Fork 6
/
Copy pathcreate-spatial-neighbours.R
82 lines (80 loc) · 4 KB
/
create-spatial-neighbours.R
1
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
41
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
81
82
#' @name CreateSpatialNeighbours
#'
#' @export
#'
#' @title Distances between related family members, formatted for spatial analysis.
#'
#' @description This helper function formats the LinksPair datasets so it can be used in some types of spatial analyses. The \pkg{spdep} (Spatial Dependence) uses a sparse matrix (actually a [base::data.frame]) to represent neighbours.
#'
#' @usage CreateSpatialNeighbours(linksPairsDoubleEntered)
## CreateSpatialNeighbours79Gen2()
#'
#' @param linksPairsDoubleEntered A [base::data.frame] containing the links, preferably created by a function like [CreatePairLinksDoubleEntered()].
#'
#' @details There is one row per unique pair of subjects, *respecting order*. This has twice as many rows as [Links79Pair] and [Links79PairExpanded] (which have one row per unique pair of subjects, *irrespective of order*).
#'
#' [CreateSpatialNeighbours()] accepts any paired relationships in a [base::data.frame], as long as it contains the columns `SubjectTag_S1`, `SubjectTag_S2`, and `R`. See [Links79Pair] for more details about these columns.
#'
#' @return An S3 `spdep::spatial.neighbours` object to work with functions in the \pkg{spdep} package.
#'
#' `SubjectTag_S1` is renamed '`from`'.
#'
#' `SubjectTag_S2` is renamed '`to`'.
#'
#' `R` is renamed '`weight`'.
#'
#' The attribute `region.id` specifies each unique SubjectTag.
#'
#' The attribute `n` specifies the number of unique subjects.
#'
#' @references
#' Bard, D.E., Beasley, W.H., Meredith, K., & Rodgers, J.L. (2012). [*Biometric Analysis of Complex NLSY Pedigrees: Introducing a Conditional Autoregressive Biometric (CARB) Mixed Model*](https://link.springer.com/article/10.1007/s10519-012-9566-6). Behavior Genetics Association 42nd Annual Meeting. [Slides](https://r-forge.r-project.org/forum/forum.php?thread_id=4761&forum_id=4266&group_id=1330).
#'
#' Bivand, R., Pebesma, E., & Gomez-Rubio, V. (2013). [*Applied Spatial Data Analysis with R.*](https://link.springer.com/book/10.1007/978-1-4614-7618-4) New York: Springer. (Especially Chapter 9.)
#'
#' Banerjee, S., Carlin, B.P., & Gelfand, A.E. (2004). [*Hierarchical Modeling and Analysis for Spatial Data*](http://books.google.com/books/about/Hierarchical_Modeling_and_Analysis_for_S.html?id=YqpZKTp-Wh0C). Boca Raton: CRC Press.
#'
#' Lawson, A.B (2013). [*Bayesian Disease Mapping: Hierarchical Modeling in Spatial Epidemiology, Second Edition*](http://books.google.com/books?id=g7RJEZb1umwC). Boca Raton: CRC Press.
#'
#' The \pkg{spdep} package documentation: [spdep: Spatial dependence: weighting schemes, statistics and models](https://cran.r-project.org/package=spdep).
#'
#' @author Will Beasley and David Bard
#'
#' @note Notice the British variant of 'neighbo*u*rs' is used, to be consistent with the `spdep::spatial.neighbour` class.
#'
#' @examples
#' dsLinksAll <- Links79Pair
#' dsLinksGen1Housemates <- dsLinksAll[dsLinksAll$RelationshipPath == "Gen1Housemates", ]
#' dsLinksGen2Siblings <- dsLinksAll[dsLinksAll$RelationshipPath == "Gen2Siblings", ]
#'
#' spGen1 <- CreateSpatialNeighbours(dsLinksGen1Housemates)
#' spGen2 <- CreateSpatialNeighbours(dsLinksGen2Siblings)
#'
#' head(spGen2)
#' # Returns:
#' # from to weight
#' # 3 201 202 0.50
#' # 6 301 302 0.50
#' # 7 301 303 0.50
#' # 9 302 303 0.50
#' # 24 401 403 0.25
#' # 28 801 802 0.50
#'
#' table(spGen2$weight)
#' # Returns:
#' # 0.25 0.375 0.5 0.75 1
#' # 3442 610 6997 12 27
#' @keywords spatial analysis
#'
CreateSpatialNeighbours <- function(linksPairsDoubleEntered) {
ValidatePairLinks(linksPairsDoubleEntered)
ds <- base::subset(linksPairsDoubleEntered, select = c("SubjectTag_S1", "SubjectTag_S2", "R"))
base::colnames(ds)[base::colnames(ds) == "SubjectTag_S1"] <- "from"
base::colnames(ds)[base::colnames(ds) == "SubjectTag_S2"] <- "to"
base::colnames(ds)[base::colnames(ds) == "R"] <- "weight"
# summary(ds)
base::class(ds) <- c("spatial.neighbour", base::class(ds))
base::attr(ds, "region.id") <- base::unique(ds$from)
base::attr(ds, "n") <- base::length(base::unique(ds$from))
return(ds)
}