basicr.R 1.8 KB
Newer Older
Jean-Marie Lepioufle's avatar
Jean-Marie Lepioufle committed
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

#' basicr

#' basicr
#' @param dataset tbl_friendlyts object
#' @param target target
#' @param group group character
#' @keywords basicr
#' @export
#' @examples
#' \dontrun{
#' basicr()
#' }
basicr <- function(dataset,target,group="none"){

  if (is.null(dataset) || (!inherits(dataset,"tbl_friendlyts")) ) {
    stop("need non-null tbl_friendlyts dataset")
  }

  res <- switch(group,
    "none"  = dataset %>% basic_(target=target),
    "HOUR"  = dataset %>% group_by(HOUR) %>% basic_(target=target),
    "WDAY"  = dataset %>% group_by(wday) %>% basic_(target=target),
    "MONTH" = dataset %>% group_by(MONTH) %>% basic_(target=target),
    stop("group not recognized"))

  res <- as_tbl_basic(res,group)

  return(res)
}

#' basic_

#' basic_
#' @param dataset tbl_friendlyts object
#' @param target character
#' @keywords basicr
#' @export
#' @examples
#' \dontrun{
#' basic_()
#' }
basic_ <- function(dataset,target){

  names(dataset)[names(dataset)==target] <- "targ"

  res <- dataset %>% summarise(
      n = n(),
      q0  = as.numeric(stats::quantile(targ,probs=0,na.rm=TRUE)),
      q1  = as.numeric(stats::quantile(targ,probs=0.25,na.rm=TRUE)),
      q2  = as.numeric(stats::quantile(targ,probs=0.50,na.rm=TRUE)),
      q3  = as.numeric(stats::quantile(targ,probs=0.75,na.rm=TRUE)),
      q4  = as.numeric(stats::quantile(targ,probs=1,na.rm=TRUE)),
      IQR = as.numeric(stats::quantile(targ,probs=0.75,na.rm=TRUE)) - as.numeric(stats::quantile(targ,probs=0.25,na.rm=TRUE)),
      m   = mean(targ, na.rm = TRUE),
      sd  = stats::sd(targ, na.rm = TRUE),
      cv  = stats::sd(targ, na.rm = TRUE)/mean(targ, na.rm = TRUE)
  )

  indice <- which(is.na(res$m))
  if (length(indice)>0) {
    res$m[indice] <- mean(res$m,na.rm=TRUE)
    res$sd[indice] <- mean(res$sd,na.rm=TRUE)
    return(res)

  } else {
    return(res)
  }

}