The R package berryFunctions, available at github.com/brry and CRAN, contains my collection of miscellaneous functions. A lot is related to plotting and hydrology (Vignette Rmd source).
Package installation
install.packages("berryFunctions")
library(berryFunctions)
To get the most recent development version from github:
source("https://raw.githubusercontent.com/brry/berryFunctions/master/R/instGit.R")
instGit("brry/berryFunctions")
TOC
Package highlights
Scatterpoints with third dimension classified into colors: colPoints, colPointsLegend, colPointsHist
(This uses severall helper functions like smallPlot, classify, logSpaced, pretty2, seqPal)
Write text with colored shape underneath: textField
Histogram of data with logarithmic axis: logHist, using logAxis
x <- sample(1:87, 150, TRUE); y <- sample(1:61, 150, TRUE); z <- diag(volcano[x,y])-95
colPoints(x,y,z, pch="+", legargs=list(y2=80, title="Elevation"), add=FALSE)
mtext("colPoints, textField", adj=0.05, outer=TRUE, line=-1.2, cex=1.2, font=2)
text(60,30, "unreadable text")
textField(60, 15, "good text", field="round", fill="orange", cex=1.2)
dat <- rbeta(1e4, 2, 80)*100; dat <- dat[dat>0.1]
logHist(dat, col="tan", breaks=50, main="logHist, logAxis")
Linear storage cascade (rainfall-runoff modelling): lsc, unitHydrograph, superPos, nse, rmse
# estimate parameters for Unit Hydrograph, plot data and simulation: lsc
QOBS <- dbeta(1:40/40, 3, 10) + rnorm(20,0,0.2) + c(seq(0,1,len=20), rep(1,20))
PREC <- c(1,1,3,4,5,5,4,3,1,1, rep(0,30))
lsc(PREC, QOBS, area=10, main="lsc, unitHydrograph, superPos") # , plotsim=F
## n k NSE psi
## 0.3923418 34.7377751 0.9246820 0.6615805
Quick linear Regression: linReg
Draw circle with given radius: circle
Add transparency to existing colors: addAlpha
Fit a wide range of function types to see which one is best: mReg
a <- 1:30 ; b <- a/2.345+rnorm(30,0,3)
linReg(a,b, main="linReg, circle, addAlpha")
circle(12,3, r=5, col=addAlpha("darkgreen"), border="blue", lwd=3)
x <- c(1.3, 1.6, 2.1, 2.9, 4.4, 5.7, 6.6, 8.3, 8.6, 9.5)
y <- c(8.6, 7.9, 6.6, 5.6, 4.3, 3.7, 3.2, 2.5, 2.5, 2.2)
mReg(x,y, main="mReg")[,c(2,3,5:6)]
## R2 Formulas a b
## cubic 1.00 y = -0.02*x^3 + 0.42*x^2 - 3.2*x + 12 -0.020000 0.42043
## logarithmic 0.99 y = -7.3*log10(x) + 9.2 -7.302887 9.20336
## power 0.99 y = 11*x^-0.67 10.958503 -0.67490
## square 0.98 y = 0.098*x^2 - 1.8*x + 10 0.098122 -1.75920
## exponential 0.98 y = 9.6*e^(-0.16*x) 9.564193 -0.16080
## reciprocal 0.97 y = 9.7/x + 1.7 9.727717 1.68322
## linear 0.91 y = -0.73*x + 8.4 -0.725433 8.40971
## rational 0.63 y = 1/( -0.73 + 8.4*x ) -0.725433 8.40971
Table with numbers and corresponding color: tableColVal
tableColVal(as.matrix(eurodist)[1:15,1:5], nameswidth=0.25)
Climate diagram: climateGraph
climateGraph(temp=c(-9.3,-8.2,-2.8,6.3,13.4,16.8,18.4,17,11.7,5.6,-1,-5.9),
rain=c(46,46,36,30,31,21,26,57,76,85,59,46))
TOC
Dataframe Operations
# Convert list with vectors of unequal length to one single data.frame: l2df
eglist <- list(BB=c(6,9,2,6), KA=1:8, JE=c(-3,2) )
eglist
## $BB
## [1] 6 9 2 6
##
## $KA
## [1] 1 2 3 4 5 6 7 8
##
## $JE
## [1] -3 2
l2df(eglist) # names are even kept
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## BB 6 9 2 6 NA NA NA NA
## KA 1 2 3 4 5 6 7 8
## JE -3 2 NA NA NA NA NA NA
# add rows to a data.frame: addRows, insertRows
MYDF <- data.frame(A=5:3, B=2:4)
addRows(MYDF, 3)
## A B
## 1 5 2
## 2 4 3
## 3 3 4
## 4 NA NA
## 5 NA NA
## 6 NA NA
insertRows(MYDF, 2, 10:11)
## A B
## 1 5 2
## 2 10 11
## 3 4 3
## 4 3 4
# Order rows in a dataframe: sortDF
sortDF(USArrests[USArrests$Murder>14,], "Assault", decreasing=TRUE)
## Murder Assault UrbanPop Rape
## Florida 15.4 335 80 31.9
## South Carolina 14.4 279 48 22.5
## Mississippi 16.1 259 44 17.1
## Louisiana 15.4 249 66 22.2
## Georgia 17.4 211 60 25.8
# truth table to test logical expressions: TFtest
TFtest(!a & !b, a&b, !(a&b))
## a b -- !a & !b -- a & b -- !(a & b)
## 1 TRUE TRUE FALSE TRUE FALSE
## 2 TRUE FALSE FALSE FALSE TRUE
## 3 TRUE NA FALSE NA NA
## 4 FALSE TRUE FALSE FALSE TRUE
## 5 FALSE FALSE TRUE FALSE TRUE
## 6 FALSE NA NA FALSE TRUE
## 7 NA TRUE FALSE NA NA
## 8 NA FALSE NA FALSE TRUE
## 9 NA NA NA NA NA
# Head and tail at the same time: headtail (exception from lowerCamelCasing)
headtail(iris, n=3, na=FALSE)
## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 148 6.5 3.0 5.2 2.0 virginica
## 149 6.2 3.4 5.4 2.3 virginica
## 150 5.9 3.0 5.1 1.8 virginica
TOC
Graphics
Color palettes: seqPal, divPal, showPal
Plot simulation results as result ranges: quantileBands, ciBand
showPal(cex=0.55)
neff <- t(replicate(n=300, sapply(1:200, function(nn) max(rnorm(nn))) ))
qB <- quantileBands(neff, x=1:200, smooth=7)
Quickly plot distributions by just specifying parameters: normPlot, betaPlot
normPlot(mean=81.7, sd=11.45)
betaPlot(shape1=1.5, shape2=6)
Compare Beta distribution parameter effects: betaPlotComp
betaPlotComp()
Set ylim so that it does not extend below zero: lim0
val <- c(3.2, 1.8, 4.5, 8.2, 0.1, 2.9) # just some numbers
plot(val) # axes are extended by 4\% automatically, if xaxs="r"
plot(val, ylim=lim0(val), las=1) # you don't even have to set yaxs="i" ;-)
Histogram with bars drawn horizontally: horizHist
Histograms for dataset split into categories: groupHist
(Uses panelDim to compute layout of panels passed to par(mfrow))
ExampleData <- rnorm(200,13,5)
hpos <- horizHist(ExampleData, col=4)
abline(h=hpos(11), col=2, lwd=2)
groupHist(chickwts, "weight", "feed", col=2, unit="gr_6")
# drop the horsebean, feed those chicks with sunflower seeds (unless you like small chicken)
A few interactive things (not shown als Graphs)
Zoom into graphics: pointZooom
Horizontal and Vertial line at point clicked on: locLine
Transformation from linear to logarithmic axis: linLogHist, linLogTrans
a <- rnorm(90); b <- rexp(90)
dev.new(record=TRUE) # turn recording on
plot(a,b, las=1)
pointZoom(a,b) # scroll through the plots (Pg Up and Pg Dn) to unzoom again.
locLine()
x <- rlnorm(700, m=3)
dev.new(record=TRUE) # scroll through the plots (Pg Up and Pg Dn)...
linLogHist(x, xlab="ddd", breaks=30, yaxt="n", freq=FALSE)
Moving average with overlapping windows: movAv, movAvLines
Funnel plot for proportional Data: funnelPlot
plot(a, type="l", pch=16, las=1)
lines(movAv(a), col=2, lwd=3)
movAvLines(a, lwd=3, plot=FALSE)
X <- c(2, 224, 54, 505, 1, 5, 236, 92, 3, 0) # successful events
N <- c(2, 400, 100, 1000, 2, 10, 500, 200, 10, 2) # possible succeses
funnelPlot(X,N, letters[1:10])
Get nice values and labels to write at logarithmic axes: logVals, logAxis
Label time axis in date-regular intervals: monthLabs, monthAxis
exdat <- 10^runif(50, -1, 2)
plot(exdat, log="y", yaxt="n")
logAxis(side=2) # invisibly returns values and labels
points(exdat, pch=16)
plot(as.Date("2013-10-25")+sort(sample(0:100, 30)),
cumsum(rnorm(30)), type="o", xaxt="n", ann=F)
dummy <- monthAxis(side=1, n=4) # tries to find suitable labeling intervall
str(dummy)
## Date[1:24], format: "2013-01-01" "2013-02-01" "2013-03-01" "2013-04-01" ...
TOC
Hydrology
Extreme value Statistics (e.g. for flood risk estimation): moved to https://github.com/brry/extremeStat
# superposition of precipitation to simulate Q from P: superPos
N <- c(9,5,2,14,1,3) # [mm/hour]
UH <- c(0.1, 0.4, 0.3, 0.1, 0.1) # [1/h]
superPos(N, UH)
## [1] 0.9 4.1 4.9 4.6 7.7 5.6 3.1 2.4 0.4 0.3
# calculate continuous UH with given n and k: unitHydrograph
plot(0:40, unitHydrograph(n=2, k=3, t=0:40), type="l")
# Nash-Sutcliffe efficiency: nse
QSIM <- lsc(PREC, QOBS, area=10, returnsim=TRUE, plot=FALSE)
## Warning in lsc(PREC, QOBS, area = 10, returnsim = TRUE, plot = FALSE): sum
## of UH is not 1, probably the time should be longer
nse(QOBS, QSIM)
## [1] 0.92468
# Root Mean Squared Error, e.g. to be minimized: rmse
rmse(QOBS, QSIM)
## [1] 0.29084
# R squared (coefficient of determination): rsquare
rsquare(QOBS, QSIM)
## [1] 0.9249
TOC
Spatial
# arrange points randomly with minimal distance to each other: randomPoints
rp <- randomPoints(xmin=5,xmax=15, ymin=20,ymax=30, number=25, mindist=1)
# distance between two points on a plane: distance
A <- c(3, 9,-1) ; B <- c(7, -2, 4)
plot(A,B); points(3,5, col=2, pch=16); segments(3,5, A,B)
distance(A,B, 3,5)
## [1] 2.0000 9.2195 4.1231
# calculate Area of a planar triangle: triangleArea
a <- c(1,5.387965,9); b <- c(1,1,5)
plot(a[c(1:3,1)], b[c(1:3,1)], type="l", asp=1)
abline(v=1:9, h=1:5, col=8,lty=2)
triangleArea(a,b)
## [1] 8.776
Zooming in Shapefiles in my package https://github.com/brry/shapeInteractive
TOC
Miscellaneous
# paste character strings with collapse: pastec
listoferrors <- c("filetype", "header", "nonemptyline")
message("The following entities were corrupted:\n", pastec(listoferrors))
## The following entities were corrupted:
## filetype, header, nonemptyline
# remove leading and trailing white space: removeSpace
s <- c("space at end ", " white at begin", " both ", " special ^ ")
removeSpace(s)
## [1] "space at end" "white at begin" "both" "special ^"
# calculate confidence interval (and other EDA values): ci, cie
ci( c(5:8,3,14) )
## CI.lower CI.upper level
## 1 3.217 11.117 0.95
# sequence given by range or vector of values: seqR
seqR(range=c(12,6), by=-2)
## [1] 12 10 8 6
seqR(rnorm(20), len=7)
## [1] -2.02468 -1.23692 -0.44915 0.33861 1.12637 1.91413 2.70189
# Rescale values to another range: rescale
rescale(10:15, from=200, to=135)
## [1] 200 187 174 161 148 135
# Show memory size of the biggest objects in MB: lsMem
lsMem(n=5)
## neff dat qB hpos ExampleData sum rest:
## 0.480200 0.079744 0.019360 0.002232 0.001640 0.007320
# extract pdf link from google search result url: googleLink2pdf
Link <- paste0("http://www.google.de/url?sa=t&rct=j&q=&esrc=s&source=web&cd=1",
"&cad=rja&sqi=2&ved=0CDIQFjAA&url=http%3A%2F%2Fcran.r-project.org",
"%2Fdoc%2Fmanuals%2FR-intro.pdf&ei=Nyl4UfHeOIXCswa6pIC4CA",
"&usg=AFQjCNGejDwPlor4togQZmQEQv72cK9z8A&bvm=bv.45580626,d.Yms")
googleLink2pdf(Link)
## [1] "http://cran.r-project.org/doc/manuals/R-intro.pdf"
# Create a number of 999 strings with spaces for reading files: na9
na9()[c(1:4,13,30)]
## [1] "-9999" "-999" "-99" "-9.99" " -9.9" " -9,99"
A few things not executed for this document:
# Separate lists with arguments for functions: owa
?owa # the example section has a good - wait for it - example!
# install.package and require in one single function: require2
require2(ada)
# Write a file with a Roxygen-compatible function structure,
# making it easy to add new functions to the package: createFun
createFun(myNewFunction, package="extremeStat", path="S:/Dropbox")
# Open the source code of a function on github: funSource
funSource("smoothLines")
# Install a package from github without dependencies: instGit
instGit("brry/shapeInteractive")
# concatenate textfiles contents unchanged into one file: combineFiles
# see also: compareFiles, dupes
cat("This is Sparta.\nKicking your face.", file="BujakashaBerry1.txt")
cat("Chuck Norris will roundhousekick you.", file="BujakashaBerry2.txt")
combineFiles(inFiles=paste0("BujakashaBerry", 1:2, ".txt"),
outFile="BujakashaBerry3.txt")
readLines("BujakashaBerry3.txt")
unlink(paste0("BujakashaBerry", 1:3, ".txt"))
# wish neRds a happy new year: yearSample
yearSample(2016)
# Have a nerdy
set.seed(12353); sample(0:9,4,T)
# generate name from "random" sample: nameSample
nameSample("berry")
# Kind regards from
set.seed(1248272); paste(sample(letters,5,rep=T),collapse='')
## [1] "berry"
TOC
Explore the other possibilities of the package by reading the function help files.
Any Feedback on this package (or this vignette) is very welcome via github or berry-b@gmx.de!