/
utils.R
146 lines (140 loc) · 5.14 KB
/
utils.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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
############################################################
#' @title Natural Breaks (Jenks)
#' @description Natural Breaks group data whose boundaries are set where there
#' are relatively big differences.
#' @param k A numeric value indicates how many breaks
#' @param df A data frame with selected variable. E.g. guerry["Crm_prs"]
#' @return A vector of numeric values of computed breaks
#' @examples
#' library(sf)
#' guerry_path <- system.file("extdata", "Guerry.shp", package = "rgeoda")
#' guerry <- st_read(guerry_path)
#' natural_breaks(k=5, guerry['Crm_prs'])
#' @export
natural_breaks <- function(k, df) {
if (inherits(df, "data.frame") == FALSE) {
stop("The input data needs to be a data.frame.")
}
data <- df[[1]]
return(p_naturalbreaks(k, data))
}
############################################################
#' @title Quantile Breaks
#' @description Quantile breaks data into groups that each have the same number
#' of observations
#' @param k A numeric value indicates how many breaks
#' @param df A data frame with selected variable. E.g. guerry["Crm_prs"]
#' @return A vector of numeric values of computed breaks
#' @examples
#' library(sf)
#' guerry_path <- system.file("extdata", "Guerry.shp", package = "rgeoda")
#' guerry <- st_read(guerry_path)
#' quantile_breaks(k=5, guerry['Crm_prs'])
#' @export
quantile_breaks <- function(k, df) {
if (inherits(df, "data.frame") == FALSE) {
stop("The input data needs to be a data.frame.")
}
data <- df[[1]]
return(p_quantilebreaks(k, data))
}
############################################################
#' @title (Box) Hinge15 Breaks
#' @description Hinge15 breaks data into 6 groups like box plot groups
#' (Lower outlier, < 25%, 25-50%, 50-75%, >75%, Upper outlier) with hinge=1.5
#' @param df A data frame with selected variable. E.g. guerry["Crm_prs"]
#' @return A vector of numeric values of computed breaks
#' @examples
#' library(sf)
#' guerry_path <- system.file("extdata", "Guerry.shp", package = "rgeoda")
#' guerry <- st_read(guerry_path)
#' hinge15_breaks(guerry['Crm_prs'])
#' @export
hinge15_breaks <- function(df) {
if (inherits(df, "data.frame") == FALSE) {
stop("The input data needs to be a data.frame.")
}
data <- df[[1]]
return(p_hinge15breaks(data))
}
############################################################
#' @title (Box) Hinge30 Breaks
#' @description Hinge30 breaks data into 6 groups like box plot groups
#' (Lower outlier, < 25%, 25-50%, 50-75%, >75%, Upper outlier) with hinge=3.0
#' @param df A data frame with selected variable. E.g. guerry["Crm_prs"]
#' @return A vector of numeric values of computed breaks
#' @examples
#' library(sf)
#' guerry_path <- system.file("extdata", "Guerry.shp", package = "rgeoda")
#' guerry <- st_read(guerry_path)
#' hinge30_breaks(guerry['Crm_prs'])
#' @export
hinge30_breaks <- function(df) {
if (inherits(df, "data.frame") == FALSE) {
stop("The input data needs to be a data.frame.")
}
data <- df[[1]]
return(p_hinge30breaks(data))
}
############################################################
#' @title Percentile Breaks
#' @description Percentile breaks data into 6 groups: the lowest 1%, 1-10%,
#' 10-50%, 50-90%, 90-99% and the top 1%.
#' @param df A data frame with selected variable. E.g. guerry["Crm_prs"]
#' @return A vector of numeric values of computed breaks
#' @examples
#' library(sf)
#' guerry_path <- system.file("extdata", "Guerry.shp", package = "rgeoda")
#' guerry <- st_read(guerry_path)
#' percentile_breaks(guerry['Crm_prs'])
#' @export
percentile_breaks <- function(df) {
if (inherits(df, "data.frame") == FALSE) {
stop("The input data needs to be a data.frame.")
}
data <- df[[1]]
return(p_percentilebreaks(data))
}
############################################################
#' @title Standard Deviation Breaks
#' @description Standard deviation breaks first transforms data to standard
#' deviation units (mean=0, stddev=1), and then divide the range of values into
#' 6 groups.
#' @param df A data frame with selected variable. E.g. guerry["Crm_prs"]
#' @return A vector of numeric values of computed breaks
#' @examples
#' library(sf)
#' guerry_path <- system.file("extdata", "Guerry.shp", package = "rgeoda")
#' guerry <- st_read(guerry_path)
#' stddev_breaks(guerry['Crm_prs'])
#' @export
stddev_breaks <- function(df) {
if (inherits(df, "data.frame") == FALSE) {
stop("The input data needs to be a data.frame.")
}
data <- df[[1]]
return(p_stddevbreaks(data))
}
#################################################################
#' @title Empirical Bayes(EB) Rate
#' @description The function to compute EB Rate from an event variable and a
#' base variable.
#' @param df A data frame with two selected variable: one is "event", anothor is
#' "base" variable. E.g. guerry[c("hr60", "po60")]
#' @return A data.frame with two columns "EB Rate" and "IsNull".
#' @examples
#' \dontrun{
#' library(sf)
#' nat <- st_read("natregimes.shp")
#' ebr <- eb_rates(nat[c("HR60", "PO60")])
#' ebr
#' }
#' @export
eb_rates <- function(df) {
if (inherits(df, "data.frame") == FALSE) {
stop("The input data needs to be a data.frame.")
}
event_data <- df[[1]]
base_data <- df[[2]]
return(p_eb_rate(event_data, base_data))
}