File: LSD.heatboxplot.R

package info (click to toggle)
r-cran-lsd 4.1-0-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, forky, sid, trixie
  • size: 420 kB
  • sloc: makefile: 2
file content (141 lines) | stat: -rwxr-xr-x 9,827 bytes parent folder | download
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


### densitylane ###


#' @name densitylane
#' @aliases LSD.densitylane
#' @title Visualize a density in a rectangular fashion
#' @description Add a color stripe to an existing plot based on a kernel density estimate.
#' @param x density$x values of a density object.
#' @param y density$y values of a density object.
#' @param pos the x co-ordinate of the lane (mid point).
#' @param width a numeric value giving the width of the lane.
#' @param colpal a character vector containing R built-in color names or a name of a \code{LSD} colorpalette as a character string (see disco() or \code{\link{disco}}) (defaults to "heat", if not specified).
#' @param rev logical: if \code{TRUE} (\code{FALSE} by default), a reversed colorpalette is used.
#' @param simulate logical: if \code{TRUE} (\code{FALSE} by default), a converted colorpalette is used to simulate dichromat vision according to \url{http://www.daltonize.org} (see \code{\link{daltonize}}).
#' @param daltonize logical: if \code{TRUE} (\code{FALSE} by default), a converted colorpalette is used to enhance dichromat vision according to \url{http://www.daltonize.org} (see \code{\link{daltonize}}).
#' @param cvd character string implying the type of color vision deficiency ("p" for protanope, "d" for deuteranope or "t" for tritanope).
#' @param alpha alpha value: a two-digit integer between 01 and 99 for color opacity, i.e. appearance of partial or full transparency (usage omitted by default).
#' @param horizontal logical: if \code{TRUE} (\code{FALSE} by default), rotation of 90 degrees is applied.
#' @param nrcol a non-negative integer specifying the number of colors to be used (defaults to 100, if not specified).
#' @author Bjoern Schwalb
#' @seealso \code{\link{comparisonplot}}, \code{\link{demotour}}, \code{\link{disco}}, \code{\link{colorpalette}}
#' @keywords density


densitylane = function(x,y,pos = 1,width = 0.4,colpal = "standard",rev = FALSE,simulate = FALSE,daltonize = FALSE,cvd = "p",alpha = NULL,horizontal = horizontal,nrcol = 75)
{
	if (!is.vector(x) | !is.vector(y)) stop("First two argument must be vectors!")
	if (length(x) != length(y)) stop("Data vectors must be of the same length!")
	colpalette = rev(colorpalette(colpal,nrcol,simulate = simulate,daltonize = daltonize,cvd = cvd,alpha = alpha,rev = rev))
	ycol  = pmin(pmax(round((y-min(y))/(max(y)-min(y))*nrcol+0.5),1),nrcol)
	if (horizontal){for (j in 1:(length(x)-1)){rect(x[j],pos-width/2,x[j+1],pos+width/2,col=colpalette[ycol[j]],border=NA)}}
	else {for (j in 1:(length(x)-1)){rect(pos-width/2,x[j],pos+width/2,x[j+1],col=colpalette[ycol[j]],border=NA)}}
}


### aliases ###


LSD.densitylane = densitylane


### heatboxplot ###


#' @export
#' @name heatboxplot
#' @aliases LSD.heatboxplot
#' @title Heatboxplot: a colored boxplot
#' @description A boxplot with an additional color stripe based on a kernel density estimate.
#' @param x data as vector, matrix, list or data.frame.
#' @param horizontal logical: if \code{TRUE} (\code{FALSE} by default), rotation of 90 degrees is applied.
#' @param add logical: if \code{TRUE} (\code{FALSE} by default), the boxplot is added to an existing plot.
#' @param colpal a character vector containing R built-in color names or a name of a \code{LSD} colorpalette as a character string (see disco() or \code{\link{disco}}) (defaults to "heat", if not specified).
#' @param rev logical: if \code{TRUE} (\code{FALSE} by default), a reversed colorpalette is used.
#' @param simulate logical: if \code{TRUE} (\code{FALSE} by default), a converted colorpalette is used to simulate dichromat vision according to \url{http://www.daltonize.org} (see \code{\link{daltonize}}).
#' @param daltonize logical: if \code{TRUE} (\code{FALSE} by default), a converted colorpalette is used to enhance dichromat vision according to \url{http://www.daltonize.org} (see \code{\link{daltonize}}).
#' @param cvd character string implying the type of color vision deficiency ("p" for protanope, "d" for deuteranope or "t" for tritanope).
#' @param alpha alpha value: a two-digit integer between 01 and 99 for color opacity, i.e. appearance of partial or full transparency (usage omitted by default).
#' @param colpals a character vector containing names of \code{LSD} colorpalettes (see disco() or \code{\link{disco}}).
#' @param nrcol a non-negative integer specifying the number of colors to be used (defaults to 100, if not specified).
#' @param lwd linewidth of the box and whiskers.
#' @param axes logical: if \code{TRUE} (by default), the axes are plotted.
#' @param labels a character vector of labels.
#' @param xlim x limits, standard graphics parameter.
#' @param ylim y limits, standard graphics parameter.
#' @param xlab x label, standard graphics parameter.
#' @param ylab y label, standard graphics parameter.
#' @param main title(s) of the plot, standard graphics parameter.
#' @param nolab logical: if \code{TRUE} (\code{FALSE} by default), the title and ylab are suppressed.
#' @param outline logical: if \code{TRUE} (by default), outliers are plotted.
#' @param boxonly logical: if \code{TRUE} (\code{FALSE} by default), the density is only be plotted in the box.
#' @param adjust a numeric value giving the scaling factor for the used bandwidth (defaults to 1).
#' @param quant.from a numeric value (between 0 and 1) giving the quantile from which the density lane should be plotted.
#' @param quant.to a numeric value (between 0 and 1) giving the quantile to which the density lane should be plotted.
#' @param range a numeric value to determine how far the plot whiskers extend out from the box.
#' @param border an R build-in color for the box and whiskers.
#' @param plot.boxplot logical: if \code{TRUE} (by default), the boxplot is added to the density.
#' @param add.quartiles if \code{TRUE} (\code{FALSE} by default), only the box of the boxplot is added (if \code{plot.boxplot = FALSE}).
#' @param add.box logical: if \code{TRUE} (by default), the box is added to the plot.
#' @param n.density an integer specifying the number of equally spaced points at which the density is to be estimated.
#' @param cexbox a numerical value giving the amount by which the boxes should be magnified relative to the default.
#' @param ... additional parameters to be passed to points and plot.
#' @author Bjoern Schwalb
#' @seealso \code{\link{comparisonplot}}, \code{\link{demotour}}, \code{\link{disco}}, \code{\link{colorpalette}}
#' @examples f = c(rnorm(200),rnorm(200)+4)
#' h = rf(500,15,15)*10
#' g = rnorm(300)+1
#' 
#' heatboxplot(h)
#' 
#' heatboxplot(list(f=f,g=g),colpals=c("rdpu","greens"),labels=c("bimodal","unimodal"))
#' @keywords boxplot


heatboxplot = function(x,horizontal = FALSE,add = FALSE,colpal = "standard",rev = FALSE,simulate = FALSE,daltonize = FALSE,cvd = "p",alpha = NULL,colpals = NULL,nrcol = 75,lwd = 1.75,axes = TRUE,labels = NULL,xlim = NULL,ylim = NULL,xlab = NULL,ylab = "",main = "heatboxplot",nolab = FALSE,outline = TRUE,boxonly = FALSE,adjust = 1,quant.from = 0.25,quant.to = 0.75,range = 1.5,border = "black",plot.boxplot = TRUE,add.quartiles = TRUE,add.box = FALSE,n.density = 1024,cexbox = 0.6,...)
{
	if (!is.vector(x) & !is.matrix(x) & !is.list(x) & !is.data.frame(x)) stop("x must be a vector, matrix, list or a data.frame!")
	if (!is.list(x) & !is.matrix(x) & !is.data.frame(x)){x = cbind(x)}
	if (is.data.frame(x)){x = as.list(x)}
	if (is.matrix(x)){x = as.list(as.data.frame(x))}
	if (is.null(colpals)){colpals = rep(colpal,length(x))}
	if (!is.null(xlim)){print("xlim argument will be ignored!")}
	if (is.null(ylim)){ylim = range(unlist(x))}
	if (!is.null(xlab)){print("xlab argument will be ignored! Use labels instead!")} # necessary ? 
	if (length(x) == 1){xlab = labels}
	if (length(x) == 1){cexbox = 0.4}
	if (length(x) > 1){boxwex = cexbox} else{boxwex = NULL}
	if (nolab){ylab = NULL}
	if (horizontal){labdummy = ylab
		ylab = xlab
		xlab = labdummy}
	limlist = list()
	qlimlist = list()
	for (i in 1:length(x)){limlist[[i]] = c(quantile(x[[i]],quant.from),quantile(x[[i]],quant.to))}
	for (i in 1:length(x)){qlimlist[[i]] = c(quantile(x[[i]],0.25),quantile(x[[i]],0.75))}
	boxplot(x,border="white",add=add,horizontal=horizontal,axes=axes,xlim=c(0.5,length(x)+0.5),ylim=ylim,width=NULL,boxwex=boxwex,main="",ylab=ylab,xlab=xlab,names=labels,outline=outline,range=range,lwd=lwd,...)
	if (!nolab){mtext(paste(main),3,2,cex=1.25)}
	for (j in 1:length(x)){xrel = x[[j]][x[[j]] >= ylim[1] & x[[j]] <= ylim[2]]
		dx = density(xrel,n=n.density,adjust=adjust)
		if(boxonly){dxx = dx$x[dx$x >= limlist[[j]][1] & dx$x <= limlist[[j]][2]]
			dxy = dx$y[dx$x >= limlist[[j]][1] & dx$x <= limlist[[j]][2]]}
		else {dxx = dx$x
			dxy = dx$y}
		densitylane(dxx,dxy,colpal=colpals[[j]],horizontal=horizontal,pos=j,width=cexbox,nrcol=nrcol,simulate = simulate,daltonize = daltonize,cvd = cvd,alpha=alpha,rev = rev)}
	if (plot.boxplot){boxplot(x,add=TRUE,horizontal=horizontal,axes=axes,col="transparent",xlim=c(0.5,length(x)+0.5),ylim=ylim,width=NULL,boxwex=boxwex,names=labels,outline=outline,range=range,lwd=lwd,...)}                                 
	if (!plot.boxplot){if (add.quartiles) {if (horizontal){ for (j in 1:length(x)){rect(qlimlist[[j]][1],j-cexbox/2,qlimlist[[j]][2],j+cexbox/2,border="grey40",lwd=lwd)} }
			else { for (j in 1:length(x)){rect(j-cexbox/2,qlimlist[[j]][1],j+cexbox/2,qlimlist[[j]][2],border="grey40",lwd=lwd)} }}}
	if (add.box){if (horizontal){ for (j in 1:length(x)){rect(limlist[[j]][1],j-cexbox/2,limlist[[j]][2],j+cexbox/2,border=border,lwd=lwd)} }
		else { for (j in 1:length(x)){rect(j-cexbox/2,limlist[[j]][1],j+cexbox/2,limlist[[j]][2],border=border,lwd=lwd)} }}
}


### aliases ###


LSD.heatboxplot = heatboxplot