-
Notifications
You must be signed in to change notification settings - Fork 2
/
utils.R
84 lines (73 loc) · 2.51 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
#' Generate random draws based on empirical c.d.f.
#'
#' Generate random draws from a set of quantiles, based on the empirical
#' cumulative density function
#'
#' @param n integer, the number of draws to generate
#' @param probs numeric vector, the probabilities
#' @param qtls numeric vector, the quantiles for the probabilities
#' specified in `probs`
#'
#' @details Based on the Inverse Transform Sampling technique, by sampling
#' random probabilities from a uniform distribution and interpolate (cubic)
#' the count samples from the percentiles provided by the user (taken as the
#' empirical cumulative density function)
#'
#' @return a numeric vector, with random draws of the approximated distribution
#' underpinning the provided quantiles
#' @export
#' @examples
#' sample_qtls(10,c(0.1,0.2,0.3),qtls=c(0.05,0.1,0.95))
sample_qtls <- function(n, probs, qtls){
x_intPoints <- runif(n, min(probs), max(probs))
y_intPoints <- pracma::interp1(probs, qtls, xi = x_intPoints, method = "cubic")
return(y_intPoints)
}
# The inverse of %in%, returning elements absent from a vector
"%nin%" <- Negate("%in%")
#' Format any month name to three letter code
#' @param months character string or vector. The name of the month
#'
#' @return a character string. The three letter name of the month
#' @examples
#' format_months("January")
#' @export
format_months <- function(months){
substr(months, 1, 1) <- toupper(substr(months, 1, 1))
return(substr(months, 1, 3))
}
#' Generate sequence of months
#'
#' @param start_month character string, the three-letter name of the starting month.
#' @param end_month character string, the three-letter name of the finishing month.
#'
#' @return character vector. The list of months that falls in between two months
#' @examples
#' seq_months("Jan", "Apr")
#' @export
seq_months <- function(start_month, end_month){
Mst <- which(month.abb == start_month)
Men <- which(month.abb == end_month)
if(Mst > Men){
Mnths <- c(month.abb[Mst:12],month.abb[1:Men])
}else{
Mnths <- month.abb[Mst:Men]
}
return(Mnths)
}
# Name of parent function
#
# Returns the name of the parent function relative to current evaluation. Returns "GlobalEnv"
# if parent frame is the Global environment.
parent_fn_name <- function(){
grandparent_call <- sys.call(-2)
if(is.null(grandparent_call)){
"GlobalEnv"
}else{
sub("\\(.+", "", deparse(grandparent_call, nlines = 1))
}
}
# check if a number is whole
is.wholenumber <- function(x, tol = .Machine$double.eps^0.5){
abs(x - round(x)) < tol
}