-
Notifications
You must be signed in to change notification settings - Fork 2
/
indices.R
94 lines (93 loc) · 3.76 KB
/
indices.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
83
84
85
86
87
88
89
90
91
92
93
94
#' Isolation Index
#' @description Given two groups (A and B) of individuals, the isolation index captures the
#' extent to which group A disproportionately visit websites whose other visitors
#' are also members of group A.
#' @param grp_a vector (usually corresponds to a column in a webtrack
#' data frame) indicating the number of individuals of group A using a website
#' @param grp_b vector (usually corresponds to a column in a webtrack
#' data frame) indicating the number of individuals of group B using a website
#' @param adjusted logical. should the index be adjusted (defaults to FALSE)
#' @details a value of 1 indicates that the websites visited by group A and group B do not overlap.
#' A value of 0 means both visit exactly the same websites
#' @return numeric value between 0 and 1. 0 indicates no isolation and 1 perfect isolation
#' @references
#' Cutler, David M., Edward L. Glaeser, and Jacob L. Vigdor. "The rise and decline of the American ghetto." Journal of political economy 107.3 (1999): 455-506.
#' Gentzkow, Matthew, and Jesse M. Shapiro. "Ideological segregation online and offline." The Quarterly Journal of Economics 126.4 (2011): 1799-1839.
#' @examples
#' # perfect isolation
#' grp_a <- c(5, 5, 0, 0)
#' grp_b <- c(0, 0, 5, 5)
#' isolation_index(grp_a, grp_b)
#'
#' # perfect overlap
#' grp_a <- c(5, 5, 5, 5)
#' grp_b <- c(5, 5, 5, 5)
#' isolation_index(grp_a, grp_b)
#' @export
isolation_index <- function(grp_a, grp_b, adjusted = FALSE) {
if (length(grp_a) != length(grp_b)) {
stop("grp_a and grp_b need to have the same length")
}
if (isFALSE(adjusted)) {
grp_a <- grp_a / sum(grp_a, na.rm = TRUE)
grp_b <- grp_b / sum(grp_b, na.rm = TRUE)
right_share <- grp_b / (grp_a + grp_b)
out <- (grp_b - grp_a) * right_share
return(sum(out, na.rm = TRUE))
} else {
out <- 1 / sum(grp_a, na.rm = TRUE) * grp_a * (grp_a - 1) / (grp_a + grp_b - 1)
out <- out - 1 / sum(grp_b, na.rm = TRUE) * (grp_b * grp_a) / (grp_a + grp_b - 1)
return(sum(out, na.rm = TRUE))
}
}
#' Dissimilarity Index
#' @description The Dissimilarity Index can be interpreted as the share of Group A
#' visits that would need to be redistributed across media for the share of
#' group A to be uniform across websites.
#' @inheritParams isolation_index
#' @references
#' Cutler, David M., Edward L. Glaeser, and Jacob L. Vigdor. "The rise and decline of the American ghetto." Journal of political economy 107.3 (1999): 455-506.
#' @examples
#' # perfect dissimilarity
#' grp_a <- c(5, 5, 0, 0)
#' grp_b <- c(0, 0, 5, 5)
#' dissimilarity_index(grp_a, grp_b)
#'
#' # no dissimilarity
#' grp_a <- c(5, 5, 5, 5)
#' grp_b <- c(5, 5, 5, 5)
#' dissimilarity_index(grp_a, grp_b)
#' @export
dissimilarity_index <- function(grp_a, grp_b) {
if (length(grp_a) != length(grp_b)) {
stop("grp_a and grp_b need to have the same length")
}
grp_a <- grp_a / sum(grp_a, na.rm = TRUE)
grp_b <- grp_b / sum(grp_b, na.rm = TRUE)
out <- abs(grp_b - grp_a)
0.5 * sum(out, na.rm = TRUE)
}
#' Symmetric Atkinson Index
#' calculates the symmetric Atkinson index
#' @inheritParams isolation_index
#' @references
#' Frankel, David, and Oscar Volij. "Scale Invariant Measures of Segregation "Working Paper, 2008.
#' @examples
#' # perfect score
#' grp_a <- c(5, 5, 0, 0)
#' grp_b <- c(0, 0, 5, 5)
#' atkinson_index(grp_a, grp_b)
#'
#' grp_a <- c(5, 5, 5, 5)
#' grp_b <- c(5, 5, 5, 5)
#' atkinson_index(grp_a, grp_b)
#' @export
atkinson_index <- function(grp_a, grp_b) {
if (length(grp_a) != length(grp_b)) {
stop("grp_a and grp_b need to have the same length")
}
grp_a <- (grp_a / sum(grp_a, na.rm = TRUE))^(1 / 2)
grp_b <- (grp_b / sum(grp_b, na.rm = TRUE))^(1 / 2)
bilanz <- grp_a * grp_b
1 - sum(bilanz, na.rm = TRUE)
}