Nothing
#' Spaghetti plot
#'
#' Quick plot of paired differences, for exploratory purposes.
#' @param p1,p2 vectors of paired values (numerical vectors)
#' @param highlight should positive and negative differences within pairs highlighted with different colors? Logical
#' @param col.dif color vector if \code{highlight = TRUE}
#' @param groups.names labels for the groups names; numeric or character vector of length two.
#' @param ... further arguments to be passed to \code{plot} function.
#'
#' @export
#' @import graphics
#' @import stats
splot <- function(p1, p2, highlight = TRUE, col.dif = c("black","grey"), groups.names=c(1,2), ...){
dots <- list(...)
if(!"pch"%in%names(dots)) dots$pch=19
if(!"xlim"%in%names(dots)) dots$xlim=c(0.8,2.2)
grupo <- rep(groups.names,each=length(p1))
if(highlight){
diferencas <- p1-p2
do.call(stripchart, c(list(x=as.formula("c(p1[diferencas>0],p2[diferencas>0])~rep(groups.names,each=length(p1[diferencas>0]))"),
vertical =TRUE,col=col.dif[1], ylim=range(c(p1,p2))),dots))
do.call(stripchart, list(x=as.formula("c(p1[diferencas<=0],p2[diferencas<=0])~rep(groups.names,each=length(p1[diferencas<=0]))"),
vertical =TRUE,col=col.dif[2], pch=dots$pch, add=TRUE))
segments(x0=1,y0=p1[diferencas>0],x1=2,y1=p2[diferencas>0],col=col.dif[1])
segments(x0=1,y0=p1[diferencas<=0],x1=2,y1=p2[diferencas<=0], col=col.dif[2])
}
else{
do.call(stripchart, c(list(x=as.formula("c(p1,p2)~grupo"), vertical =TRUE),dots))
segments(x0=1,y0=p1,x1=2,y1=p2)
}
}
#' Statistic distribution plot
#'
#' Plots the distribution of the statistic of interest. Has switches to
#' plot the extreme values and
#' null hypothesis rejection region (also known as critical region).
#' @param dist the statistic distribution, as generated by
#' \code{\link{Rsampling}} (numeric vector)
#' @param svalue the result of applying the statistic over the original data
#' @param pside the alternative hypothesis for the hypothesis testing
#' @param extreme logical. should extreme points be highlighted in the plot?
#' @param vline logical. should the svalue be displayed as a vertical line?
#' @param rejection logical. should the critical region be highlighted?
#' @param ... further arguments to be passed to \code{hist} function.
#' @seealso See the package vignettes for more information about how to interpret this graph
#' @export
#' @import graphics
#' @import grDevices
dplot <- function(dist, svalue, pside=c("Two sided", "Greater", "Lesser"),
extreme = TRUE, vline = TRUE, rejection = TRUE, ...) {
# argument handling and default values
pside <- match.arg(pside)
dots <- list(...)
if(!"col" %in% names(dots)) dots$col = "skyblue"
if(!"border" %in% names(dots)) dots$border = "white"
# what should be the xlim?
maxx <- max(abs(dist))
if(abs(svalue) > maxx) maxx = abs(svalue);
if(!"xlim" %in% names(dots)) dots$xlim = 1.1*c(-maxx, maxx)
if(!"main" %in% names(dots)) dots$main = "Distribution of the statistic of interest"
if(!"xlab" %in% names(dots)) dots$xlab= "Statistic of interest"
# draws the histogram
oh <- do.call(hist, c(list(dist), dots))
# adds the extreme values in orange. the definition of "extreme" depends on whether the test is
# one sided or two sided
extremes <- switch(pside,
"Two sided" = dist[abs(dist) >= abs(svalue)],
"Greater" = dist[dist >= svalue],
"Lesser" = dist[dist <= svalue]
)
if(extreme && length(extremes)>0)
hist(extremes, xlim=dots$xlim, col="orange1", border = dots$border,
add=TRUE, breaks = oh$breaks)
# vertical svalue with the original statistic
if(vline) abline(v = svalue, lty=2, col="red")
# Vertical svalues for rejection region
dist.q <- quantile(dist, c(0.025, 0.975, 0.95, 0.05))
rrejection <- switch(pside,
"Two sided" = dist.q[1:2],
"Greater" = c(dots$xlim[1], dist.q[3]),
"Lesser" = c(dist.q[4], dots$xlim[2])
)
if(rejection)
rect(xleft=rrejection[1], xright=rrejection[2], ybottom = 0, ytop=max(oh$counts),
col=gray.colors(1,alpha=.3), lwd=0)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.