--- title: "berryFunctions" author: "Berry Boessenkool, " date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true \\ toc_float: true \\ not possible as of march 2016 vignette: > %\VignetteIndexEntry{berryFunctions} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- *The R package `berryFunctions`, available at [github.com/brry](https://github.com/brry/berryFunctions) and [CRAN](https://cran.r-project.org/package=berryFunctions), contains my collection of miscellaneous functions. A lot is related to plotting and hydrology (Vignette [Rmd source](https://raw.githubusercontent.com/brry/berryFunctions/master/vignettes/berryFunctions.Rmd)).* ## Package installation ```{r instcran, eval=FALSE} install.packages("berryFunctions") library(berryFunctions) ``` To get the development version on github, including vignette: ```{r instgit, eval=FALSE} if(!requireNamespace("remotes", quitly=TRUE)) install.packages("remotes") remotes::install_github("brry/berryFunctions", build_opts="--no-manual") ``` ```{r library, echo=FALSE} library(berryFunctions) ``` [TOC](#top) ## 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` ```{r colPoints, fig.show='hold', echo=-c(1:2)} par(mar=c(3.2,3.2,3,0.7), mgp=c(2.1,0.7,0)) set.seed(007) 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(y1=0.8,y2=1, title="Elevation [m]"), add=FALSE) mtext("colPoints, textField", outer=TRUE, adj=0.05, line=0.5, 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` ```{r lsc, fig.show='hold', echo=-1, fig.height=3.5, fig.width=5.5, warning=FALSE} par(mar=c(3.2,3.2,1.5,0.7), mgp=c(2.1,0.7,0)) # 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 ``` 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` ```{r regression, fig.show='hold', echo=-(1:2)} par(mar=c(3.2,3.2,1.5,0.7), mgp=c(2.1,0.7,0)) options(digits=5) 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)] ``` Table with numbers and corresponding color: `tableColVal` ```{r tableColVal, echo=-1, fig.height=3.5, fig.width=5.5} par(mar=c(0,0,1,0)) tableColVal(as.matrix(eurodist)[1:15,1:5], nameswidth=0.25) ``` Climate diagram: `climateGraph` ```{r climgraph, echo=-1, fig.height=3.5, fig.width=5.5} par(mar=c(3.2,3.2,1.5,0.7), mgp=c(2.1,0.7,0)) 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](#top) ## Dataframe Operations ```{r df} # Convert list with vectors of unequal length to one single data.frame: l2df eglist <- list(AB=c(6,9,2,6), CD=1:8, EF=c(-3,2) ) eglist l2df(eglist) # names are even kept # add rows to a data.frame: addRows, insertRows MYDF <- data.frame(A=5:3, B=2:4) addRows(MYDF, 3) insertRows(MYDF, 2, 10:11) # Order rows in a dataframe: sortDF sortDF(USArrests[USArrests$Murder>14,], "Assault", decreasing=TRUE) # truth table to test logical expressions: TFtest TFtest(!a & !b, a&b, !(a&b)) # Head and tail at the same time: headtail (exception from lowerCamelCasing) headtail(iris, n=3, na=FALSE) ``` [TOC](#top) ## Graphics Color palettes: `seqPal`, `divPal`, `showPal` Plot simulation results as result ranges: `quantileBands`, `ciBand` ```{r showPal, fig.show='hold'} showPal(cex=3) 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` ```{r distrplots, fig.show='hold', echo=-1} par(mar=c(3.2,3.2,1.5,0.7), mgp=c(2.1,0.7,0)) normPlot(mean=81.7, sd=11.45) betaPlot(shape1=1.5, shape2=6) ``` Compare Beta distribution parameter effects: `betaPlotComp` ```{r betacomp, echo=-1, fig.height=4.5, fig.width=5.5} par(mar=c(3.2,3.2,1.5,0.7), mgp=c(2.1,0.7,0)) betaPlotComp() ``` Set ylim so that it does not extend below zero: `lim0` ```{r lim0, fig.show='hold', echo=-1} par(mar=c(3.2,3.2,1.5,0.7), mgp=c(2.1,0.7,0)) 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)`) ```{r horizHist, fig.show='hold', echo=-1} par(mar=c(3.2,3.2,1.5,0.7), mgp=c(2.1,0.7,0)) 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` ```{r pointZoom, eval=FALSE} 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` ```{r movAvLines, fig.show='hold', echo=-(1:2), warning=FALSE} par(mar=c(3.2,3.2,1.5,0.7), mgp=c(2.1,0.7,0)) set.seed(42); a <- cumsum(rnorm(100)) plot(a, type="l", pch=16, las=1) lines(movAv(a), col=2, lwd=3) movAvLines(y=a, lwd=3) 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` ```{r axes, fig.show='hold', echo=-(1:2)} par(mar=c(3.2,3.2,1.5,0.7), mgp=c(2.1,0.7,0)) set.seed(42) 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-04-25")+0:500, cumsum(rnorm(501)), type="l", xaxt="n", ann=FALSE) dummy <- monthAxis(side=1) str(dummy) ``` [TOC](#top) ## Hydrology Extreme value Statistics (e.g. for flood risk estimation): moved to https://github.com/brry/extremeStat ```{r hydro, echo=-1} par(mar=c(3.2,3.2,1.5,0.7), mgp=c(2.1,0.7,0)) # 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) # calculate continuous UH with given n and k: unitHydrograph plot(0:40, unitHydrograph(n=2, k=3, t=0:40), type="l") # Nash-Sutcliffe and kling-gupta efficiency: nse + kge QSIM <- lsc(PREC, QOBS, area=10, returnsim=TRUE, plot=FALSE) nse(QOBS, QSIM) kge(QOBS, QSIM) # Root Mean Squared Error, e.g. to be minimized: rmse rmse(QOBS, QSIM) # R squared (coefficient of determination): rsquare rsquare(QOBS, QSIM) ``` [TOC](#top) ## Programming `tmessage`, `twarning`, `tstop`: explicit tracing of messages, warnings and errors: ```{r trace} lower <- function(a, s) {tmessage("some stuff with ", a+10, skip=s); a} upper <- function(b, skip=0) lower(b+5, skip) upper(3) ``` `tryStack`: tracing any message / warning error in other people's code, can also log to a file: ```{r tryStack} lower <- function(a) {message("fake message, a = ", a); a+10} middle <- function(b) {plot(b, main=b) ; warning("fake warning, b = ", b); lower(b) } upper <- function(c) {cat("printing c:", c, "\n") ; middle(c)} tryStack(upper("42") ) ``` [TOC](#top) ## Miscellaneous ```{r misc} # 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) # remove leading and trailing white space: removeSpace s <- c("space at end ", " white at begin", " both ", " special ^ ") removeSpace(s) # sequence given by range or vector of values: seqR seqR(range=c(12,6), by=-2) seqR(rnorm(20), len=7) # Rescale values to another range: rescale rescale(10:15, from=200, to=135) # Show memory size of the biggest objects in MB: lsMem lsMem(n=5) # 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) # Create a number of 999 strings with spaces for reading files: na9 na9()[c(1:4,13,30)] ``` A few things not executed for this document: ```{r misc_non, eval=FALSE} # 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") ``` ```{r misc2} # Kind regards from set.seed(8833277); paste(sample(letters,5,rep=T),collapse='') ``` [TOC](#top) 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 !