# R/frame_br.R In quokar: Quantile Regression Outlier Diagnostics with K Left Out Analysis

#### Documented in frame_br

```globalVariables(c("obs", "index", "variable", "value"))
#' @title Visualization of quantile regression model fitting: br algorithem
#' @param object quantile regression model using br method
#' @param tau quantiles can be a single quantile or a vector of
#' quantiles
#' @return All observations and the observations used in quantile
#' regression fitting using br algorithem
#' @description get the observation used in br algorithem
#' @details This is a function that can be used to create point plot
#' for the observations used in quantile regression fitting based
#' on 'br'method.
#' @author Wenjing Wang \email{[email protected]ail.com}
#' @examples
#' library(ggplot2)
#' library(quantreg)
#' data(ais)
#' tau <- c(0.1, 0.5, 0.9)
#' object1 <- rq(BMI ~ LBM, tau, method = 'br', data = ais)
#' data_plot <- frame_br(object1, tau)\$all_observation
#' choose <- frame_br(object1, tau)\$fitting_point
#' ggplot(data_plot,
#'  aes(x=value, y=data_plot[,2])) +
#'  geom_point(alpha = 0.1) +
#'  ylab('y') +
#'  xlab('x') +
#'  facet_wrap(~variable, scales = "free_x", ncol = 2) +
#'  geom_point(data = choose, aes(x = x, y = y,
#'                                       group = tau_flag,
#'                                       colour = tau_flag,
#'                                       shape = obs))
#'
#' object2 <- rq(BMI ~ Ht + LBM + Wt, tau, method = 'br',
#'             data = ais)
#' data_plot <- frame_br(object2, tau)\$all_observation
#' choose <- frame_br(object2, tau)\$fitting_point
#' ggplot(data_plot,
#'  aes(x=value, y=data_plot[,2])) +
#'  geom_point(alpha = 0.1) +
#'  ylab('y') +
#'  xlab('x') +
#'  facet_wrap(~variable, scales = "free_x", ncol = 2) +
#'  geom_point(data = choose, aes(x = x, y = y,
#'                                       group = tau_flag,
#'                                       colour = tau_flag,
#'                                       shape = obs))
#' @export
#' @useDynLib quokar
#'
frame_br <- function(object, tau){
y <- matrix(object\$y, ncol = 1)
colnames(y) <-'y'
x <- object\$x
x <- as.matrix(x)
ntau <- length(tau)
h <- matrix(0, nrow = ntau, ncol = ncol(x))
for (i in 1:ntau){
h[i, ] <- wh(object, tau[i])
}
colnames(h) <- paste('indice', 1:ncol(h), sep='')
tau_flag <- paste('tau', tau, sep = '=')
h <- cbind(tau_flag, data.frame(h))
print('Observations used in br method fitting')
print(h)
if(colnames(object\$x)[1] == '(Intercept)'){
x <- object\$x[,-1]
x <- as.matrix(x)
}
colnames(x) <- paste('x', 1:ncol(x), sep='')
data_plot <- data.frame(index = 1:length(y), y, x)
data_plot_g <- data_plot %>% gather(variable, value, -c(index, y))
choose_point <- h %>% gather(obs, index, -tau_flag)
merge_x_y <- choose_point %>%
inner_join(data_plot, by ='index')
choose_point2 <- merge_x_y %>% gather(variable, x,
-c(index, tau_flag, obs, y))

return(list(all_observation = data_plot_g, fitting_point = choose_point2))
}
```

## Try the quokar package in your browser

Any scripts or data that you put into this service are public.

quokar documentation built on Nov. 17, 2017, 6:20 a.m.