* Error when tangling subtree - but works for whole document
@ 2015-09-04 10:05 Rainer M Krug
2015-09-04 10:11 ` SOLVED: " Rainer M Krug
0 siblings, 1 reply; 2+ messages in thread
From: Rainer M Krug @ 2015-09-04 10:05 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 427766 bytes --]
Hi
I get an error #(wrong-type-argument stringp nil)# when I tangle a
subtree, but tangling the whole document works.
,----
| GNU Emacs 24.5.1 (x86_64-apple-darwin14.5.0, Carbon Version 157 AppKit 1348.17) of 2015-08-28 on Rainers-MacBook-Pro.local
| Org-mode version 8.3.1 (release_8.3.1-166-g5bfdfc @ /Users/rainerkrug/.emacs.d/org-mode/lisp/)
`----
The backtrace is below
Let me know if you need any further info
Thanks,
Rainer
--8<---------------cut here---------------start------------->8---
Debugger entered--Lisp error: (wrong-type-argument stringp nil)
expand-file-name(nil)
file-relative-name(nil)
org-babel-spec-to-string((5939 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/data/fileNames.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "CACHE <- file.path( \".\", \"cache\")\nSQLITEDB <- file.path(CACHE, \"energyBalance.sqlite\")" nil))
#[(spec) "\306\211.\307!.\b\310!\211.G\311V\205.\0\n).\b\312!. \313\230\203%.\314\315 !\2027. \316\230\203/.\317\2027. G\311V\2057. \211.\205P.\x0e,\203O. \313\230\203O.\r\320.,Q\202P.\r\211.-\2054.\b\321!\322.-!..\211./\203w.\x0e.\203w.\x0e/\316\230\204w.\323..\324\"\210*\325.-!\203\217.\x0e-\326\327.0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203\247.\317\335\336\217\210\v\203\277.\x0e-.3\235\204\277.\v\337Pc\210.-.3B.3\340.4!\210\341 .5\331\332!.6r.6q\210\342\216\325.-!\203\340.\343.-!\210db\210\344\345\346.48\"A\316\230\204\371.`eU\204\371.\337c\210.5c\210\347\317\211.-#\210.\a\v\203.\x01\f\204.\x01\350.\x0e7T.7.-\fB.8\351.8.0\352\353$\203+.\x0e0\2023.\x0e8.0B\211.0)..\207" [get-spec tangle sheb she-bang tangle-mode base-name #[(name) "\302\b\303 8\"A\207" [name spec assoc 4] 4] :tangle :shebang 0 :tangle-mode "yes" file-name-sans-extension buffer-file-name "no" nil "." :mkdirp file-name-directory make-directory parents file-exists-p mapcar car delete-file generate-new-buffer " *temp*" ((byte-code "\301\b!\203\n.\302\b!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) fboundp (funcall lang-f) ((error)) "\n" org-babel-spec-to-string buffer-string ((byte-code "\301\b!\203\n.\302\b!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) insert-file-contents assoc :padline 4 write-region 493 cl-member :test #[(a b) "\b@ @\232\207" [a b] 2] ext file-name fnd m path-collector temp-buffer ...] 6]((5939 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/data/fileNames.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "CACHE <- file.path( \".\", \"cache\")\nSQLITEDB <- file.path(CACHE, \"energyBalance.sqlite\")" nil))
mapc(#[(spec) "\306\211.\307!.\b\310!\211.G\311V\205.\0\n).\b\312!. \313\230\203%.\314\315 !\2027. \316\230\203/.\317\2027. G\311V\2057. \211.\205P.\x0e,\203O. \313\230\203O.\r\320.,Q\202P.\r\211.-\2054.\b\321!\322.-!..\211./\203w.\x0e.\203w.\x0e/\316\230\204w.\323..\324\"\210*\325.-!\203\217.\x0e-\326\327.0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203\247.\317\335\336\217\210\v\203\277.\x0e-.3\235\204\277.\v\337Pc\210.-.3B.3\340.4!\210\341 .5\331\332!.6r.6q\210\342\216\325.-!\203\340.\343.-!\210db\210\344\345\346.48\"A\316\230\204\371.`eU\204\371.\337c\210.5c\210\347\317\211.-#\210.\a\v\203.\x01\f\204.\x01\350.\x0e7T.7.-\fB.8\351.8.0\352\353$\203+.\x0e0\2023.\x0e8.0B\211.0)..\207" [get-spec tangle sheb she-bang tangle-mode base-name #[(name) "\302\b\303 8\"A\207" [name spec assoc 4] 4] :tangle :shebang 0 :tangle-mode "yes" file-name-sans-extension buffer-file-name "no" nil "." :mkdirp file-name-directory make-directory parents file-exists-p mapcar car delete-file generate-new-buffer " *temp*" ((byte-code "\301\b!\203\n.\302\b!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) fboundp (funcall lang-f) ((error)) "\n" org-babel-spec-to-string buffer-string ((byte-code "\301\b!\203\n.\302\b!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) insert-file-contents assoc :padline 4 write-region 493 cl-member :test #[(a b) "\b@ @\232\207" [a b] 2] ext file-name fnd m path-collector temp-buffer ...] 6] ((5939 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/data/fileNames.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "CACHE <- file.path( \".\", \"cache\")\nSQLITEDB <- file.path(CACHE, \"energyBalance.sqlite\")" nil) (5950 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Package%20Documentation" Package\ Documentation:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/EnergyBalance.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' EnergyBalance: A package for computating wind profiles and\n#' aerodynamic resistances.\n#'\n#' The EnergyBalance package provides functiuons to\n#' fit wind profiles, calculate the aerial resistance and plot the profiles.\n#' \n#' @section EnergyBalance functions:\n#' To Be added ...\n#'\n#' @docType package\n#' @name EnergyBalance\n#' @importFrom parallel detectCores\n#' @importFrom parallel mclapply\n#' @importFrom lhs randomLHS\n#' @importFrom RSQLite SQLite\n#' @import DBI\n#' @import magrittr\nNULL\n#> NULL" nil) (5973 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/CACHE.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' Cache for computations in package\n#'\n#' CACHE to be used for the computations. The cac=he holde =temporary\n#' as well as final results of the computations which are saved\n#' automatically to avoid re-computqtion. \n#' \n#' @format Character vector of length one.\n#' @name CACHE\n#' @docType data\nNULL" nil) (5986 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*SQLITEDB" SQLITEDB:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/SQLITEDB.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' SQLite Database with processed input data\n#'\n#' File name and path to the sqlite database which holds the processed\n#' wind speeds and LAI and the indices to increase access speed.\n#' \n#' @format Character vector of length one.\n#' @name SQLITEDB\n#' @docType data\nNULL" nil) (6000 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*getplotlim" getplotlim:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/getplotlim.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Return the limits of the plot\n##'\n##' Return the limits, as set by \\code{xlim = } and \\code{ylim = }. \n##' @param lim if \\code{xlim} or \\code{ylim} return the xorresponding\n##' limits, if code{xlimylim} retur list with each limit as an\n##' element.\n##' @return either vector with two elements containing the x or y\n##' limits or a list of two elements, xlim and ylim.\n##' @author Rainer M. Krug\n##' @export\ngetplotlim<-function(lim = c(\"xlim\", \"ylim\")) {\n usr <- par('usr')\n xr <- (usr[2] - usr[1]) / 27 # 27 = (100 + 2*4) / 4\n yr <- (usr[4] - usr[3]) / 27\n return(\n switch(\n EXPR = paste(sort(lim), collapse=\"\"),\n xlim = c(usr[1] + xr, usr[2] - xr),\n ylim = c(usr[3] + yr, usr[4] - yr),\n xlimylim = list(\n xlim = c(usr[1] + xr, usr[2] - xr),\n ylim = c(usr[3] + yr, usr[4] - yr)\n ),\n stop(\"Invalid value for lim!\")\n ) \n )\n}" nil) (6032 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Input%20data%20directory%20discovery%20functions" Input\ data\ directory\ discovery\ functions:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/inputDataDir.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Returns input data dir\n##'\n##' Returns input data dir (the directory with the wind and LAI\n##' input files are located in). If the package \\code{EnergyBalancePaper} is\n##' installed, the data included in this package is returned,\n##' otherwist the directory \\code{paste0{getwd(), \"/inputdata\"}} is\n##' returned.\n##' \n##' @title inputDataDir\n##' @return input data directory for win=d and LAI data\n##' @author Rainer M. Krug\n##' @export\ninputDataDir <- function() {\n file.path(\n ifelse(\n \"package:EnergyBalancePaper\" %in% search(),\n system.file(package = \"EnergyBalancePaper\"),\n getwd()\n ),\n \"inputdata\"\n )\n}" nil) (6120 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*importVentToDB" importVentToDB:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/importVentToDB.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Import wind data\n##'\n##' Import data into sqlite db and fit =default= to each wind profile\n##' to obtain the parameters, e.g. ustar for selecting.\n##' @param h canopy height in meter. Needed for estimate of ustar (u*)\n##' @param fn file name of wind date\n##' @return invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\nimportVentToDB <- function(fn, h) {\n wsw <- read.csv(\n file = fn,\n stringsAsFactors = FALSE,\n header = TRUE\n )\n names(wsw) <- c(\n \"date\",\n \"time\",\n \"julien\",\n \"h03\",\n \"h11\",\n \"h17\",\n \"h23\",\n \"h29\",\n \"h37\"\n )\n ## Add columns for wpLELDefault parameter values\n wsw$ua <- NA\n wsw$dep <- NA\n wsw$z0 <- NA\n wsw$na <- NA\n wsw$zjoint <- NA\n wsw$h <- NA\n wsw$za <- NA\n wsw$ustar <- NA\n ## Fit wpLELDefault and save parameter\n\n for (i in 1:nrow(wsw)) {\n if(floor(i/20)*20 == i) { cat(i, \" \") }\n wp <- dfFromLong(wsw[i,])\n if ( !any( is.na( c(wp$z, wp[,3]) ) ) ){\n wpf <- fitOptim.wpLEL.default.single(\n z = wp$z,\n u = wp[,3],\n ## lower = c(dep=0, z0=0.001, na=0.01, zjoint=0),\n initial = c(dep=2, z0=2, na=2, zjoint=3)\n ## upper = c(dep=27, z0=h, na=20, zjoint=h),\n ## method = \"L-BFGS-B\"\n )\n wsw$ua[i] <- wpf$wp[[\"ua\"]]\n wsw$dep[i] <- wpf$fit$par[[\"dep\"]]\n wsw$z0[i] <- wpf$fit$par[[\"z0\"]]\n wsw$na[i] <- wpf$fit$par[[\"na\"]]\n wsw$zjoint[i] <- wpf$fit$par[[\"zjoint\"]]\n wsw$h[i] <- wpf$wp[[\"h\"]]\n wsw$za[i] <- wpf$wp[[\"za\"]]\n wsw$ustar[i] <- wpf$wp[[\"ustar\"]]\n }\n }\n \n wsl <- data.frame(\n date = wsw$date,\n time = wsw$time,\n julien = wsw$julien,\n z = rep(\n c(3,11,17,23,29,37),\n times = rep( nrow(wsw), 6 )\n ),\n ws = c(\n wsw$h03,\n wsw$h11,\n wsw$h17,\n wsw$h23,\n wsw$h29,\n wsw$h37\n ),\n ua = wsw$ua,\n dep = wsw$dep,\n z0 = wsw$z0,\n na = wsw$na,\n zjoint = wsw$zjoint,\n h = wsw$h,\n za = wsw$za,\n ustar = wsw$ustar\n )\n ##\n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try({\n ## WindSpeed_w\n DBI::dbWriteTable(db, \"WindSpeed_w\", wsw, overwrite=TRUE)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsw_dt ON WindSpeed_w (date, time)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsw_jt ON WindSpeed_w (julien, time)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsw_date ON WindSpeed_w (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsw_time ON WindSpeed_w (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsw_julien ON WindSpeed_w (julien)\")\n ## WindSpeed_l\n DBI::dbWriteTable(db, \"WindSpeed_l\", wsl, overwrite=TRUE)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsl_dth ON WindSpeed_l (date, time, z)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsl_jth ON WindSpeed_l (julien, time, z)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_date ON WindSpeed_l (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_time ON WindSpeed_l (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_julien ON WindSpeed_l (julien)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_h ON WindSpeed_l (h )\")\n }\n )\n DBI::dbDisconnect(db)\n invisible()\n}" nil) (6245 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*importLAIToDB" importLAIToDB:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/importLAIToDB.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Import LAI data\n##'\n##' Import LAI data into sqlite db\n##' @param fn file name of LAI data\n##' @return invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\nimportLAIToDB <- function(fn) {\n lai <- read.csv(\n file = fn,\n stringsAsFactors = FALSE,\n header = TRUE\n )\n names(lai) <- c(\n \"doy\",\n \"lai\"\n )\n ##\n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try(\n {\n DBI::dbWriteTable(db, \"LeafAreaIndex\", lai, overwrite=TRUE)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX lai_doy ON LeafAreaIndex (doy)\")\n DBI::dbGetQuery(db, \"CREATE INDEX lai_h ON LeafAreaIndex (lai)\")\n }\n )\n DBI::dbDisconnect(db)\n}" nil) (6353 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*createWsLAI" createWsLAI:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/createWsLAI.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Finalize sqlight databaes of input data\n##'\n##' Create combined wind speed and LAI table and associated indices in sqlite database.\n##' @return invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\ncreateWsLAI <- function(\n ){\n sql_l <- paste(\n \"CREATE TABLE\",\n \" WindSpeedLAI_l\",\n \"AS SELECT\",\n \" WindSpeed_l.*, LeafAreaIndex.lai AS lai\",\n \"FROM\", \n \" WindSpeed_l\",\n \"LEFT OUTER JOIN\",\n \" LeafAreaIndex\",\n \"ON\",\n \" julien=DOY\"\n )\n sql_w <- paste(\n \"CREATE TABLE\",\n \" WindSpeedLAI_w\",\n \"AS SELECT\",\n \" WindSpeed_w.*, LeafAreaIndex.lai AS lai\",\n \"FROM\", \n \" WindSpeed_w\",\n \"LEFT OUTER JOIN\",\n \" LeafAreaIndex\",\n \"ON\",\n \" julien=DOY\"\n )\n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try({\n ##\n DBI::dbGetQuery( conn = db, statement = \"DROP TABLE IF EXISTS WindSpeedLAI_l\")\n DBI::dbGetQuery( conn = db, statement = sql_l)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslail_dth ON WindSpeedLAI_l (date, time, z)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslail_jth ON WindSpeedLAI_l (julien, time, z)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_date ON WindSpeedLAI_l (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_time ON WindSpeedLAI_l (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_julien ON WindSpeedLAI_l (julien)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_h ON WindSpeedLAI_l (z )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_lai ON WindSpeedLAI_l (lai)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_ustar ON WindSpeedLAI_l (ustar)\")\n ##\n DBI::dbGetQuery( conn = db, statement = \"DROP TABLE IF EXISTS WindSpeedLAI_w\")\n DBI::dbGetQuery( conn = db, statement = sql_w)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslaiw_dth ON WindSpeedLAI_w (date, time)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslaiw_jth ON WindSpeedLAI_w (julien, time)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_date ON WindSpeedLAI_w (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_time ON WindSpeedLAI_w (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_julien ON WindSpeedLAI_w (julien)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_lai ON WindSpeedLAI_w (lai)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_ustar ON WindSpeedLAI_w (ustar)\")\n }\n )\n DBI::dbDisconnect(db)\n invisible(NULL)\n}" nil) (6421 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*createCache" createCache:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/createCache.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Re-create \\code{CACHE}\n##'\n##' Deletes all files in the cache (directory \\code{CACHE}) and re-creates them\n##' @title Recreate files in cache\n##' @name createCache\n##' @return invisible NULL\n##' @author Rainer M. Krug\n##' @export\n##' @param fnVent file name of Wind Profile csv file\n##' @param fnLAI file name of LAI csv file\n##' @param h height, needed for wind profile fit to obtain u^*\ncreateCache <- function(fnVent, fnLAI, h) {\n dir.create(CACHE, showWarnings = FALSE)\n unlink(SQLITEDB)\n importVentToDB(fnVent, h)\n importLAIToDB(fnLAI)\n createWsLAI()\n invisible(NULL)\n}" nil) (6446 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*loadWS" loadWS:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/loadWS.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Depending on the values of the arguments, different datasets are\n##' loaded, but all contain wind speed at different heights and lai\n##' data. The sql argument can be used to specify different\n##' conditions for the data returned.\n##'\n##' Loads wind speed data from sql database in cache\n##' @title Load wind speed data\n##' @param wide if TRUE, load wide format, if FALSE long format\n##' @param onlyComplete if \\code{TRUE}, load only datapoints without missing\n##' data in wind \\code{h*} and \\code{LAI}.\n##' @param minSpeedIncreaseWide numeric value or \\code{NULL}. If not \\code{NULL}, the following rules will be\n##' used to filter the wind profiles:\n##' \n##' \\itemize{\n##' \n##' \\item{ differences of wind speeds between each point and the\n##' adjacend lower sampling points has to be larger then the value of\n##' \\code{minSpeedIncreaseWide}}\n##'\n##' }\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @param maxWindSpeedWide numeric value or \\code{null}. If not\n##' \\code{NULL}, wind profiles with wind speeds higher then\n##' \\code{maxWindSpeedWide} will be filtered out.\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @param maxWindSpeedOneWide Logical - if \\code{TRUE} the wind profiles will\n##' be standardised to wind speed at highest sampling point to 1 and\n##' the original wind speed will be stored in a field \\code{ua}\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @param minUstar minimum ustar value to be included in analysis. The default is 0.25. \\bold{REFERENCE NEEDED}\n##' \n##' @param WAI Wood Area Index - default value \\code{0}. numeric value to be added to the field\n##' \\code{lai}. \n##' @param sql sql statement to be used instread of \\code{wide} and\n##' \\code{onlyComplete}. The sql statement is evauated and the result is\n##' returned.\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @return data.frame containing the data. If the \\code{wide==TRUE},\n##' the class is also set to \\code{wsw}, if \\code{wide==FALSE} to\n##' \\code{wsl}\n##' @author Rainer M. Krug\n##' @export\nloadWS <- function(\n wide = TRUE,\n onlyComplete = TRUE,\n minSpeedIncreaseWide = 0,\n maxWindSpeedWide = 10,\n maxWindSpeedOneWide = FALSE,\n minUstar = 0.25,\n WAI = 0,\n sql\n ) {\n if (wide) {\n tbln <- \"WindSpeedLAI_w\"\n } else {\n tbln <- \"WindSpeedLAI_l\"\n }\n try({ \n db <- dbConnect(RSQLite::SQLite(), SQLITEDB)\n if (missing(sql)) {\n if (!onlyComplete) {\n sql <- paste( \"SELECT * FROM\", tbln ) \n } else {\n f <- c( \"LAI\", grep(\"^h.\", dbListFields(db, tbln), value=TRUE))\n f <- paste(f, \"IS NOT NULL\", collapse = \" AND \")\n sql <- paste( \"SELECT * FROM \", tbln, \"WHERE\", f, \"AND ustar >=\", minUstar)\n }\n }\n ws <- DBI::dbGetQuery(db, sql)\n } \n )\n dbDisconnect(db)\n ##\n if (length(grep(\"date|time\", names(ws))) >= 2) {\n ws$date <- as.Date(ws$date, format = \"%d/%m/%y\")\n ws$dateTime <- as.POSIXct(paste(ws$date, ws$time), format=\"%Y-%m-%d %H:%M\")\n ##\n ws <- ws[\n c(\n \"date\",\n \"time\",\n \"dateTime\",\n grep(\"date|time|dateTime\", names(ws), invert=TRUE, value=TRUE)\n )\n ]\n ##\n }\n if (wide) {\n class(ws) <- c(class(ws), \"wsw\")\n h <- rownames(dfFromLong(ws[2,]))\n if (!is.null(minSpeedIncreaseWide)) {\n ws <- ws[\n ws[,h] %>%\n as.matrix %>%\n t %>%\n diff %>%\n data.frame %>%\n sapply(\n X = .,\n FUN = . %>%\n is_less_than(minSpeedIncreaseWide) %>%\n any\n ) %>%\n not,\n ]\n }\n if (!is.null(maxWindSpeedWide)) {\n ws <-\n ws[\n ws[,h] %>%\n apply(\n X = .,\n MARGIN = 1,\n FUN = max\n ) %>%\n is_less_than(maxWindSpeedWide),\n ]\n }\n ua <- dfFromLong(ws[1,]) %>% extract(\"z\") %>% max %>% paste0(\"h\", .)\n ws$ua <- ws[[ua]]\n if (maxWindSpeedOneWide) {\n for (i in h) {\n ws[i] <- ws[i] / ws[ua] \n }\n }\n } else {\n class(ws) <- c(class(ws), \"wsl\")\n }\n if (!is.null(WAI)) {\n ws$lai <- ws$lai + WAI\n }\n return(ws)\n}" nil) (6596 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*dfFromLong" dfFromLong:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/dfFromLong.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Extract the height from the column names in the database, where\n##' the column names of the height have to follow the format\n##' \\code{h[:digit:]}.\n##'\n##' Extract the height\n##' @title Extract height from column names\n##' @param x column names\n##' @return heights as encoded in the column names in the order as given\n##' @author Rainer M. Krug\n##' @export\ndfFromLong <- function(\n x\n ) {\n hCols <- grep(\n pattern = \"^h[[:digit:]]\",\n x = names(x),\n value = FALSE\n )\n h <- gsub(\"h\", \"\", names(x)[hCols])\n h <- as.numeric(h)\n u <- as.matrix(x[hCols])\n if(is.vector(u)) {\n result <- data.frame(\n index = hCols,\n z = h,\n u = u\n )\n } else { # is.matrix(u) == TRUE\n result <- data.frame(\n index = hCols,\n z = h,\n u = t(u)\n )\n }\n rownames(result) <- names(x)[hCols]\n return(result)\n}" nil) (6646 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL%20Generic%20function%20definition" wpLEL\ Generic\ function\ definition:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to create \\code{wpLEL} object.\n##'\n##' The returned object of class \\code{wpLEL} contains the following fields:\n##' \\itemize{\n##' \\item{\\code{parametrization}} {parametrization used to create this object. Possible values are \"default\" and \"Mahat2013\"}\n##' \n##' \\item{\\code{dep}} {some info}\n##' \\item{\\code{z0}} {some info}\n##' \\item{\\code{na}} {some info}\n##' \\item{\\code{zjoint}} {some info}\n##' \\item{\\code{h}} {some info}\n##' \\item{\\code{za}} {some info}\n##' \\item{\\code{z0sol}} {some info}\n##' \n##' \\item{\\code{vk}} {some info}\n##' \\item{\\code{ua}} {some info}\n##' \\item{\\code{ustar}} {some info}\n##' \\item{\\code{z0h}} {some info}\n##' \\item{\\code{uzjoint}} {some info}\n##' \\item{\\code{ustarsol}} {some info}\n##'\n##' \\item{\\code{noU}} {some info}\n##' }\n##' @title wpLEL\n##' @param x object from which to calculat the \\code{wpLEL} object\n##' @param ... optional arguments for the generic functions\n##' @return objerct of class \\code{wpLEL}\n##' @author Rainer M. Krug\n##' @export\nwpLEL <- function(x, ...) UseMethod(\"wpLEL\")" nil) (6681 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*parameterOK" parameterOK:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/parmeterOK.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Check parameter for validity\n##'\n##' Check parameter for validity. If they are valid, the function\n##' returns \\code{TRUE}, if not, it returns the error messages.\n##' @title parameterOK\n##' @param z z\n##' @param ua ua\n##' @param dep dep\n##' @param z0 z0\n##' @param na na\n##' @param zjoint zjoint\n##' @param h h\n##' @param za za\n##' @param z0sol z0sol\n##' @return \\code{TRUE} if parameter are OK, otherwise a named\n##' \\code{character} vector where the names are the parameter which\n##' are not OK and the values the error messages to be used\n##' @author Rainer M. Krug\n##' @export\nparameterOK <- function(\n z,\n ua,\n dep,\n z0,\n na,\n zjoint,\n h,\n za,\n z0sol\n ) {\n result <- NULL\n ## z 0 <= z\n if (any( z < 0 )) {\n result <- c(result, z = \"All z have to be larger or equal than zero!\\n\")\n }\n ## ua 0 <= ua\n if (ua < 0 ) {\n result <- c(result, ua = \"ua has to be larger or equal than zero!\\n\")\n }\n ## dep 0 <= dep < h\n if ((dep < 0) | (dep >= h) ) {\n result <- c(result, dep = \"dep has to be larger or equal than zero and smaller than h!\\n\")\n }\n ## z0 0 < z0 <= h\n if ((z0 <= 0) | (z0 > h)) {\n result <- c(result, z0 = \"z0 has to be larger than zero and smaller or equal than h!\\n\")\n } \n ## na 0 < na\n if (na < 0 ) {\n result <- c(result, na = \"na has to be larger or equal than zero!\\n\")\n } \n ## zjoint\n if ((zjoint < 0) | (zjoint > h)) {\n result <- c(result, zjoint = \"zjoint has to larger or equal than 0 and smaller or equal than h!\\n\")\n }\n ## h h >= 0\n if (h < 0 ) {\n result <- c(result, h = \"h has to be larger or equal than zero!\\n\")\n }\n ## za za > h\n if (za <= h ) {\n result <- c(result, za = \"za has to be larger than h!\\n\")\n }\n ## z0sol 0 < z0sol POSSIBLY < h/10 ???\n if (z0sol <= 0 ) {\n result <- c(result, z0sol = \"z0sol has to be larger than zero!\\n\")\n }\n ## ###\n ## dep, z0, h dep + z0 < h\n if ((dep + z0) > h) {\n result <- c(result, \"(dep + z0) has to be smaller than h!\\n\")\n }\n \n if (is.null(result)) {\n result <- TRUE\n }\n return(result)\n}" nil) (6775 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELDefault" wpLELDefault ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELDefault.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param dep zero-plane displacement height. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{dep}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' dep = function(LAI, ...) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the argument\n##' \\code{parametrization} accordingly (in this example\n##' \"Mahat\") to adjust further analysis accordingly!\n##' @param z0 roughness length at canopy level. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{z0}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' z0 = function(LAI, ...) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the\n##' argument \\code{parametrization} accordingly (in this\n##' example \"Mahat\") to adjust further analysis accordingly!\n##' @param na exponential decay coefficient\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @param ... further argumewnts which will be passed to the user\n##' defined function \\code{dep} and \\code{z0}.\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELDefault <- function(\n z,\n ua,\n dep,\n z0,\n na, # = 7,\n zjoint,\n h, # = 28,\n za, # = 37,\n z0sol,# = 0.001,\n noU = FALSE,\n check = TRUE\n ){ \n vk <- 0.41\n \n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n stop(ok)\n }\n \n ## profil5.m l29 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::29]]\n ## ustar = ua * vk / log( (za - dep) / z0) \n ustar <- ua * vk / log( (za - dep) / z0)\n\n ## profil5.m l30 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::30]]\n ## z0h = z0 * exp( -6.27 * vk * ( ustar^(1/3) ) ); % Calcul de Z0h (Thom)\n z0h <- z0 * exp( -6.27 * vk * ( ustar^(1/3) ) )\n\n ## profil5.m l32 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::32]]\n ## zjoint = z0h + dep;\n ## if (missing(zjoint)) {zjoint <- z0h + dep}\n\n ## profil5.m l33 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::33]]\n ## uzjoint = ustar / vk * log( (hauteur - dep)/z0 ) * exp( - na * (1 - zjoint/hauteur) );\n uzjoint <- (ustar / vk) * log( (h - dep)/z0 ) * exp( - na * (1 - zjoint/h ) )\n\n ## profil5.m l34 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::34]]\n ## ustarsol = uzjoint * vk / log( (zjoint/z0sol))\n ustarsol <- ifelse(\n (zjoint == 0),\n as.numeric(NA),\n uzjoint * vk / log( zjoint / z0sol )\n )\n \n ##\n result <- list(\n z = NA,\n u = NA,\n u.onlyTop = NA\n )\n\n if (!noU) {\n result$z <- as.numeric(z)\n ##\n result$u <- as.numeric(\n sapply(\n z,\n function(z) {\n if (z >= h) {\n ## profil5.m l36 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::37]]\n u <- ( ustar/vk ) * log( (z-dep) / z0 )\n } else if (z >= zjoint) {\n ## profil5.m l40 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::41]]\n uh <- ( ustar/vk ) * log( (h-dep) / z0 )\n u <- uh * exp( -na*(1-(z/h)) )\n } else if (z >= 0) {\n ## profil5.m l42 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::42]]\n u <- ( ustarsol/vk ) * log( (z ) / z0sol )\n } else {\n u <- NA\n }\n return(u)\n }\n )\n )\n names(result$u) <- paste0(\"h\", z)\n ##\n result$u.onlyTop = as.numeric(\n sapply(\n z,\n function(z) {\n zd <- ((z-dep) / z0)\n if (zd < 0){\n u <- NA\n } else {\n u <- ( ustar/vk ) * log( (z-dep) / z0 )\n }\n if (!is.na(u)) {\n if (u < 0) {\n u <- NA\n }\n }\n return(u)\n }\n )\n )\n }\n ##\n result$parametrization <- \"default\"\n result$dep <- as.numeric(dep)\n result$z0 <- as.numeric(z0)\n result$na <- as.numeric(na)\n result$zjoint <- as.numeric(zjoint)\n result$h <- as.numeric(h)\n result$za <- as.numeric(za)\n result$z0sol <- as.numeric(z0sol)\n \n result$vk <- as.numeric(vk)\n result$ua <- as.numeric(ua)\n result$ustar <- as.numeric(ustar)\n result$z0h <- as.numeric(z0h)\n result$uzjoint <- as.numeric(uzjoint)\n result$ustarsol <- as.numeric(ustarsol)\n ##\n result$noU <- noU\n result$check <- check\n ##\n class(result) <- c(\"wpLEL\")\n return(result)\n}" nil) (6981 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELMahat" wpLEL\.mahat ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELMahat.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape using Mahat parametrisation\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile based on Mahat parametrization\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param na exponential decay coefficient\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param LAI Leaf Area Index to be used for the calculation of \\code{dep}\n##' @param y integer indicating three basic forest profiles\n##' \\itemize{\n##' \\item{y = 1} : {young pine}\n##' \\item{y = 2} : {leafed decideous tree}\n##' \\item{y = 3} : {old pine with long stems and clumping at the top}\n##' }\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELMahat <- function(\n z,\n ua,\n na,\n zjoint,\n h,\n za,\n z0sol,\n LAI,\n y,\n noU = FALSE,\n check = TRUE\n){ \n depFUN <- function(LAI, ...) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n dep <- depFUN(LAI, h, y)\n ##\n z0FUN <- function(LAI, ...) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n z0 <- z0FUN(LAI, h, y)\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = FALSE\n )\n ##\n result$z0FUN <- z0FUN\n result$depFUN <- depFUN\n result$LAI <- as.numeric(LAI)\n result$y <- as.numeric(y)\n result$check <- check\n ##\n result$parametrization <- \"mahat\"\n ##\n return(result)\n}" nil) (7084 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELLE" wpLELLE ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELLE.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile using Log-Exp shape\n##'\n##' Creates Log-Exp shaped wind profile oblect \\code{wpLEL} based on\n##' input parameter. Uses \\code{wpLELDefault()} with \\code{zjoint=0}\n##' and \\code{z0sol=NA}.\n##' @title Log-Exp wind profile\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param dep zero-plane displacement height. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{dep}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' dep = function(LAI, ...) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the argument\n##' \\code{parametrization} accordingly (in this example\n##' \"Mahat\") to adjust further analysis accordingly!\n##' @param z0 roughness length at canopy level. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{z0}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' z0 = function(LAI, ...) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the\n##' argument \\code{parametrization} accordingly (in this\n##' example \"Mahat\") to adjust further analysis accordingly!\n##' @param na exponential decay coefficient\n##' @param h canopy height h\n##' @param za ???????\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param ... further argumewnts which will be passed to the user\n##' defined function \\code{dep} and \\code{z0}.\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELLE <- function(\n z,\n ua,\n dep,\n z0,\n na,\n h,\n za,\n noU = FALSE,\n check = TRUE\n ){\n zjoint <- 0\n z0sol <- 0.1\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = TRUE\n )\n ##\n result$check <- check\n result$parametrization <- \"LE\"\n return(result)\n}" nil) (7204 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELMahatLE" wpLELMahatLE ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELMahatLE.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape using Mahat parametrisation\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile based on Mahat parametrization\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param na exponential decay coefficient\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param LAI Leaf Area Index to be used for the calculation of \\code{dep}\n##' @param y integer indicating three basic forest profiles\n##' \\itemize{\n##' \\item{y = 1} : {young pine}\n##' \\item{y = 2} : {leafed decideous tree}\n##' \\item{y = 3} : {old pine with long stems and clumping at the top}\n##' }\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELMahatLE <- function(\n z,\n ua,\n na,\n h,\n za,\n z0sol,\n LAI,\n y,\n noU = FALSE,\n check = TRUE\n){ \n depFUN <- function(LAI, h, y) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n dep <- depFUN(LAI, h, y)\n z0FUN <- function(LAI, h, y) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n z0 <- z0FUN(LAI, h, y)\n zjoint <- 0\n z0sol <- 0.1\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = FALSE\n )\n ##\n result$depFUN <- depFUN\n result$z0FUN <- z0FUN\n result$LAI <- as.numeric(LAI)\n result$y <- as.numeric(y)\n result$check <- check\n result$parametrization <- \"mahatLE\"\n ##\n return(result)\n}" nil) (7307 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELCastanea" wpLELCastanea ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELCastanea.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param LAI Leaf Area Index\n##' @param WAI Wood Area Index, default=1.1\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELCastanea <- function(\n z,\n ua,\n zjoint,\n h,\n za,\n z0sol,\n LAI,\n WAI = 1.1,\n noU = FALSE,\n check = TRUE\n){\n depFUN <- function(h) {(2/3) * h}\n dep <- depFUN(h) # Oke 1972\n ##\n z0FUN <- function(h) {0.1 * h}\n z0 <- z0FUN(h) # Granier\n ##\n naFUN <- function(LAI, WAI) {\n na <- 2.6 * (LAI + WAI)^0.36\n if (na > 4) {\n na <- 4\n }\n return(na)\n }\n na <- naFUN(LAI, WAI)\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua, \n dep = na,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h, \n za = za,\n z0sol = z0sol, \n noU = noU,\n check = FALSE\n )\n result$depFUN <- depFUN\n result$z0FUN <- z0FUN\n result$naFUN <- naFUN\n result$LAI <- as.numeric(LAI)\n result$WAI <- as.numeric(WAI)\n result$check <- check\n result$parametrization <- \"castanea\"\n return(result)\n}" nil) (7415 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELOwnFree" wpLELOwnFree ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELOwnFree.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape using ownFree parametrisation\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' dep, z0, na and zoint are parametrized using:\n##'\n##' x = h * ( x.a + ( LAI ^ x.b ) / x.c )\n##'\n##' where x is dep, z0, na and zjoint respectively.\n##' \n##' @title Log-Exp-Log wind profile based on Mahat parametrization\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param h canopy height h\n##' @param za za\n##' @param z0sol roughness length at soil level\n##' @param dep.a see Details\n##' @param dep.b see Details\n##' @param dep.c see Details\n##' @param z0.a see Details\n##' @param z0.b see Details\n##' @param z0.c see Details\n##' @param na.a see Details\n##' @param na.b see Details\n##' @param na.c see Details\n##' @param zjoint.a see Details\n##' @param zjoint.b see Details\n##' @param zjoint.c see Details\n##' @param LAI Leaf Area Index to be used for the calculation of \\code{dep}\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @param na exponential decay coefficient\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELOwnFree <- function(\n z,\n ua,\n\n h,\n za,\n z0sol,\n\n dep.a, dep.b, dep.c,\n z0.a, z0.b, z0.c,\n na.a, na.b, na.c,\n zjoint.a, zjoint.b, zjoint.c,\n\n LAI,\n noU = FALSE,\n check = TRUE\n ){ \n depFUN <- function(LAI, h, dep.a, dep.b, dep.c) { h * ( dep.a + ( LAI ^ dep.b ) / dep.c ) }\n z0FUN <- function(LAI, h, z0.a, z0.b, z0.c) { h * ( z0.a + ( LAI ^ z0.b ) / z0.c ) }\n naFUN <- function(LAI, h, na.a, na.b, na.c) { h * ( na.a + ( LAI ^ na.b ) / na.c ) }\n zjointFUN <- function(LAI, h, zjoint.a, zjoint.b, zjoint.c) { h * (zjoint.a + ( LAI ^ zjoint.b ) / zjoint.c ) }\n ##\n dep <- depFUN(LAI, h, dep.a, dep.b, dep.c)\n z0 <- depFUN(LAI, h, z0.a, z0.b, z0.c)\n na <- depFUN(LAI, h, na.a, na.b, na.c)\n zjoint <- zjointFUN(LAI, h, zjoint.a, zjoint.b, zjoint.c)\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = FALSE\n )\n ##\n result$depFUN <- depFUN\n result$dep.a <- dep.a\n result$dep.b <- dep.b\n result$dep.c <- dep.c\n ##\n result$naFUN <- naFUN\n result$na.a <- na.a\n result$na.b <- na.b\n result$na.c <- na.c\n ##\n result$z0FUN <- z0FUN\n result$z0.a <- z0.a\n result$z0.b <- z0.b\n result$z0.c <- z0.c\n ##\n result$zjointFUN <- zjointFUN\n result$zjoint.a <- zjoint.a\n result$zjoint.b <- zjoint.b\n result$zjoint.c <- zjoint.c\n ##\n result$LAI <- as.numeric(LAI)\n result$check <- check\n result$parametrization <- \"ownFree\"\n ##\n return(result)\n}" nil) (7547 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL.wpLEL" wpLEL\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLEL.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Creates a new \\code{wpLEL} object from a \\code{wpLEL} object\n##'\n##' \n##' Creates an \\code{wpLEL} object from a \\code{wpLEL} object by\n##' calling \\code{wpLELDefault()} with the arguments in \\code{...} given\n##' arguments and the from \\code{x} extracted arguments.\n##' @title Log-Exp-Log wind profile\n##' @param x object of class \\code{wpLEL} to be used as source\n##' for the parameter to create the \\code{wpLEL} object\n##' @param ... \\bold{named} arguments which will be used to create the\n##' new \\code{wpLEL} object using the \\code{wpLELDefault} function.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\nwpLEL.wpLEL <- function(\n x,\n ...\n){\n iff <- function(test, yes, no) {\n if (test) {\n yes\n } else {\n no\n }\n }\n dot <- list(...)\n u <- switch(\n x$parametrization,\n \"default\" = wpLELDefault( \n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n dep = iff(exists(\"dep\", dot), dot[[\"dep\"]], x[[\"depOrg\"]]),\n z0 = iff(exists(\"z0\", dot), dot[[\"z0\"]], x[[\"z0Org\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n zjoint = iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]])\n ),\n \"mahat\" = wpLELMahat(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n zjoint = iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n y = iff(exists(\"y\", dot), dot[[\"y\"]], x[[\"y\"]])\n ),\n \"LE\" = wpLELLE(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n dep = iff(exists(\"dep\", dot), dot[[\"dep\"]], x[[\"depOrg\"]]),\n z0 = iff(exists(\"z0\", dot), dot[[\"z0\"]], x[[\"z0Org\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]])\n ),\n \"mahatLE\" = wpLELMahatLE(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n y = iff(exists(\"y\", dot), dot[[\"y\"]], x[[\"y\"]])\n ),\n \"castanea\" = wpLELCastanea(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n zjoint = iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n WAI = iff(exists(\"WAI\", dot), dot[[\"WAI\"]], x[[\"WAI\"]])\n ),\n \"ownFree\" = wpLELOwnFree(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n \n dep.a = iff(exists(\"dep.a\", dot), dot[[\"dep.a\"]], x[[\"dep.a\"]]),\n dep.b = iff(exists(\"dep.b\", dot), dot[[\"dep.b\"]], x[[\"dep.b\"]]),\n dep.c = iff(exists(\"dep.c\", dot), dot[[\"dep.c\"]], x[[\"dep.c\"]]),\n\n z0.a = iff(exists(\"z0.a\", dot), dot[[\"z0.a\"]], x[[\"z0.a\"]]),\n z0.b = iff(exists(\"z0.b\", dot), dot[[\"z0.b\"]], x[[\"z0.b\"]]),\n z0.c = iff(exists(\"z0.c\", dot), dot[[\"z0.c\"]], x[[\"z0.c\"]]),\n\n na.a = iff(exists(\"na.a\", dot), dot[[\"na.a\"]], x[[\"na.a\"]]),\n na.b = iff(exists(\"na.b\", dot), dot[[\"na.b\"]], x[[\"na.b\"]]),\n na.c = iff(exists(\"na.c\", dot), dot[[\"na.c\"]], x[[\"na.c\"]]),\n\n zjoint.a = iff(exists(\"zjoint.a\", dot), dot[[\"zjoint.a\"]], x[[\"zjoint.a\"]]),\n zjoint.b = iff(exists(\"zjoint.b\", dot), dot[[\"zjoint.b\"]], x[[\"zjoint.b\"]]),\n zjoint.c = iff(exists(\"zjoint.c\", dot), dot[[\"zjoint.c\"]], x[[\"zjoint.c\"]]),\n\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]])\n ),\n stop(\"No valid parametrization\")\n )\n return(u)\n}" nil) (7668 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL.wpLELFit" wpLEL\.wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLEL.wpLELFit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Creates an \\code{wpLEL} object from a \\code{wpLELFit} object\n##'\n##' \n##' Creates an \\code{wpLEL} object from a \\code{wpLELFit} object by\n##' calling \\code{wpLELDefault()} with the extracted\n##' parameter.\n##' @title Log-Exp-Log wind profile\n##' @param x object of class \\code{wpLELFit} to be used as source\n##' for the parameter to ctreate the \\code{wpLEL} object\n##' @param ... additional arguments which are discarded\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\nwpLEL.wpLELFit <- function(\n x,\n ...\n){ \n return(x$wp)\n}" nil) (7695 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.wpLEL" plot\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Plot \\code{wpLEL} object\n##'\n##' Generic function to plot \\code{wpLEL} object\n##' @param x object of class \\code{wpLEL} to be plotted\n##' @param z numeric vector at which the line should be calculated. If\n##' missing, \\code{x$z} will be used. the more points, the smoother\n##' the line.\n##' @param xlab x label\n##' @param ylab y label\n##' @param plotWPValues if \\code{TRUE}, the values and value lines are\n##' plotted\n##' @param plotWPPoints if \\code{TRUE}, the points in \\code{x$u; x$z}\n##' are plotted\n##' @param plotWPLines if \\code{TRUE}, the wind profile line is plotted\n##' @param add if \\code{TRUE}, the plot wil be added to an existing plot\n##' @param ... optional arguments for \\code{plot} method\n##' @return incisible NULL\n##' @author Rainer M. Krug\n##' @export\nplot.wpLEL <- function(\n x,\n z,\n xlab = \"Wind Speed (m/s)\",\n ylab = \"Height above ground (m)\",\n plotWPValues = TRUE,\n plotWPPoints = TRUE,\n plotWPLines = TRUE,\n add = FALSE,\n ...\n) {\n if (missing(z)) {z <- x$z}\n u <- wpLEL(x, z=z)\n ## setup plot if !add\n if (!add) {\n plot(\n x = c(0, max(x$u, u$u)),\n y = c(0, max(x$z, u$z)),\n type= \"n\",\n xlab = xlab,\n ylab = ylab\n )\n }\n ## plot points\n points(\n x = x$u,\n y = x$z,\n type= ifelse(plotWPPoints, \"p\", \"n\"),\n ...\n )\n lines(\n x = u$u.onlyTop,\n y = u$z,\n type = ifelse(plotWPLines, \"l\", \"n\"),\n lty = \"dotted\",\n col = \"blue\"\n )\n lines(\n x = u$u,\n y = u$z,\n type = ifelse(plotWPLines, \"l\", \"n\"),\n lty = \"solid\",\n col = \"black\"\n )\n if (plotWPValues) {\n mx <- par(\"usr\")[2]\n with(\n x,\n {\n arrows(\n x0 = c(0, 0, 0 ,0 ,0),\n y0 = c(z0+dep, za, h, dep, zjoint),\n x1 = c(4, 4, 4 ,4 ,4 ,4),\n y1 = c(z0+dep, za, h, dep, zjoint),\n length = 0,\n col = \"grey\",\n lty = \"dotted\"\n )\n text(mx, z0, paste('z0', round(z0, 2), sep=\" = \" ), pos = 2)\n text(mx, za, paste('za', round(za, 2), sep=\" = \" ), pos = 2)\n text(mx, h, paste('hauteur', round(h, 2), sep=\" = \" ), pos = 2)\n text(mx, dep, paste('dep', round(dep, 2), sep=\" = \" ), pos = 2)\n text(mx, zjoint, paste('zjoint', round(zjoint, 2), sep=\" = \" ), pos = 2)\n }\n )\n }\n invisible(NULL)\n}" nil) (7786 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*print.wpLEL" print\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to print \\code{wpLEL}\n##'\n##' This function prints a \\code{wpLEL} object\n##' @param x object of class \\code{wpLEL} to be printed\n##' @param ... optional arguments for \\code{print} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nprint.wpLEL <- function(\n x,\n ...\n ) {\n print.default(x)\n invisible(x)\n}" nil) (7814 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.default.single" fitOptim\.wpLEL\.default\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.default.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL}} wind profile.\n##' @title fitOptim.wpLEL.default.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.default.single <- function(\n z,\n u,\n LAI,\n initial = c(dep=25, z0=0.8*28, na=9, zjoint=0.2*2),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n ) {\n ## Function to be minimised\n wpLELMin <- function(par, z, u, ua, h, za, z0sol) {\n if (\n isTRUE(\n parameterOK(\n z = z,\n ua = ua,\n dep = par[1], # par$dep,\n z0 = par[2], # par$z0,\n na = par[3], # par$na,\n zjoint = par[4], # par$zjoint\n h = h,\n za = za,\n z0sol = z0sol\n )\n )\n ) {\n p <- wpLELDefault(\n z = z,\n ua = ua,\n dep = par[1], # par$dep,\n z0 = par[2], # par$z0,\n na = par[3], # par$na,\n zjoint = par[4], # par$zjoint\n h = h,\n za = za,\n z0sol = z0sol,\n check = FALSE\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n } else {\n result <- NA\n }\n return( result )\n } \n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.default.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"dep\"],\n initial[\"z0\"],\n initial[\"na\"],\n initial[\"zjoint\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n ...\n )\n result$wp <- wpLELDefault(\n z = z,\n ua = ua,\n dep = result$fit$par[\"dep\"],\n z0 = result$fit$par[\"z0\"],\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (7942 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahat.single" fitOptim\.wpLEL\.mahat\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.mahat.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL.mahat} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL.mahat}} wind profile.\n##' @title fitOptim.wpLEL.mahat.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf area index\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahat.single <- function(\n z,\n u,\n LAI,\n initial = c(na=9, zjoint=0.2*2, y=3),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za, z0sol, LAI) {\n result <- NA\n try({\n p <- wpLELMahat(\n z = z,\n ua = ua,\n na = par[1], # na\n zjoint = par[2], # zjoint\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n y = par[3] # y\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.mahat.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"na\"],\n initial[\"zjoint\"],\n initial[\"y\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n ...\n )\n result$wp <- wpLELMahat(\n z = z,\n ua = ua,\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n y = result$fit$par[\"y\"]\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8053 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.LE.single" fitOptim\.wpLEL\.LE\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.LE.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values (\\code{u} and \\code{z}) to a \\code{link{wpLEL}} wind profile.\n##' @title fitOptim.wpLEL.LE.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.LE.single <- function(\n z,\n u,\n LAI,\n initial = c(dep=25, z0=0.8*28, na=9),\n h = 28,\n za = 37,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za) {\n result <- NA\n try({\n p <- wpLELLE(\n z = z,\n ua = ua,\n dep = par[1], # par$dep,\n z0 = par[2], # par$z0,\n na = par[3], # par$na,\n h = h,\n za = za\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.LE.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"dep\"],\n initial[\"z0\"],\n initial[\"na\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n## z0sol = z0sol,\n ...\n )\n result$wp <- wpLELLE(\n z = z,\n ua = ua,\n dep = result$fit$par[\"dep\"],\n z0 = result$fit$par[\"z0\"],\n na = result$fit$par[\"na\"],\n h = h,\n za = za\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8157 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahatLE.single" fitOptim\.wpLEL\.mahatLE\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.mahatLE.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL.mahatLE} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL.mahatLE}} wind profile.\n##' @title fitOptim.wpLEL.mahatLE.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahatLE.single <- function(\n z,\n u,\n LAI,\n initial = c(na=9, y=3),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za, z0sol, LAI) {\n result <- NA\n try({\n p <- wpLELMahatLE(\n z = z,\n ua = ua,\n na = par[1], # na\n h = h,\n za = za,\n LAI = LAI,\n y = par[2] # y\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.mahatLE.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"na\"],\n initial[\"y\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n ...\n )\n result$wp <- wpLELMahatLE(\n z = z,\n ua = ua,\n na = result$fit$par[\"na\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n y = result$fit$par[\"y\"]\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8264 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.castanea.single" fitOptim\.wpLEL\.castanea\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.castanea.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL}} wind profile.\n##' @title fitOptim.wpLEL.castanea.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.castanea.single <- function(\n z,\n u,\n LAI,\n initial = c(zjoint=0.2*2),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za, z0sol, LAI) {\n result <- NA\n try({\n p <- wpLELCastanea(\n z = z,\n ua = ua,\n zjoint = par[1], # par$zjoint\n h = h,\n za = za,\n z0sol = z0sol,\n LAI=LAI\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.castanea.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"zjoint\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n ...\n )\n result$wp <- wpLELCastanea(\n z = z,\n ua = ua,\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8370 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.default.multiple" fitOptim\.wpLEL\.default\.multiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.default.multiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param wso Wind speed profiles in the format as read from \\code{loadWS(wide=TRUE, ...)}\n##' @param initial initial\n##' @param h h\n##' @param za za\n##' @param z0sol z0sol \n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' @param ... additional arguments to be passed on to \\code{optim()}\n##' @return an oject of class \\code{wpFit} containing the result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.default.multiple <- function(\n wso,\n initial = c(dep=25, z0=0.8*28, na=9, zjoint=0.2*2),\n h = 28,\n za = 37,\n z0sol = 0.001,\n silentError = TRUE,\n ...\n ) {\n\n ## Function to be minimised\n minFUN <- function(\n par,\n ## ## passed in par:\n ## dep\n ## z0\n ## na\n ## zjoint\n ## ## passed in the other arguments:\n z,\n h, za, z0sol,\n ## the data to be fitted to\n wsFit\n ) {\n mse <- sapply(\n wsFit,\n function(u) {\n p <- NULL\n try( {\n p <- wpLELDefault(\n z = z,\n ua = u[length(u)],\n ##\n h = h,\n za = za,\n z0sol = z0sol,\n ## \n dep = par[1],\n z0 = par[2],\n na = par[3],\n zjoint = par[4]\n )\n },\n silent = silentError\n )\n if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)])^2 ) / length(p$u) ) \n } else {\n result <- NA\n }\n return( result )\n }\n )\n mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n mse <- sum( ( mse^2 ) / length(mse), na.rm=TRUE )\n } else {\n mse <- NA\n }\n return(mse)\n }\n \n ## construct result list\n result <- list()\n result$method <- \"fitOptim.wpLEL.default.multiple\"\n result$initial <- initial\n result$dot <- list(...)\n ## result$z <- z\n ## result$u <- u\n ## Do the optimisation\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n result$fit <- optim(\n par = initial,\n fn = minFUN,\n ##\n z = z,\n h = h,\n za = za,\n z0sol = z0sol,\n ##\n wsFit = wso,\n ...\n )\n ## calculate sample wind profile\n if ( (length(z) > 0) & (is.numeric(z)) ) {\n z <- seq(0.1, max(z), 0.1)\n } else {\n z <- seq(0.1, 37, 0.1)\n }\n result$wp <- wpLELDefault(\n z = z,\n ua = mean(wso[2,][[1]]),\n dep = result$fit$par[\"dep\"],\n z0 = result$fit$par[\"z0\"],\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol\n )\n ##\n \n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8502 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahat.multiple" fitOptim\.wpLEL\.mahat\.multiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.mahat.multiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param wso Wind speed profiles in the format as read from \\code{loadWS(wide=TRUE, ...)}\n##' @param initial initial parameter values for fit \n##' @param h height\n##' @param za za\n##' @param z0sol z0sol\n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' @param ... additional values to be passed on to \\code{optim}\n##' @return an object of class \\code{wpFit} containing the result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahat.multiple <- function(\n wso,\n initial = c(na=9, zjoint=0.2*2, y=3),\n h = 28,\n za = 37,\n z0sol = 0.001,\n silentError = TRUE,\n ...\n ) {\n \n ## Function to be minimised\n minFUN <- function(\n par,\n ## ## passed in par:\n ## na\n ## zjoint\n ## y\n ## ## passed in the other arguments:\n z,\n h, za, z0sol,\n ## the data to be fitted to\n wsFit\n ) {\n mse <- sapply(\n wsFit,\n function(u) {\n p <- NULL\n try( {\n p <- wpLELMahat(\n z = z,\n ua = u[length(u)],\n na = par[1],\n zjoint = par[2],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = u[[1]],\n y = par[3]\n )\n },\n silent = silentError\n )\n if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)])^2 ) / length(p$u) ) \n } else {\n result <- NA\n }\n return( result )\n }\n )\n mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n mse <- sum( ( mse^2 ) / length(mse), na.rm=TRUE )\n } else {\n mse <- NA\n }\n return(mse)\n }\n \n ## construct result list\n result <- list()\n result$method <- \"fitOptim.wpLEL.mahat.multiple\"\n result$initial <- initial\n result$dot <- list(...)\n ## result$z <- z\n ## result$u <- u\n ## Do the optimisation\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n result$fit <- optim(\n par = initial,\n fn = minFUN,\n ##\n z = z,\n h = h,\n za = za,\n z0sol = z0sol,\n ##\n wsFit = wso,\n ...\n )\n ## calculate sample wind profile\n if ( (length(z) > 0) & (is.numeric(z)) ) {\n z <- seq(0.1, max(z), 0.1)\n } else {\n z <- seq(0.1, 37, 0.1)\n }\n result$wp <- wpLELMahat(\n z = z,\n ua = mean(as.numeric(wso[2,])),\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = mean(as.numeric(wso[1,])),\n y = result$fit$par[\"y\"]\n )\n ##\n \n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8634 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.ownFree.multiple" fitOptim\.wpLEL\.ownFree\.multiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.ownFree.multiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param wso Wind speed profiles in the format as read from \\code{loadWS(wide=TRUE, ...)}\n##' @param initial initial parameter values for \\code{optim()}\n##' @param z0 z0\n##' @param na na\n##' @param zjoint zjoint \n##' @param h h\n##' @param za za\n##' @param z0sol z0sol\n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' @param ... additional argumaents to be passed to \\code{optim}\n##' @return an oject of class \\code{wpFit} containing the result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.ownFree.multiple <- function(\n wso,\n initial = unlist(\n list(\n dep = c(a=0.5, b=0.02, c=-2),\n z0 = c(a=0.23, b=0.25, c=10),\n na = c(a=0.23, b=0.25, c=10),\n zjoint = c(a=0.23, b=0.25, c=10)\n )\n ),\n h = 28,\n za = 37,\n z0sol = 0.001,\n silentError = TRUE,\n ...\n ) {\n\n ## Function to be minimised\n minFUN <- function(\n par,\n ## ## passed in par:\n ## dep.a, dep.b, dep.c,\n ## z0.a, z0.b, z0.c,\n ## na.a, na.b, na.c,\n ## zjoint.a, zjoint.b, zjoint.c,\n ## ## passed in the other arguments:\n z,\n h, za, z0sol,\n ## the data to be fitted to\n wsFit\n ) {\n mse <- sapply(\n wsFit,\n function(u) {\n p <- NULL\n try( {\n p <- wpLELOwnFree(\n z = z,\n ua = u[length(u)],\n ##\n h = h,\n za = za,\n z0sol = z0sol,\n ## .a .b .c\n dep.a = par[ 1], dep.b = par[ 2], dep.c = par[ 3],\n z0.a = par[ 4], z0.b = par[ 5], z0.c = par[ 6],\n na.a = par[ 7], na.b = par[ 8], na.c = par[ 9],\n zjoint.a = par[10], zjoint.b = par[11], zjoint.c = par[12],\n LAI = u[[1]]\n )\n },\n silent = silentError\n )\n if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)])^2 ) / length(p$u) ) \n } else {\n result <- NA\n }\n return( result )\n }\n )\n ## maxMse <- quantile(mse, probs=c(0, (1 - exclHighMseProp), 0.5, 1))\n ## mse <- mse[mse <= maxMse[2]]\n mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n mse <- sum( ( mse^2 ) / length(mse), na.rm=TRUE )\n } else {\n mse <- NA\n }\n ## print(mse)\n return(mse)\n }\n \n ## construct result list\n result <- list()\n result$method <- \"fitOptim.wpLEL.ownFree.multiple\"\n result$initial <- initial\n result$dot <- list(...)\n result$wpLELParameter <- list(\n h = h,\n za = za,\n z0sol = z0sol\n )\n ## result$z <- z\n ## result$u <- u\n ## Do the optimisation\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n result$fit <- optim(\n par = initial,\n fn = minFUN,\n ##\n z = z,\n h = h,\n za = za,\n z0sol = z0sol,\n ##\n wsFit = wso,\n ...\n )\n ## calculate sample wind profile\n if ( (length(z) > 0) & (is.numeric(z)) ) {\n z <- seq(0.1, max(z), 0.1)\n } else {\n z <- seq(0.1, 37, 0.1)\n }\n \n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8772 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Goodness%20of%20fit%20for%20wpLELFit" Goodness\ of\ fit\ for\ wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/gof.wpLELfit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Calculate goodnes of fit of fit compared to object of class \\code{wpLELFit}\n##'\n##' Uses gofFun to calculate the goodnes of fit between \\code{fit} and\n##' the observed wind profile \\code{wp}\n##' \n##' @title gof.wpLELfit\n##' @param fit fit of the wind profile of the type \\code{wpLELFit}\n##' @param wp wind profile as returned in the wide format of \\code{loadWS}\n##' @param gofFun function returning the goodnes of fit.\n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' This function accepts the two argumentsa \\code{obs, exp}.\n##' These can be assumed of being of the same length. An example is the =default function:\n##' \n##' \\code{ function(obs, exp){ sum( ( (exp - obs)^2 ) / length(obs) ) } }\n##' \n##' @return vector of the goodnes of fit values, one per row in \\code{wp}\n##' @author Rainer M. Krug\n##' @export\ngof.wpLELFit <- function(\n fit,\n wp,\n gofFun = function(obs, exp){ sum( ( (exp - obs)^2 ) / length(obs), na.rm=TRUE ) },\n silentError = TRUE\n ) {\n gofs <- sapply(\n 1:nrow(wp),\n function(i) {\n o <- dfFromLong(wp[i,])\n names(o)[ncol(o)] <- \"ws\"\n gof <- NA\n try( {\n e <- wpLEL(\n fit$wp,\n z = o$z,\n ua = wp[i, \"ua\"],\n LAI = wp[i,\"lai\"]\n )\n gof <- gofFun(\n obs = o$ws,\n exp = e$u\n )\n gof\n },\n silent = silentError\n )\n return(gof)\n\n }\n )\n}" nil) (8832 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.wpLELFit" plot\.wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to plot \\code{wpLELFit}\n##'\n##' This function a \\code{wpLELFit} object by plotting the fitted line\n##' smoothly and adding the original points to the graph.\n##' @param x object of class \\code{wpLELFit} to be plotted \n##' @param z numeric vector at which the line should be calculated. If\n##' missing, \\code{x$z} will be used. the more points, the smoother\n##' the line.\n##' @param plotWPValues if \\code{TRUE}, the values and value lines are\n##' drawn\n##' @param plotWPLines if \\code{TRUE}, the lines of the profile are drawn\n##' @param plotOrgPoints if \\code{TRUE}, the original points are drawn\n##' @param add if \\code{TRUE}, the plot wil be added to an existing plot\n##' @param ... additional arguments for plotting the \\bold{original} points of the fit using the \\code{poiunts} function\n##' are plotted\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nplot.wpLELFit <- function(\n x,\n z,\n plotWPValues = TRUE,\n plotWPLines = TRUE,\n plotOrgPoints = TRUE,\n add = FALSE,\n ...\n ) {\n xu <- x$wp\n ## plot values (dep, ...)\n plot.wpLEL(\n xu,\n z,\n plotWPValues = plotWPValues,\n plotWPPoints = FALSE,\n plotWPLines = FALSE,\n add = add\n )\n ## plot fitted lines \n plot.wpLEL(\n xu,\n z,\n plotWPValues = FALSE,\n plotWPPoints = FALSE,\n plotWPLines = plotWPLines,\n add = TRUE\n )\n ## plot original points \n points(\n x$u,\n x$z,\n type = ifelse(plotOrgPoints, \"p\", \"n\"),\n ...\n )\n}" nil) (8890 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*print.wpLELFit" print\.wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLELFit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to print \\code{wpLELFit}\n##'\n##' This function prints a \\code{wpLELFit} object\n##' @param x object of class \\code{wpLELFit} to be printed\n##' @param ... optional arguments for \\code{print} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nprint.wpLELFit <- function(\n x,\n ...\n ) {\n print.default(x)\n invisible(x)\n}" nil) (8920 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpFitEach" wpFitEach ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpFitEach.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title wpLELFitEach\n##' @param new if \\code{TRUE} the cache is re-created - if\n##' \\code{FALSE} the results are read from the cache.\n##' @param suffix suffix for cache\n##' @param FUN name of the function to be used for fitting. It has to\n##' take the arguments \\code{z} and \\code{u}, but can also take\n##' additional arguments.\n##' @param cores number of cores to be used for analysis - defaults to the number of cores mius one, but is at least 1.\n##' @param minSpeedIncreaseWide minimum wind speed difference - see \\link{loadWS} for details\n##' @param maxWindSpeedWide maximum wind speed - see \\link{loadWS} for details\n##' @param maxWindSpeedOneWide standardise highest sampled wind speed to one - see \\link{loadWS} for details\n##' @param WAI Wood Area Index, argument \\code{WAI} of function\n##' \\code{loadWS()}. Will be added to lai from raw data.\n##' @param selectWPFit a function returning \\bold{a vector} where each\n##' element represents the indices of loaded wind profiles which will\n##' be used for fitting the parameter. The function takes one value,\n##' i.e. \\code{wso} which is the \\code{data.frame} of the loaded wind\n##' profiles, as returned by the function\n##'\n##' code{\n##' wso <- loadWS(\n##' wide = TRUE,\n##' onlyComplete = TRUE,\n##' minSpeedIncreaseWide,\n##' maxWindSpeedWide,\n##' maxWindSpeedOneWide,\n##' WAI = WAI\n##' )\n##' }\n##'\n##' Examples are:\n##'\n##' \\code{selectWPFit = function(wso){TRUE}}\n##'\n##' which would select all elements in \\code{wso}.This is the default.\n##' \n##' \\code{selectWPFit = function(wso){sample(1:nrow(wso), 100)}}\n##' \n##' which would create vector of 100 randomly selected wind profiles\n##' \\bold{selected} for fitting or\n##'\n##' \\code{selectWPFit = function(wso){-sample(1:nrow(wso), 500)}}\n##'\n##' which would create vector of 500 randomly selected wind profiles\n##' \\bold{excluded} from fitting\n##'\n##' @param ... additional arguments passed to FUN\n##' @return an oject of class \\code{wpLELFitList} (i.e. \\code{list}) of\n##' the length of the number wind profiles to fit. Each element\n##' contains the result of an individual fit.\n##' @author Rainer M. Krug\n##' @export\nwpFitEach <- function(\n new = FALSE,\n suffix = \"\",\n FUN = \"wpLEFitSingle\",\n cores = detectCores() - 1,\n minSpeedIncreaseWide = 0,\n maxWindSpeedWide = 10,\n maxWindSpeedOneWide = FALSE,\n WAI = 0,\n selectWPFit = function(wso) { TRUE },\n ...\n ) {\n if (cores==0) {\n cores <- 1\n }\n fn <- paste0(CACHE, \"/wpFitEach.\", FUN, suffix, \".rds\")\n FUN <- get(FUN)\n if (new) {\n unlink(fn)\n }\n if (file.exists(fn)) {\n dat <- readRDS(fn)\n } else {\n ## Load wind priofile data\n wso <- loadWS(\n wide = TRUE,\n onlyComplete = TRUE,\n minSpeedIncreaseWide,\n maxWindSpeedWide,\n maxWindSpeedOneWide,\n WAI = WAI\n )\n \n ## #################################\n ## From now on, LAI (later u[[1]]) is LAI = LAI + WAI)\n ## #################################\n\n ## Get indices for fitting. Must only be done once as the\n ## functions might contain random number generation!\n indFit <- selectWPFit(wso)\n\n ## Save \"metadata\"\n ## construct result list\n md <- list()\n md$method <- \"wpFitEach\"\n md$FUN <- FUN\n md$loadWSParm <- list(\n minSpeedIncreaseWide = minSpeedIncreaseWide,\n maxWindSpeedWide = maxWindSpeedWide,\n maxWindSpeedOneWide = maxWindSpeedOneWide,\n WAI = WAI\n )\n md$selectWPFit <- list(\n fun = selectWPFit,\n indices = indFit\n )\n md$dot <- list(...)\n saveRDS(md, paste0(fn, \".metadata.rds\"))\n \n z <- dfFromLong(wso[1,])$z \n ws <- wso[,grep(\"^h[[:digit:]]\", names(wso))]\n ws <- cbind(ua=wso$ua, ws)\n ws <- cbind(lai=wso$lai, ws)\n ws <- as.data.frame(t(ws))\n \n ##\n i <- 0\n no <- ceiling(ncol(ws) / cores)\n dat <- mclapply(\n ws[,indFit],\n function(u) {\n f <- FUN(\n z = z,\n u = u[-(1:2)],\n LAI = u[1],\n ...\n )\n if (!is.null(f)) {\n f$lai <- u[1]\n f$ua <- u[2]\n }\n i <<- i + 1\n if (round(i, -2)==i){\n cat(i, \"\\tof about\\t\", no, \"\\r\")\n }\n return(f)\n },\n mc.cores = cores\n )\n class(dat) <- c(\"wpLELFitList\", class(dat))\n saveRDS(dat, fn)\n }\n if (!(\"wpLELFitList\" %in% class(dat))) {\n class(dat) <- c(\"wpLELFitList\", class(dat))\n }\n return(dat)\n}" nil) (9085 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpFitMultiple" wpFitMultiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpFitMultiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title wpLELFitEach\n##' @param new if \\code{TRUE} the cache is re-created - if\n##' \\code{FALSE} the results are read from the cache.\n##' @param suffix suffix for cache\n##' @param FUN Name of function to be used for fitting TODO\n##' @param cores number of cores to be used for analysis - defaults to the number of cores mius one, but is at least 1.\n##' @param minSpeedIncreaseWide minimum wind speed difference - see \\link{loadWS} for details\n##' @param maxWindSpeedWide maximum wind speed - see \\link{loadWS} for details\n##' @param maxWindSpeedOneWide standardise highest sampled wind speed to one - see \\link{loadWS} for details\n##' @param WAI Wood Area Index, argument \\code{WAI} of function\n##' \\code{loadWS()}. Will be added to lai from raw data.\n##' @param minUstar minimum value of ustar for wind profiles to be\n##' included. Values smaller than 0 will include all wind profiles.\n##' @param selectWPFit a function returning \\bold{a list} where each\n##' element of the list represents the indices of loaded wind profiles\n##' which will be used for fitting the parameter. The function takes\n##' one value, i.e. \\code{wso} which is the \\code{data.frame} of the\n##' loaded wind profiles, as returned by the function\n##'\n##' code{\n##' wso <- loadWS(\n##' wide = TRUE,\n##' onlyComplete = TRUE,\n##' minSpeedIncreaseWide,\n##' maxWindSpeedWide,\n##' maxWindSpeedOneWide,\n##' WAI = WAI\n##' )\n##' }\n##'\n##' An exapmle is\n##'\n##' \\code{selectWPFit = function(wso){lapply(1:5, function(x){sample(1:nrow(wso), 100)})}}\n##' \n##' which would create a list of 5 elements where each consists of 100\n##' randomly selected wind profiles \\bold{selected} for fitting or\n##'\n##' \\code{selectWPFit = function(wso){lapply(1:10, function(x){-sample(1:nrow(wso), 500)})}}\n##'\n##' which would create a list of 10 elements where each consists of 500\n##' randomly selected wind profiles \\bold{excluded} from fitting\n##'\n##' @param ... additional parameter passed to FUN ( mainly for the function \\code{optim()} )\n##' @return an oject of class \\code{wpLELFitList} (i.e. \\code{list}) of\n##' the length of the number wind profiles to fit. Each element\n##' contains the result of an individual fit.\n##' @author Rainer M. Krug\n##' @export\nwpFitMultiple <- function(\n new = FALSE,\n suffix = \"\",\n FUN = \"fitOptim.wpLEL.ownFree.multiple\",\n cores = detectCores() - 1,\n minSpeedIncreaseWide = 0,\n maxWindSpeedWide = 10,\n maxWindSpeedOneWide = FALSE,\n minUstar = 0.25,\n WAI = 0,\n selectWPFit = function(wso) { lapply(1:5, function(x){sample(1:nrow(wso), 100)}) },\n ...\n ) {\n if (cores==0) {\n cores <- 1\n }\n fn <- paste0(CACHE, \"/wpFitMultiple.\", FUN, suffix, \".rds\")\n FUN <- get(FUN)\n if (new) {\n unlink(fn)\n }\n if (file.exists(fn)) {\n dat <- readRDS(fn)\n } else {\n\n ## Load Wind Profiles\n wso <- loadWS(\n wide = TRUE,\n onlyComplete = TRUE,\n minSpeedIncreaseWide = minSpeedIncreaseWide,\n maxWindSpeedWide = maxWindSpeedWide,\n maxWindSpeedOneWide = maxWindSpeedOneWide,\n minUstar = minUstar,\n WAI = WAI\n )\n \n ## #################################\n ## From now on, LAI (later u[[1]]) is LAI = LAI + WAI)\n ## #################################\n\n ## Get indices for fitting. Must only be done once as the\n ## functions might contain random number generation!\n indFit <- selectWPFit(wso)\n\n ## Save \"metadata\"\n ## construct result list\n md <- list()\n md$method <- \"wpFitMultiple\"\n md$FUN <- FUN\n md$loadWSParm <- list(\n minSpeedIncreaseWide = minSpeedIncreaseWide,\n maxWindSpeedWide = maxWindSpeedWide,\n maxWindSpeedOneWide = maxWindSpeedOneWide,\n minUstar = minUstar,\n WAI = WAI\n )\n md$selectWPFit <- list(\n fun = selectWPFit,\n indices = indFit\n )\n md$dot <- list(...)\n saveRDS(md, paste0(fn, \".metadata.rds\"))\n \n ## Format the data\n z <- dfFromLong(wso[1,])$z \n ws <- wso[,grep(\"^h[[:digit:]]\", names(wso))]\n ws <- cbind(ua=wso$ua, ws)\n ws <- cbind(lai=wso$lai, ws)\n ws <- as.data.frame(t(ws))\n\n ## Do the fitting\n i <- 0\n no <- ceiling(ncol(ws) / cores)\n dat <- mclapply(\n indFit,\n function(s) {\n f <- FUN(\n wso = ws[,s],\n ...\n )\n i <<- i + 1\n if (round(i, -2)==i){\n cat(i, \"\\tof about\\t\", no, \"\\r\")\n }\n return(f)\n },\n mc.cores = cores\n )\n class(dat) <- c(\"wpLELFitList\", class(dat))\n saveRDS(dat, fn)\n }\n if (!(\"wpLELFitList\" %in% class(dat))) {\n class(dat) <- c(\"wpLELFitList\", class(dat))\n }\n return(dat)\n}" nil) (9242 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.wpLELFitList" plot\.wpLELFitList:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFitList.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to plot \\code{wpLELFitList}\n##'\n##' This function plots an \\code{wpLELFitList} object by plotting the\n##' lines of each fit on each other. The indices can be specified by\n##' using y.\n##' @param x object of class \\code{wpLELFitList} to be plotted \n##' @param y default \\code{NULL}; numeric vector of indices specifying\n##' the fits in \\code{x} to be plotted. If \\code{NULL} all will be plotted.\n##' @param ... optional arguments for \\code{plot} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nplot.wpLELFitList <- function(\n x,\n y = NULL,\n ...\n ) {\n if (is.null(y)) {\n y <- 1:length(x)\n }\n plot(\n x[[1]],\n add = FALSE,\n ...\n )\n ##\n for (i in y[-1]) {\n plot(\n x[[i]],\n add = TRUE,\n ...\n )\n }\n invisible()\n}" nil) (9283 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*print.wpLELFitList" print\.wpLELFitList:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLELFitList.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to print \\code{wpLELFitList}\n##'\n##' This function prints a \\code{wpLELFitList} object\n##' @param x object of class \\code{wpLELFitList} to be printed\n##' @param ... optional arguments for \\code{print} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nprint.wpLELFitList <- function(\n x,\n ...\n) {\n cat( \"Number of fits: \" )\n cat(length(x), \"\\n\")\n invisible(x)\n}" nil) (9311 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*airRest%20Generic%20function%20definition" airRest\ Generic\ function\ definition:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/airRest.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "airRest <- function(x, zsource) UseMethod(\"airRest\")" nil) (9318 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*airRest.wpLEL" airRest\.wpLEL ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/airRest.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function for \\code{airRest} to calculate aerial resistance\n##'\n##' Calculate aerial resistance based on \\code{wpLEL} object\n##' @param x object of class \\code{wpLEL}\n##' @param zsource if \\code{NULL} (default), \\code{zsource = z0 + dep}, unless the numerical value\n##' @return object of class \\code{airRest}.\n##' This object contains the following elements:\n##' \\itemize{\n##' \\item{method} : {the method used to generate the aerial profile (the name of this function)}\n##' \\item{wp} : {the wind profile on which the aerial resistance is based}\n##' \\item{I1} : {aerial resistance top log profile}\n##' \\item{I2} : {aerial resistance from h to zsource}\n##' \\item{I3} : {aerial resistance for exp profile}\n##' \\item{I4} : {aerial resistance lower exp profile}\n##' \\item{ras} : {aerial resistance from z0sol to top}\n##' \\item{rac} : {aerial resistance from zsource to za}\n##' }\n##' @author Rainer M. Krug\n##' @export\nairRest.wpLEL <- function(\n x,\n zsource = NULL\n) {\n ## resistance top log profile\n ## LEL - from za (very top) to dep (above canopy, log profile)\n ## LE - from za (very top) to dep (above canopy, log profile)\n I1 <- 1 / (x$vk*x$ustar) * log( (x$za-x$dep)/(x$h-x$dep) )\n\n ## resistance for exp profile\n ## LEL - from dep to zjoint (into canopy, exp profile)\n ## LE - from dep to z0sol (into canopy, exp profile)\n if (x$zjoint == 0) {\n ## log-exp profile\n I3 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp( x$na * (1 - x$z0sol/x$h) ) - 1 )\n } else {\n ## log-exp-log profile\n I3 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp( x$na * (1 - x$zjoint/x$h) ) - 1 )\n }\n\n ## resistance lower exp profile\n ## LEL - from zjoint to z0sol\n ## LE - 0\n if (x$zjoint == 0) {\n ## log-exp profile\n I4 <- 0\n } else {\n ## log-exp-log profile\n I4 <- 1 / (x$vk*x$ustarsol) * log( x$zjoint/x$z0sol )\n }\n ##\n\n ## resistance from z0sol to za\n ras = I1 + I3 + I4\n\n\n ## resistance from h to zsource (into canopy, exp profile or exp-log profile depending if zsource > zjoint or not)\n ## LEL (zsource > zjoint) - exp profile\n ## LEL (zsource < zjoint) - exp & log profile\n ## LE - exp profile\n if (is.null(zsource)) {\n zsource <- x$z0 + x$dep \n }\n if (x$zjoint==0) {\n ## log-exp profile\n I2 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp(x$na*(1 - zsource/x$h)) - 1 )\n } else {\n ## log-exp-log profile\n if (zsource < x$zjoint) {# never happen\n I2_1 <- ( 1/(x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp(x$na*(1 - x$zjoint/x$h)) - 1 )\n I2_2 <- ( 1/(x$vk*x$ustarsol) ) * ( log(x$zjoint/zsource) )\n I2 <- I2_1 + I2_2\n } else {\n I2 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp(x$na*(1- (zsource)/x$h)) - 1 )\n }\n }\n ##\n ## resistance from zsource to za\n rac <- I1 + I2\n\n ar <- list()\n ar$method <- \"airRest.wpLEL\"\n ar$wp <- x\n ar$I1 <- I1\n ar$I2 <- I2\n ar$I3 <- I3\n ar$I4 <- I4\n ar$ras <- ras\n ar$rac <- rac\n class(ar) <- \"airRest\"\n return(ar)\n}" nil) (9414 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.arLEL" plot\.arLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.arLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "plot.arLEL <- function(\n x,\n plotWPPoints = TRUE,\n plotWPValues = TRUE,\n plotARValues = TRUE,\n ...\n) {\n plot.wpLEL(\n x,\n plotWPPoints = plotWPPoints,\n plotWPValues = plotWPValues,\n ...\n )\n if (plotARValues) {\n mx <- par(\"usr\")[2]\n with(\n x,\n {\n ## arrows(\n ## x0 = c(0, 0, 0 ,0 ,0 ,0),\n ## y0 = c(z0+dep, za, h, hsource, dep, zjoint),\n ## x1 = c(4, 4, 4 ,4 ,4 ,4),\n ## y1 = c(z0+dep, za, h, hsource, dep, zjoint),\n ## length = 0,\n ## col = \"grey\",\n ## lty = \"dotted\"\n ## )\n \n \n text(mx*0.4, (za+h)/2., paste(\"R1=\", round(R1, 2) ) )\n text(mx*0.65, (z0h+dep+h)/2., paste(\"R2z0h=\", round(R2z0h, 2), \"R2z0=\", round(R2z0, 2) ) )\n text(mx*0.6, (z0+h)/2., paste(\"R3=\", round(R3, 2) ) )\n text(mx*0.6, (2*z0+h)/3., paste(\"R4log=\", round(R4log, 2), \"R4exp=\", round(R4exp, 2) ) )\n text(mx*0.5, 2, paste(\"racz0h=\", round(racz0h, 2), \"racz0=\", round(racz0, 2) ) )\n text(mx*0.5, 1, paste(\"raslog=\", round(raslog, 2), \"rasexp=\", round(rasexp, 2) ) )\n }\n )\n }\n invisible(NULL)\n}" nil) (9464 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans%20Generic%20function%20definition" evapoTrans\ Generic\ function\ definition:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans <- function(x) UseMethod(\"evapoTrans\")" nil) (9471 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.default" evapoTrans\.default:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.default.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans.default <- function(\n ras,\n rac,\n Ta = 20,\n frach = 1,\n Rnhsol = 600,\n RH = 50, # deltae = 5,\n gsol = 0.001\n) {\n ## mb (Monteith, 1990)\n es <- 6.1078 * exp( 17.269 * Ta/(Ta+ 237.3) ) # mb\n ea <- es * RH/100\n deltae <- es - ea\n Landah <- -2.37273 * Ta + 2501 # J.g-1\n Cph <- 1.01 # J.g-1.degreeC-1\n Rauh <- -4.111 * Ta + 1289.764 # g/m3\n Psyh <- Rauh * Cph * 8.31 * (Ta + 273.15) / (100*18*Landah) # mb.degreeC-1\n deltah <- Landah * 18 * es / ( 8.31 * (Ta + 273.15)^2 ) # mb.degreetC-1 Monteith p.10\n \n ## ETR du sol\n ETRhrsol <- frach * 3.6 *\n (deltah * Rnhsol) /\n (Landah * (deltah + Psyh * (1 + 1/(gsol * ras) )))\n ETRhcsol <- frach * 3.6 *\n (Rauh * Cph * deltae/ras) /\n (Landah * (deltah + Psyh * (1 + 1/(gsol * ras) )))\n ETRhsol <- ETRhrsol+ETRhcsol\n\n ## ETP couvert\n ETPch <- frach * 3.6 *\n (Rauh * Cph * deltae / rac) /\n ( Landah * (deltah + Psyh) )\n etp <- list(\n etrHrsol = ETRhrsol,\n etrHcsol = ETRhcsol,\n etrHsol = ETRhsol,\n etpCh = ETPch\n )\n etp$input <- list(\n ras = ras,\n rac = rac,\n Ta = Ta,\n frach = frach,\n Rnhsol = Rnhsol,\n RH = RH,\n gsol = gsol\n )\n class(etp) <- c(\"evapoTrans\", \"list\")\n attr(etp, \"method\") <- \"default\"\n return( etp )\n}" nil) (9530 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.airRest" evapoTrans\.airRest:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.airRest.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans.airRest <- function(\n x,\n Ta = 20,\n frach = 1,\n Rnhsol = 600,\n RH = 50, # deltae = 5,\n gsol = 0.001\n) {\n etp <- evapoTrans.default(\n ras = x$ras,\n rac = x$rac,\n Ta = Ta,\n frach = frach,\n Rnhsol = Rnhsol,\n RH = RH,\n gsol = gsol\n )\n etp$input$airRest <- x\n attr(etp, \"method\") <- \"airRest\"\n return( etp )\n}" nil) (9559 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.wpLEL" evapoTrans\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans.wpLEL <- function(\n x,\n Ta = 20,\n frach = 1,\n Rnhsol = 600,\n RH = 50, # deltae = 5,\n gsol = 0.001\n) {\n etp <- evapoTrans.airRest(\n x = airRest(x),\n Ta = Ta,\n frach = frach,\n Rnhsol = Rnhsol,\n RH = RH,\n gsol = gsol\n )\n attr(etp, \"method\") <- \"wpLEL\"\n return( etp )\n}" nil) (9588 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*lhc.etp.R" lhc\.etp ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/lhc.etp.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL} and calculates the aeril resistance.\n##'\n##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL}. The object \\code{x} is used at a template to fill in\n##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL} and calculates the aeril resistance.\n##'\n##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL}. The object \\code{x} is used at a template to fill in\n##' the missing values.\n##' @title lhc.wpLEL\n##' @param x object of type \\code{wpLEL} which will be used as a\n##' template for the returned Latin Hyper Cube \n##' @param n size of Latin Hypercube sample\n##' @param Min list of named named elements for minimum value of each column in the\n##' Latin Hypercube. \\code{names(Min)} has to be the same as \\code{names(Max)}!\n##' @param Max list of named named elements for maximum values for each column in the\n##' Latin Hypercube. \\code{names(Min)} has to be the same as \\code{names(Max)}!\n##' @param suffix suffix for file in cache\n##' @param new if \\code{TRUE} the cache is recreated, if \\code{FALSE}, the\n##' default, the cached values will be read\n##' @param cores number of cores to be used for the evaluation\n##' @return returns Latin Hypercube \\code{data.frame}\n##' @author Rainer M. Krug\n##' @export\nlhc.etp <- function(\n x,\n n,\n Min,\n Max,\n suffix,\n new = FALSE,\n cores = parallel::detectCores() - 1\n) {\n if (missing(suffix)) {\n suffix <- paste0(\".\", paste(names(Min), sep = \"\", collapse=\"-\"))\n } else {\n suffix <- paste0(\".\", paste(names(Min), sep = \"\", collapse=\"-\"), suffix)\n }\n fn <- paste0(CACHE, \"/lhc.etp.\", x$parametrization, suffix, \".rds\")\n if (new) {\n unlink(fn)\n }\n if (file.exists(fn)) {\n result <- readRDS(fn)\n } else {\n if (length(Min) != length(Max)) {stop(\"Min and Max have to have the same length!\")}\n if (!all.equal(names(Min), names(Max) )) {stop(\"Min and Max have to have the same names!\")}\n ## Build random Latin Hypercube\n dat <- lhs::randomLHS(n=n, k=length(Min))\n colnames(dat) <- names(Min)\n ## Transform the 0..1 values to the selected range\n dat <- sweep(\n x = dat,\n MARGIN = 2,\n Max-Min,\n '*'\n )\n dat <- sweep(\n x = dat,\n MARGIN = 2,\n Min,\n '+'\n )\n ## ## Exculde cases where conditions 6) and 7) are not met\n ## if (all(c(\"z0\", \"dep\", \"zjoint\") %in% names(Min))) {\n ## depz0 <- dat[,\"dep\"] + dat[,\"z0\"]\n ## i <- depz0 < h & depz0 > dat[,\"zjoint\"]\n ## dat <- dat[i,]\n ## }\n\n dat <- as.data.frame(t(dat))\n ##\n wphelp <- function(...) {wpLEL.wpLEL(x, ...)}\n no <- ceiling(ncol(dat) / cores)\n i <- 0\n result <- mclapply(\n dat,\n function(s) {\n names(s) <- rownames(dat)\n s <- as.list(s)\n s$wp <- do.call(wphelp, s)\n \n depz0 <- s$wp[[\"dep\"]] + s$wp[[\"z0\"]]\n if (depz0 < s$wp[[\"h\"]] & depz0 > s$wp[[\"zjoint\"]]) {\n ar <- airRest(s$wp)\n etp <- evapoTrans.airRest(\n x = ar,\n Ta = s[[\"Ta\"]],\n frach = 1,\n Rnhsol = s[[\"Rnhsol\"]],\n RH = s[[\"RH\"]],\n gsol = s[[\"gsol\"]]\n )\n ##\n s$I1 <- ar$I1\n s$I2 <- ar$I2\n s$I3 <- ar$I3\n s$I4 <- ar$I4\n s$ras <- ar$ras\n s$rac <- ar$rac\n ##\n s$etrHrsol <- etp$etrHrsol\n s$etrHcsol <- etp$etrHcsol\n s$etrHsol <- etp$etrHsol\n s$etpCh <- etp$etpCh\n class(s) = c(\"lhcAirRest\", class(s))\n } else {\n s <- NULL\n }\n i <<- i + 1\n if (round(i, -2) == i) {\n cat(i, \"\\t of about \\t\", no, \"\\t\\t\\r\")\n }\n return(s)\n },\n mc.cores = cores\n )\n cat(\"\\n\")\n result <- result[!sapply(result, is.null)]\n saveRDS(result, fn)\n }\n return(result)\n}" nil) (9720 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*tests" tests:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./tests/wpLELTest.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "## stopifnot(require(energyBalance))\n\n## Tolerance for numerical comparisons\nepsilon <- 1.0e-9\n\nua <- 3.136\nza <- 37\nz <- seq(\n from = 0,\n to = za,\n by = 0.1\n)\n\n## Test 1\nu <- wpLEL(\n z,\n ua = ua,\n dep = 14,\n z0 = 2.8,\n na = 7,\n zjoint = 14.31625,\n h = 28,\n za = 37,\n z0sol = 0.01\n)\nu.s <- readRDS(\"./tests/u.rds\")\nstopifnot( max(abs(unlist(u) - unlist(u.s)), na.rm=TRUE ) < epsilon)\n\nu <- airRest(u)\nu.s <- readRDS(\"./tests/u.ar.rds\")\nstopifnot( max(abs(unlist(u) - unlist(u.s)), na.rm=TRUE ) < epsilon)\n\n## Test 2\nWAI <- 0.5\nLAI <- 0\nu1 <- wpLEL(\n z,\n ua = ua,\n dep = function(PAI) {1.1*h*log(1+(Cd*PAI)^0.25)},\n PAI = WAI + LAI\n)\nu1.s <- readRDS(\"./tests/u1.rds\")\nstopifnot( max(abs(unlist(u1) - unlist(u1.s)), na.rm=TRUE ) < epsilon)\n\nu1 <- airRest(u1)\nu1.s <- readRDS(\"./tests/u1.ar.rds\")\nstopifnot( max(abs(unlist(u1) - unlist(u1.s)), na.rm=TRUE ) < epsilon)\n\n## Test 3\nWAI <- 0.5\nLAI <- 6\nu2 <- wpLEL(\n z,\n ua = ua,\n dep = function(PAI) {1.1*h*log(1+(Cd*PAI)^0.25)},\n PAI = WAI + LAI\n)\nu2.s <- readRDS(\"./tests/u2.rds\")\nstopifnot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=TRUE ) < epsilon)\n\nu2 <- airRest(u2)\nu2.s <- readRDS(\"./tests/u2.ar.rds\")\nstopifnot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=TRUE ) < epsilon)" nil) (9828 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Package%20Documentation" Package\ Documentation:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalancePaper/R/EnergyBalancePaper.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' EnergyBalancePaper: Companion package for paper\n#'\n#' Companion package for the paper \\bold{TO BE ADDED} This packagee\n#' contains thew data and the functions used to analyse the date and\n#' to create the plots in the paper. In addition it also contains\n#' further scripts for analysis and plots not included in the paper.\n#' \n#' @section EnergyBalancePaper functions and data:\n#' Data: To Be added ...\n#' Functions: To Be added ...\n#'\n#' @docType package\n#' @name EnergyBalancePaper\nNULL\n#> NULL" nil) (9847 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plotByLAI" plotByLAI:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalancePaper/R/plotByLAI.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "plotByLAI <- function(x, lai, pars, lower, upper, ...){\n i <- (x >= lower & x <= upper)\n plot(\n x = c(lower, upper),\n y = c(-0.5, 8),\n type = \"n\",\n xlab = x,\n ylab = \"round(LAI)\",\n axes = FALSE,\n ...\n )\n ## abline(v = initial[x], col=\"blue\")\n box()\n axis(1)\n axis(\n 2,\n at=0:7,\n labels=c(\"0.5\", \"1.5\", \"2.5\", \"3.5\", \"4.5\", \"5.5\", \"6.5\", \"7\"),\n las = 1\n )\n bp <- boxplot(\n x[i] ~ round(lai[i]),\n plot = FALSE\n )\n bxp(\n bp,\n horizontal = TRUE,\n notch = TRUE,\n at = as.numeric(bp$names),\n axes = FALSE,\n add = TRUE\n )\n}" nil) ...))
#[(by-lang) "\b@.\bA.\306 \v\"A\206.\0 .\307\306 .\"A\203#.\310\306 .\"A!\206$. \311P!.\r\312.\x0e\313\314\n\"-\207" [by-lang lang specs org-babel-tangle-lang-exts ext org-src-lang-modes assoc intern symbol-name "-mode" nil mapc #[(spec) "\306\211.\307!.\b\310!\211.G\311V\205.\0\n).\b\312!. \313\230\203%.\314\315 !\2027. \316\230\203/.\317\2027. G\311V\2057. \211.\205P.\x0e,\203O. \313\230\203O.\r\320.,Q\202P.\r\211.-\2054.\b\321!\322.-!..\211./\203w.\x0e.\203w.\x0e/\316\230\204w.\323..\324\"\210*\325.-!\203\217.\x0e-\326\327.0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203\247.\317\335\336\217\210\v\203\277.\x0e-.3\235\204\277.\v\337Pc\210.-.3B.3\340.4!\210\341 .5\331\332!.6r.6q\210\342\216\325.-!\203\340.\343.-!\210db\210\344\345\346.48\"A\316\230\204\371.`eU\204\371.\337c\210.5c\210\347\317\211.-#\210.\a\v\203.\x01\f\204.\x01\350.\x0e7T.7.-\fB.8\351.8.0\352\353$\203+.\x0e0\2023.\x0e8.0B\211.0)..\207" [get-spec tangle sheb she-bang tangle-mode base-name #[(name) "\302\b\303 8\"A\207" [name spec assoc 4] 4] :tangle :shebang 0 :tangle-mode "yes" file-name-sans-extension buffer-file-name "no" nil "." :mkdirp file-name-directory make-directory parents file-exists-p mapcar car delete-file generate-new-buffer " *temp*" ((byte-code "\301\b!\203\n.\302\b!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) fboundp (funcall lang-f) ((error)) "\n" org-babel-spec-to-string buffer-string ((byte-code "\301\b!\203\n.\302\b!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) insert-file-contents assoc :padline 4 write-region 493 cl-member :test #[(a b) "\b@ @\232\207" [a b] 2] ext file-name fnd m path-collector temp-buffer ...] 6] lang-f she-banged] 5](("R" (5939 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/data/fileNames.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "CACHE <- file.path( \".\", \"cache\")\nSQLITEDB <- file.path(CACHE, \"energyBalance.sqlite\")" nil) (5950 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Package%20Documentation" Package\ Documentation:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/EnergyBalance.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' EnergyBalance: A package for computating wind profiles and\n#' aerodynamic resistances.\n#'\n#' The EnergyBalance package provides functiuons to\n#' fit wind profiles, calculate the aerial resistance and plot the profiles.\n#' \n#' @section EnergyBalance functions:\n#' To Be added ...\n#'\n#' @docType package\n#' @name EnergyBalance\n#' @importFrom parallel detectCores\n#' @importFrom parallel mclapply\n#' @importFrom lhs randomLHS\n#' @importFrom RSQLite SQLite\n#' @import DBI\n#' @import magrittr\nNULL\n#> NULL" nil) (5973 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/CACHE.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' Cache for computations in package\n#'\n#' CACHE to be used for the computations. The cac=he holde =temporary\n#' as well as final results of the computations which are saved\n#' automatically to avoid re-computqtion. \n#' \n#' @format Character vector of length one.\n#' @name CACHE\n#' @docType data\nNULL" nil) (5986 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*SQLITEDB" SQLITEDB:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/SQLITEDB.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' SQLite Database with processed input data\n#'\n#' File name and path to the sqlite database which holds the processed\n#' wind speeds and LAI and the indices to increase access speed.\n#' \n#' @format Character vector of length one.\n#' @name SQLITEDB\n#' @docType data\nNULL" nil) (6000 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*getplotlim" getplotlim:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/getplotlim.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Return the limits of the plot\n##'\n##' Return the limits, as set by \\code{xlim = } and \\code{ylim = }. \n##' @param lim if \\code{xlim} or \\code{ylim} return the xorresponding\n##' limits, if code{xlimylim} retur list with each limit as an\n##' element.\n##' @return either vector with two elements containing the x or y\n##' limits or a list of two elements, xlim and ylim.\n##' @author Rainer M. Krug\n##' @export\ngetplotlim<-function(lim = c(\"xlim\", \"ylim\")) {\n usr <- par('usr')\n xr <- (usr[2] - usr[1]) / 27 # 27 = (100 + 2*4) / 4\n yr <- (usr[4] - usr[3]) / 27\n return(\n switch(\n EXPR = paste(sort(lim), collapse=\"\"),\n xlim = c(usr[1] + xr, usr[2] - xr),\n ylim = c(usr[3] + yr, usr[4] - yr),\n xlimylim = list(\n xlim = c(usr[1] + xr, usr[2] - xr),\n ylim = c(usr[3] + yr, usr[4] - yr)\n ),\n stop(\"Invalid value for lim!\")\n ) \n )\n}" nil) (6032 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Input%20data%20directory%20discovery%20functions" Input\ data\ directory\ discovery\ functions:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/inputDataDir.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Returns input data dir\n##'\n##' Returns input data dir (the directory with the wind and LAI\n##' input files are located in). If the package \\code{EnergyBalancePaper} is\n##' installed, the data included in this package is returned,\n##' otherwist the directory \\code{paste0{getwd(), \"/inputdata\"}} is\n##' returned.\n##' \n##' @title inputDataDir\n##' @return input data directory for win=d and LAI data\n##' @author Rainer M. Krug\n##' @export\ninputDataDir <- function() {\n file.path(\n ifelse(\n \"package:EnergyBalancePaper\" %in% search(),\n system.file(package = \"EnergyBalancePaper\"),\n getwd()\n ),\n \"inputdata\"\n )\n}" nil) (6120 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*importVentToDB" importVentToDB:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/importVentToDB.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Import wind data\n##'\n##' Import data into sqlite db and fit =default= to each wind profile\n##' to obtain the parameters, e.g. ustar for selecting.\n##' @param h canopy height in meter. Needed for estimate of ustar (u*)\n##' @param fn file name of wind date\n##' @return invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\nimportVentToDB <- function(fn, h) {\n wsw <- read.csv(\n file = fn,\n stringsAsFactors = FALSE,\n header = TRUE\n )\n names(wsw) <- c(\n \"date\",\n \"time\",\n \"julien\",\n \"h03\",\n \"h11\",\n \"h17\",\n \"h23\",\n \"h29\",\n \"h37\"\n )\n ## Add columns for wpLELDefault parameter values\n wsw$ua <- NA\n wsw$dep <- NA\n wsw$z0 <- NA\n wsw$na <- NA\n wsw$zjoint <- NA\n wsw$h <- NA\n wsw$za <- NA\n wsw$ustar <- NA\n ## Fit wpLELDefault and save parameter\n\n for (i in 1:nrow(wsw)) {\n if(floor(i/20)*20 == i) { cat(i, \" \") }\n wp <- dfFromLong(wsw[i,])\n if ( !any( is.na( c(wp$z, wp[,3]) ) ) ){\n wpf <- fitOptim.wpLEL.default.single(\n z = wp$z,\n u = wp[,3],\n ## lower = c(dep=0, z0=0.001, na=0.01, zjoint=0),\n initial = c(dep=2, z0=2, na=2, zjoint=3)\n ## upper = c(dep=27, z0=h, na=20, zjoint=h),\n ## method = \"L-BFGS-B\"\n )\n wsw$ua[i] <- wpf$wp[[\"ua\"]]\n wsw$dep[i] <- wpf$fit$par[[\"dep\"]]\n wsw$z0[i] <- wpf$fit$par[[\"z0\"]]\n wsw$na[i] <- wpf$fit$par[[\"na\"]]\n wsw$zjoint[i] <- wpf$fit$par[[\"zjoint\"]]\n wsw$h[i] <- wpf$wp[[\"h\"]]\n wsw$za[i] <- wpf$wp[[\"za\"]]\n wsw$ustar[i] <- wpf$wp[[\"ustar\"]]\n }\n }\n \n wsl <- data.frame(\n date = wsw$date,\n time = wsw$time,\n julien = wsw$julien,\n z = rep(\n c(3,11,17,23,29,37),\n times = rep( nrow(wsw), 6 )\n ),\n ws = c(\n wsw$h03,\n wsw$h11,\n wsw$h17,\n wsw$h23,\n wsw$h29,\n wsw$h37\n ),\n ua = wsw$ua,\n dep = wsw$dep,\n z0 = wsw$z0,\n na = wsw$na,\n zjoint = wsw$zjoint,\n h = wsw$h,\n za = wsw$za,\n ustar = wsw$ustar\n )\n ##\n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try({\n ## WindSpeed_w\n DBI::dbWriteTable(db, \"WindSpeed_w\", wsw, overwrite=TRUE)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsw_dt ON WindSpeed_w (date, time)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsw_jt ON WindSpeed_w (julien, time)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsw_date ON WindSpeed_w (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsw_time ON WindSpeed_w (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsw_julien ON WindSpeed_w (julien)\")\n ## WindSpeed_l\n DBI::dbWriteTable(db, \"WindSpeed_l\", wsl, overwrite=TRUE)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsl_dth ON WindSpeed_l (date, time, z)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsl_jth ON WindSpeed_l (julien, time, z)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_date ON WindSpeed_l (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_time ON WindSpeed_l (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_julien ON WindSpeed_l (julien)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_h ON WindSpeed_l (h )\")\n }\n )\n DBI::dbDisconnect(db)\n invisible()\n}" nil) (6245 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*importLAIToDB" importLAIToDB:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/importLAIToDB.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Import LAI data\n##'\n##' Import LAI data into sqlite db\n##' @param fn file name of LAI data\n##' @return invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\nimportLAIToDB <- function(fn) {\n lai <- read.csv(\n file = fn,\n stringsAsFactors = FALSE,\n header = TRUE\n )\n names(lai) <- c(\n \"doy\",\n \"lai\"\n )\n ##\n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try(\n {\n DBI::dbWriteTable(db, \"LeafAreaIndex\", lai, overwrite=TRUE)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX lai_doy ON LeafAreaIndex (doy)\")\n DBI::dbGetQuery(db, \"CREATE INDEX lai_h ON LeafAreaIndex (lai)\")\n }\n )\n DBI::dbDisconnect(db)\n}" nil) (6353 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*createWsLAI" createWsLAI:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/createWsLAI.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Finalize sqlight databaes of input data\n##'\n##' Create combined wind speed and LAI table and associated indices in sqlite database.\n##' @return invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\ncreateWsLAI <- function(\n ){\n sql_l <- paste(\n \"CREATE TABLE\",\n \" WindSpeedLAI_l\",\n \"AS SELECT\",\n \" WindSpeed_l.*, LeafAreaIndex.lai AS lai\",\n \"FROM\", \n \" WindSpeed_l\",\n \"LEFT OUTER JOIN\",\n \" LeafAreaIndex\",\n \"ON\",\n \" julien=DOY\"\n )\n sql_w <- paste(\n \"CREATE TABLE\",\n \" WindSpeedLAI_w\",\n \"AS SELECT\",\n \" WindSpeed_w.*, LeafAreaIndex.lai AS lai\",\n \"FROM\", \n \" WindSpeed_w\",\n \"LEFT OUTER JOIN\",\n \" LeafAreaIndex\",\n \"ON\",\n \" julien=DOY\"\n )\n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try({\n ##\n DBI::dbGetQuery( conn = db, statement = \"DROP TABLE IF EXISTS WindSpeedLAI_l\")\n DBI::dbGetQuery( conn = db, statement = sql_l)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslail_dth ON WindSpeedLAI_l (date, time, z)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslail_jth ON WindSpeedLAI_l (julien, time, z)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_date ON WindSpeedLAI_l (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_time ON WindSpeedLAI_l (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_julien ON WindSpeedLAI_l (julien)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_h ON WindSpeedLAI_l (z )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_lai ON WindSpeedLAI_l (lai)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_ustar ON WindSpeedLAI_l (ustar)\")\n ##\n DBI::dbGetQuery( conn = db, statement = \"DROP TABLE IF EXISTS WindSpeedLAI_w\")\n DBI::dbGetQuery( conn = db, statement = sql_w)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslaiw_dth ON WindSpeedLAI_w (date, time)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslaiw_jth ON WindSpeedLAI_w (julien, time)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_date ON WindSpeedLAI_w (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_time ON WindSpeedLAI_w (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_julien ON WindSpeedLAI_w (julien)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_lai ON WindSpeedLAI_w (lai)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_ustar ON WindSpeedLAI_w (ustar)\")\n }\n )\n DBI::dbDisconnect(db)\n invisible(NULL)\n}" nil) (6421 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*createCache" createCache:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/createCache.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Re-create \\code{CACHE}\n##'\n##' Deletes all files in the cache (directory \\code{CACHE}) and re-creates them\n##' @title Recreate files in cache\n##' @name createCache\n##' @return invisible NULL\n##' @author Rainer M. Krug\n##' @export\n##' @param fnVent file name of Wind Profile csv file\n##' @param fnLAI file name of LAI csv file\n##' @param h height, needed for wind profile fit to obtain u^*\ncreateCache <- function(fnVent, fnLAI, h) {\n dir.create(CACHE, showWarnings = FALSE)\n unlink(SQLITEDB)\n importVentToDB(fnVent, h)\n importLAIToDB(fnLAI)\n createWsLAI()\n invisible(NULL)\n}" nil) (6446 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*loadWS" loadWS:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/loadWS.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Depending on the values of the arguments, different datasets are\n##' loaded, but all contain wind speed at different heights and lai\n##' data. The sql argument can be used to specify different\n##' conditions for the data returned.\n##'\n##' Loads wind speed data from sql database in cache\n##' @title Load wind speed data\n##' @param wide if TRUE, load wide format, if FALSE long format\n##' @param onlyComplete if \\code{TRUE}, load only datapoints without missing\n##' data in wind \\code{h*} and \\code{LAI}.\n##' @param minSpeedIncreaseWide numeric value or \\code{NULL}. If not \\code{NULL}, the following rules will be\n##' used to filter the wind profiles:\n##' \n##' \\itemize{\n##' \n##' \\item{ differences of wind speeds between each point and the\n##' adjacend lower sampling points has to be larger then the value of\n##' \\code{minSpeedIncreaseWide}}\n##'\n##' }\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @param maxWindSpeedWide numeric value or \\code{null}. If not\n##' \\code{NULL}, wind profiles with wind speeds higher then\n##' \\code{maxWindSpeedWide} will be filtered out.\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @param maxWindSpeedOneWide Logical - if \\code{TRUE} the wind profiles will\n##' be standardised to wind speed at highest sampling point to 1 and\n##' the original wind speed will be stored in a field \\code{ua}\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @param minUstar minimum ustar value to be included in analysis. The default is 0.25. \\bold{REFERENCE NEEDED}\n##' \n##' @param WAI Wood Area Index - default value \\code{0}. numeric value to be added to the field\n##' \\code{lai}. \n##' @param sql sql statement to be used instread of \\code{wide} and\n##' \\code{onlyComplete}. The sql statement is evauated and the result is\n##' returned.\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @return data.frame containing the data. If the \\code{wide==TRUE},\n##' the class is also set to \\code{wsw}, if \\code{wide==FALSE} to\n##' \\code{wsl}\n##' @author Rainer M. Krug\n##' @export\nloadWS <- function(\n wide = TRUE,\n onlyComplete = TRUE,\n minSpeedIncreaseWide = 0,\n maxWindSpeedWide = 10,\n maxWindSpeedOneWide = FALSE,\n minUstar = 0.25,\n WAI = 0,\n sql\n ) {\n if (wide) {\n tbln <- \"WindSpeedLAI_w\"\n } else {\n tbln <- \"WindSpeedLAI_l\"\n }\n try({ \n db <- dbConnect(RSQLite::SQLite(), SQLITEDB)\n if (missing(sql)) {\n if (!onlyComplete) {\n sql <- paste( \"SELECT * FROM\", tbln ) \n } else {\n f <- c( \"LAI\", grep(\"^h.\", dbListFields(db, tbln), value=TRUE))\n f <- paste(f, \"IS NOT NULL\", collapse = \" AND \")\n sql <- paste( \"SELECT * FROM \", tbln, \"WHERE\", f, \"AND ustar >=\", minUstar)\n }\n }\n ws <- DBI::dbGetQuery(db, sql)\n } \n )\n dbDisconnect(db)\n ##\n if (length(grep(\"date|time\", names(ws))) >= 2) {\n ws$date <- as.Date(ws$date, format = \"%d/%m/%y\")\n ws$dateTime <- as.POSIXct(paste(ws$date, ws$time), format=\"%Y-%m-%d %H:%M\")\n ##\n ws <- ws[\n c(\n \"date\",\n \"time\",\n \"dateTime\",\n grep(\"date|time|dateTime\", names(ws), invert=TRUE, value=TRUE)\n )\n ]\n ##\n }\n if (wide) {\n class(ws) <- c(class(ws), \"wsw\")\n h <- rownames(dfFromLong(ws[2,]))\n if (!is.null(minSpeedIncreaseWide)) {\n ws <- ws[\n ws[,h] %>%\n as.matrix %>%\n t %>%\n diff %>%\n data.frame %>%\n sapply(\n X = .,\n FUN = . %>%\n is_less_than(minSpeedIncreaseWide) %>%\n any\n ) %>%\n not,\n ]\n }\n if (!is.null(maxWindSpeedWide)) {\n ws <-\n ws[\n ws[,h] %>%\n apply(\n X = .,\n MARGIN = 1,\n FUN = max\n ) %>%\n is_less_than(maxWindSpeedWide),\n ]\n }\n ua <- dfFromLong(ws[1,]) %>% extract(\"z\") %>% max %>% paste0(\"h\", .)\n ws$ua <- ws[[ua]]\n if (maxWindSpeedOneWide) {\n for (i in h) {\n ws[i] <- ws[i] / ws[ua] \n }\n }\n } else {\n class(ws) <- c(class(ws), \"wsl\")\n }\n if (!is.null(WAI)) {\n ws$lai <- ws$lai + WAI\n }\n return(ws)\n}" nil) (6596 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*dfFromLong" dfFromLong:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/dfFromLong.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Extract the height from the column names in the database, where\n##' the column names of the height have to follow the format\n##' \\code{h[:digit:]}.\n##'\n##' Extract the height\n##' @title Extract height from column names\n##' @param x column names\n##' @return heights as encoded in the column names in the order as given\n##' @author Rainer M. Krug\n##' @export\ndfFromLong <- function(\n x\n ) {\n hCols <- grep(\n pattern = \"^h[[:digit:]]\",\n x = names(x),\n value = FALSE\n )\n h <- gsub(\"h\", \"\", names(x)[hCols])\n h <- as.numeric(h)\n u <- as.matrix(x[hCols])\n if(is.vector(u)) {\n result <- data.frame(\n index = hCols,\n z = h,\n u = u\n )\n } else { # is.matrix(u) == TRUE\n result <- data.frame(\n index = hCols,\n z = h,\n u = t(u)\n )\n }\n rownames(result) <- names(x)[hCols]\n return(result)\n}" nil) (6646 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL%20Generic%20function%20definition" wpLEL\ Generic\ function\ definition:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to create \\code{wpLEL} object.\n##'\n##' The returned object of class \\code{wpLEL} contains the following fields:\n##' \\itemize{\n##' \\item{\\code{parametrization}} {parametrization used to create this object. Possible values are \"default\" and \"Mahat2013\"}\n##' \n##' \\item{\\code{dep}} {some info}\n##' \\item{\\code{z0}} {some info}\n##' \\item{\\code{na}} {some info}\n##' \\item{\\code{zjoint}} {some info}\n##' \\item{\\code{h}} {some info}\n##' \\item{\\code{za}} {some info}\n##' \\item{\\code{z0sol}} {some info}\n##' \n##' \\item{\\code{vk}} {some info}\n##' \\item{\\code{ua}} {some info}\n##' \\item{\\code{ustar}} {some info}\n##' \\item{\\code{z0h}} {some info}\n##' \\item{\\code{uzjoint}} {some info}\n##' \\item{\\code{ustarsol}} {some info}\n##'\n##' \\item{\\code{noU}} {some info}\n##' }\n##' @title wpLEL\n##' @param x object from which to calculat the \\code{wpLEL} object\n##' @param ... optional arguments for the generic functions\n##' @return objerct of class \\code{wpLEL}\n##' @author Rainer M. Krug\n##' @export\nwpLEL <- function(x, ...) UseMethod(\"wpLEL\")" nil) (6681 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*parameterOK" parameterOK:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/parmeterOK.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Check parameter for validity\n##'\n##' Check parameter for validity. If they are valid, the function\n##' returns \\code{TRUE}, if not, it returns the error messages.\n##' @title parameterOK\n##' @param z z\n##' @param ua ua\n##' @param dep dep\n##' @param z0 z0\n##' @param na na\n##' @param zjoint zjoint\n##' @param h h\n##' @param za za\n##' @param z0sol z0sol\n##' @return \\code{TRUE} if parameter are OK, otherwise a named\n##' \\code{character} vector where the names are the parameter which\n##' are not OK and the values the error messages to be used\n##' @author Rainer M. Krug\n##' @export\nparameterOK <- function(\n z,\n ua,\n dep,\n z0,\n na,\n zjoint,\n h,\n za,\n z0sol\n ) {\n result <- NULL\n ## z 0 <= z\n if (any( z < 0 )) {\n result <- c(result, z = \"All z have to be larger or equal than zero!\\n\")\n }\n ## ua 0 <= ua\n if (ua < 0 ) {\n result <- c(result, ua = \"ua has to be larger or equal than zero!\\n\")\n }\n ## dep 0 <= dep < h\n if ((dep < 0) | (dep >= h) ) {\n result <- c(result, dep = \"dep has to be larger or equal than zero and smaller than h!\\n\")\n }\n ## z0 0 < z0 <= h\n if ((z0 <= 0) | (z0 > h)) {\n result <- c(result, z0 = \"z0 has to be larger than zero and smaller or equal than h!\\n\")\n } \n ## na 0 < na\n if (na < 0 ) {\n result <- c(result, na = \"na has to be larger or equal than zero!\\n\")\n } \n ## zjoint\n if ((zjoint < 0) | (zjoint > h)) {\n result <- c(result, zjoint = \"zjoint has to larger or equal than 0 and smaller or equal than h!\\n\")\n }\n ## h h >= 0\n if (h < 0 ) {\n result <- c(result, h = \"h has to be larger or equal than zero!\\n\")\n }\n ## za za > h\n if (za <= h ) {\n result <- c(result, za = \"za has to be larger than h!\\n\")\n }\n ## z0sol 0 < z0sol POSSIBLY < h/10 ???\n if (z0sol <= 0 ) {\n result <- c(result, z0sol = \"z0sol has to be larger than zero!\\n\")\n }\n ## ###\n ## dep, z0, h dep + z0 < h\n if ((dep + z0) > h) {\n result <- c(result, \"(dep + z0) has to be smaller than h!\\n\")\n }\n \n if (is.null(result)) {\n result <- TRUE\n }\n return(result)\n}" nil) (6775 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELDefault" wpLELDefault ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELDefault.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param dep zero-plane displacement height. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{dep}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' dep = function(LAI, ...) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the argument\n##' \\code{parametrization} accordingly (in this example\n##' \"Mahat\") to adjust further analysis accordingly!\n##' @param z0 roughness length at canopy level. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{z0}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' z0 = function(LAI, ...) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the\n##' argument \\code{parametrization} accordingly (in this\n##' example \"Mahat\") to adjust further analysis accordingly!\n##' @param na exponential decay coefficient\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @param ... further argumewnts which will be passed to the user\n##' defined function \\code{dep} and \\code{z0}.\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELDefault <- function(\n z,\n ua,\n dep,\n z0,\n na, # = 7,\n zjoint,\n h, # = 28,\n za, # = 37,\n z0sol,# = 0.001,\n noU = FALSE,\n check = TRUE\n ){ \n vk <- 0.41\n \n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n stop(ok)\n }\n \n ## profil5.m l29 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::29]]\n ## ustar = ua * vk / log( (za - dep) / z0) \n ustar <- ua * vk / log( (za - dep) / z0)\n\n ## profil5.m l30 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::30]]\n ## z0h = z0 * exp( -6.27 * vk * ( ustar^(1/3) ) ); % Calcul de Z0h (Thom)\n z0h <- z0 * exp( -6.27 * vk * ( ustar^(1/3) ) )\n\n ## profil5.m l32 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::32]]\n ## zjoint = z0h + dep;\n ## if (missing(zjoint)) {zjoint <- z0h + dep}\n\n ## profil5.m l33 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::33]]\n ## uzjoint = ustar / vk * log( (hauteur - dep)/z0 ) * exp( - na * (1 - zjoint/hauteur) );\n uzjoint <- (ustar / vk) * log( (h - dep)/z0 ) * exp( - na * (1 - zjoint/h ) )\n\n ## profil5.m l34 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::34]]\n ## ustarsol = uzjoint * vk / log( (zjoint/z0sol))\n ustarsol <- ifelse(\n (zjoint == 0),\n as.numeric(NA),\n uzjoint * vk / log( zjoint / z0sol )\n )\n \n ##\n result <- list(\n z = NA,\n u = NA,\n u.onlyTop = NA\n )\n\n if (!noU) {\n result$z <- as.numeric(z)\n ##\n result$u <- as.numeric(\n sapply(\n z,\n function(z) {\n if (z >= h) {\n ## profil5.m l36 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::37]]\n u <- ( ustar/vk ) * log( (z-dep) / z0 )\n } else if (z >= zjoint) {\n ## profil5.m l40 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::41]]\n uh <- ( ustar/vk ) * log( (h-dep) / z0 )\n u <- uh * exp( -na*(1-(z/h)) )\n } else if (z >= 0) {\n ## profil5.m l42 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::42]]\n u <- ( ustarsol/vk ) * log( (z ) / z0sol )\n } else {\n u <- NA\n }\n return(u)\n }\n )\n )\n names(result$u) <- paste0(\"h\", z)\n ##\n result$u.onlyTop = as.numeric(\n sapply(\n z,\n function(z) {\n zd <- ((z-dep) / z0)\n if (zd < 0){\n u <- NA\n } else {\n u <- ( ustar/vk ) * log( (z-dep) / z0 )\n }\n if (!is.na(u)) {\n if (u < 0) {\n u <- NA\n }\n }\n return(u)\n }\n )\n )\n }\n ##\n result$parametrization <- \"default\"\n result$dep <- as.numeric(dep)\n result$z0 <- as.numeric(z0)\n result$na <- as.numeric(na)\n result$zjoint <- as.numeric(zjoint)\n result$h <- as.numeric(h)\n result$za <- as.numeric(za)\n result$z0sol <- as.numeric(z0sol)\n \n result$vk <- as.numeric(vk)\n result$ua <- as.numeric(ua)\n result$ustar <- as.numeric(ustar)\n result$z0h <- as.numeric(z0h)\n result$uzjoint <- as.numeric(uzjoint)\n result$ustarsol <- as.numeric(ustarsol)\n ##\n result$noU <- noU\n result$check <- check\n ##\n class(result) <- c(\"wpLEL\")\n return(result)\n}" nil) (6981 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELMahat" wpLEL\.mahat ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELMahat.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape using Mahat parametrisation\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile based on Mahat parametrization\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param na exponential decay coefficient\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param LAI Leaf Area Index to be used for the calculation of \\code{dep}\n##' @param y integer indicating three basic forest profiles\n##' \\itemize{\n##' \\item{y = 1} : {young pine}\n##' \\item{y = 2} : {leafed decideous tree}\n##' \\item{y = 3} : {old pine with long stems and clumping at the top}\n##' }\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELMahat <- function(\n z,\n ua,\n na,\n zjoint,\n h,\n za,\n z0sol,\n LAI,\n y,\n noU = FALSE,\n check = TRUE\n){ \n depFUN <- function(LAI, ...) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n dep <- depFUN(LAI, h, y)\n ##\n z0FUN <- function(LAI, ...) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n z0 <- z0FUN(LAI, h, y)\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = FALSE\n )\n ##\n result$z0FUN <- z0FUN\n result$depFUN <- depFUN\n result$LAI <- as.numeric(LAI)\n result$y <- as.numeric(y)\n result$check <- check\n ##\n result$parametrization <- \"mahat\"\n ##\n return(result)\n}" nil) (7084 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELLE" wpLELLE ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELLE.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile using Log-Exp shape\n##'\n##' Creates Log-Exp shaped wind profile oblect \\code{wpLEL} based on\n##' input parameter. Uses \\code{wpLELDefault()} with \\code{zjoint=0}\n##' and \\code{z0sol=NA}.\n##' @title Log-Exp wind profile\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param dep zero-plane displacement height. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{dep}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' dep = function(LAI, ...) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the argument\n##' \\code{parametrization} accordingly (in this example\n##' \"Mahat\") to adjust further analysis accordingly!\n##' @param z0 roughness length at canopy level. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{z0}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' z0 = function(LAI, ...) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the\n##' argument \\code{parametrization} accordingly (in this\n##' example \"Mahat\") to adjust further analysis accordingly!\n##' @param na exponential decay coefficient\n##' @param h canopy height h\n##' @param za ???????\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param ... further argumewnts which will be passed to the user\n##' defined function \\code{dep} and \\code{z0}.\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELLE <- function(\n z,\n ua,\n dep,\n z0,\n na,\n h,\n za,\n noU = FALSE,\n check = TRUE\n ){\n zjoint <- 0\n z0sol <- 0.1\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = TRUE\n )\n ##\n result$check <- check\n result$parametrization <- \"LE\"\n return(result)\n}" nil) (7204 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELMahatLE" wpLELMahatLE ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELMahatLE.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape using Mahat parametrisation\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile based on Mahat parametrization\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param na exponential decay coefficient\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param LAI Leaf Area Index to be used for the calculation of \\code{dep}\n##' @param y integer indicating three basic forest profiles\n##' \\itemize{\n##' \\item{y = 1} : {young pine}\n##' \\item{y = 2} : {leafed decideous tree}\n##' \\item{y = 3} : {old pine with long stems and clumping at the top}\n##' }\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELMahatLE <- function(\n z,\n ua,\n na,\n h,\n za,\n z0sol,\n LAI,\n y,\n noU = FALSE,\n check = TRUE\n){ \n depFUN <- function(LAI, h, y) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n dep <- depFUN(LAI, h, y)\n z0FUN <- function(LAI, h, y) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n z0 <- z0FUN(LAI, h, y)\n zjoint <- 0\n z0sol <- 0.1\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = FALSE\n )\n ##\n result$depFUN <- depFUN\n result$z0FUN <- z0FUN\n result$LAI <- as.numeric(LAI)\n result$y <- as.numeric(y)\n result$check <- check\n result$parametrization <- \"mahatLE\"\n ##\n return(result)\n}" nil) (7307 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELCastanea" wpLELCastanea ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELCastanea.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param LAI Leaf Area Index\n##' @param WAI Wood Area Index, default=1.1\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELCastanea <- function(\n z,\n ua,\n zjoint,\n h,\n za,\n z0sol,\n LAI,\n WAI = 1.1,\n noU = FALSE,\n check = TRUE\n){\n depFUN <- function(h) {(2/3) * h}\n dep <- depFUN(h) # Oke 1972\n ##\n z0FUN <- function(h) {0.1 * h}\n z0 <- z0FUN(h) # Granier\n ##\n naFUN <- function(LAI, WAI) {\n na <- 2.6 * (LAI + WAI)^0.36\n if (na > 4) {\n na <- 4\n }\n return(na)\n }\n na <- naFUN(LAI, WAI)\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua, \n dep = na,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h, \n za = za,\n z0sol = z0sol, \n noU = noU,\n check = FALSE\n )\n result$depFUN <- depFUN\n result$z0FUN <- z0FUN\n result$naFUN <- naFUN\n result$LAI <- as.numeric(LAI)\n result$WAI <- as.numeric(WAI)\n result$check <- check\n result$parametrization <- \"castanea\"\n return(result)\n}" nil) (7415 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELOwnFree" wpLELOwnFree ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELOwnFree.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape using ownFree parametrisation\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' dep, z0, na and zoint are parametrized using:\n##'\n##' x = h * ( x.a + ( LAI ^ x.b ) / x.c )\n##'\n##' where x is dep, z0, na and zjoint respectively.\n##' \n##' @title Log-Exp-Log wind profile based on Mahat parametrization\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param h canopy height h\n##' @param za za\n##' @param z0sol roughness length at soil level\n##' @param dep.a see Details\n##' @param dep.b see Details\n##' @param dep.c see Details\n##' @param z0.a see Details\n##' @param z0.b see Details\n##' @param z0.c see Details\n##' @param na.a see Details\n##' @param na.b see Details\n##' @param na.c see Details\n##' @param zjoint.a see Details\n##' @param zjoint.b see Details\n##' @param zjoint.c see Details\n##' @param LAI Leaf Area Index to be used for the calculation of \\code{dep}\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @param na exponential decay coefficient\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELOwnFree <- function(\n z,\n ua,\n\n h,\n za,\n z0sol,\n\n dep.a, dep.b, dep.c,\n z0.a, z0.b, z0.c,\n na.a, na.b, na.c,\n zjoint.a, zjoint.b, zjoint.c,\n\n LAI,\n noU = FALSE,\n check = TRUE\n ){ \n depFUN <- function(LAI, h, dep.a, dep.b, dep.c) { h * ( dep.a + ( LAI ^ dep.b ) / dep.c ) }\n z0FUN <- function(LAI, h, z0.a, z0.b, z0.c) { h * ( z0.a + ( LAI ^ z0.b ) / z0.c ) }\n naFUN <- function(LAI, h, na.a, na.b, na.c) { h * ( na.a + ( LAI ^ na.b ) / na.c ) }\n zjointFUN <- function(LAI, h, zjoint.a, zjoint.b, zjoint.c) { h * (zjoint.a + ( LAI ^ zjoint.b ) / zjoint.c ) }\n ##\n dep <- depFUN(LAI, h, dep.a, dep.b, dep.c)\n z0 <- depFUN(LAI, h, z0.a, z0.b, z0.c)\n na <- depFUN(LAI, h, na.a, na.b, na.c)\n zjoint <- zjointFUN(LAI, h, zjoint.a, zjoint.b, zjoint.c)\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = FALSE\n )\n ##\n result$depFUN <- depFUN\n result$dep.a <- dep.a\n result$dep.b <- dep.b\n result$dep.c <- dep.c\n ##\n result$naFUN <- naFUN\n result$na.a <- na.a\n result$na.b <- na.b\n result$na.c <- na.c\n ##\n result$z0FUN <- z0FUN\n result$z0.a <- z0.a\n result$z0.b <- z0.b\n result$z0.c <- z0.c\n ##\n result$zjointFUN <- zjointFUN\n result$zjoint.a <- zjoint.a\n result$zjoint.b <- zjoint.b\n result$zjoint.c <- zjoint.c\n ##\n result$LAI <- as.numeric(LAI)\n result$check <- check\n result$parametrization <- \"ownFree\"\n ##\n return(result)\n}" nil) (7547 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL.wpLEL" wpLEL\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLEL.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Creates a new \\code{wpLEL} object from a \\code{wpLEL} object\n##'\n##' \n##' Creates an \\code{wpLEL} object from a \\code{wpLEL} object by\n##' calling \\code{wpLELDefault()} with the arguments in \\code{...} given\n##' arguments and the from \\code{x} extracted arguments.\n##' @title Log-Exp-Log wind profile\n##' @param x object of class \\code{wpLEL} to be used as source\n##' for the parameter to create the \\code{wpLEL} object\n##' @param ... \\bold{named} arguments which will be used to create the\n##' new \\code{wpLEL} object using the \\code{wpLELDefault} function.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\nwpLEL.wpLEL <- function(\n x,\n ...\n){\n iff <- function(test, yes, no) {\n if (test) {\n yes\n } else {\n no\n }\n }\n dot <- list(...)\n u <- switch(\n x$parametrization,\n \"default\" = wpLELDefault( \n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n dep = iff(exists(\"dep\", dot), dot[[\"dep\"]], x[[\"depOrg\"]]),\n z0 = iff(exists(\"z0\", dot), dot[[\"z0\"]], x[[\"z0Org\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n zjoint = iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]])\n ),\n \"mahat\" = wpLELMahat(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n zjoint = iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n y = iff(exists(\"y\", dot), dot[[\"y\"]], x[[\"y\"]])\n ),\n \"LE\" = wpLELLE(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n dep = iff(exists(\"dep\", dot), dot[[\"dep\"]], x[[\"depOrg\"]]),\n z0 = iff(exists(\"z0\", dot), dot[[\"z0\"]], x[[\"z0Org\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]])\n ),\n \"mahatLE\" = wpLELMahatLE(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n y = iff(exists(\"y\", dot), dot[[\"y\"]], x[[\"y\"]])\n ),\n \"castanea\" = wpLELCastanea(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n zjoint = iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n WAI = iff(exists(\"WAI\", dot), dot[[\"WAI\"]], x[[\"WAI\"]])\n ),\n \"ownFree\" = wpLELOwnFree(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n \n dep.a = iff(exists(\"dep.a\", dot), dot[[\"dep.a\"]], x[[\"dep.a\"]]),\n dep.b = iff(exists(\"dep.b\", dot), dot[[\"dep.b\"]], x[[\"dep.b\"]]),\n dep.c = iff(exists(\"dep.c\", dot), dot[[\"dep.c\"]], x[[\"dep.c\"]]),\n\n z0.a = iff(exists(\"z0.a\", dot), dot[[\"z0.a\"]], x[[\"z0.a\"]]),\n z0.b = iff(exists(\"z0.b\", dot), dot[[\"z0.b\"]], x[[\"z0.b\"]]),\n z0.c = iff(exists(\"z0.c\", dot), dot[[\"z0.c\"]], x[[\"z0.c\"]]),\n\n na.a = iff(exists(\"na.a\", dot), dot[[\"na.a\"]], x[[\"na.a\"]]),\n na.b = iff(exists(\"na.b\", dot), dot[[\"na.b\"]], x[[\"na.b\"]]),\n na.c = iff(exists(\"na.c\", dot), dot[[\"na.c\"]], x[[\"na.c\"]]),\n\n zjoint.a = iff(exists(\"zjoint.a\", dot), dot[[\"zjoint.a\"]], x[[\"zjoint.a\"]]),\n zjoint.b = iff(exists(\"zjoint.b\", dot), dot[[\"zjoint.b\"]], x[[\"zjoint.b\"]]),\n zjoint.c = iff(exists(\"zjoint.c\", dot), dot[[\"zjoint.c\"]], x[[\"zjoint.c\"]]),\n\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]])\n ),\n stop(\"No valid parametrization\")\n )\n return(u)\n}" nil) (7668 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL.wpLELFit" wpLEL\.wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLEL.wpLELFit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Creates an \\code{wpLEL} object from a \\code{wpLELFit} object\n##'\n##' \n##' Creates an \\code{wpLEL} object from a \\code{wpLELFit} object by\n##' calling \\code{wpLELDefault()} with the extracted\n##' parameter.\n##' @title Log-Exp-Log wind profile\n##' @param x object of class \\code{wpLELFit} to be used as source\n##' for the parameter to ctreate the \\code{wpLEL} object\n##' @param ... additional arguments which are discarded\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\nwpLEL.wpLELFit <- function(\n x,\n ...\n){ \n return(x$wp)\n}" nil) (7695 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.wpLEL" plot\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Plot \\code{wpLEL} object\n##'\n##' Generic function to plot \\code{wpLEL} object\n##' @param x object of class \\code{wpLEL} to be plotted\n##' @param z numeric vector at which the line should be calculated. If\n##' missing, \\code{x$z} will be used. the more points, the smoother\n##' the line.\n##' @param xlab x label\n##' @param ylab y label\n##' @param plotWPValues if \\code{TRUE}, the values and value lines are\n##' plotted\n##' @param plotWPPoints if \\code{TRUE}, the points in \\code{x$u; x$z}\n##' are plotted\n##' @param plotWPLines if \\code{TRUE}, the wind profile line is plotted\n##' @param add if \\code{TRUE}, the plot wil be added to an existing plot\n##' @param ... optional arguments for \\code{plot} method\n##' @return incisible NULL\n##' @author Rainer M. Krug\n##' @export\nplot.wpLEL <- function(\n x,\n z,\n xlab = \"Wind Speed (m/s)\",\n ylab = \"Height above ground (m)\",\n plotWPValues = TRUE,\n plotWPPoints = TRUE,\n plotWPLines = TRUE,\n add = FALSE,\n ...\n) {\n if (missing(z)) {z <- x$z}\n u <- wpLEL(x, z=z)\n ## setup plot if !add\n if (!add) {\n plot(\n x = c(0, max(x$u, u$u)),\n y = c(0, max(x$z, u$z)),\n type= \"n\",\n xlab = xlab,\n ylab = ylab\n )\n }\n ## plot points\n points(\n x = x$u,\n y = x$z,\n type= ifelse(plotWPPoints, \"p\", \"n\"),\n ...\n )\n lines(\n x = u$u.onlyTop,\n y = u$z,\n type = ifelse(plotWPLines, \"l\", \"n\"),\n lty = \"dotted\",\n col = \"blue\"\n )\n lines(\n x = u$u,\n y = u$z,\n type = ifelse(plotWPLines, \"l\", \"n\"),\n lty = \"solid\",\n col = \"black\"\n )\n if (plotWPValues) {\n mx <- par(\"usr\")[2]\n with(\n x,\n {\n arrows(\n x0 = c(0, 0, 0 ,0 ,0),\n y0 = c(z0+dep, za, h, dep, zjoint),\n x1 = c(4, 4, 4 ,4 ,4 ,4),\n y1 = c(z0+dep, za, h, dep, zjoint),\n length = 0,\n col = \"grey\",\n lty = \"dotted\"\n )\n text(mx, z0, paste('z0', round(z0, 2), sep=\" = \" ), pos = 2)\n text(mx, za, paste('za', round(za, 2), sep=\" = \" ), pos = 2)\n text(mx, h, paste('hauteur', round(h, 2), sep=\" = \" ), pos = 2)\n text(mx, dep, paste('dep', round(dep, 2), sep=\" = \" ), pos = 2)\n text(mx, zjoint, paste('zjoint', round(zjoint, 2), sep=\" = \" ), pos = 2)\n }\n )\n }\n invisible(NULL)\n}" nil) (7786 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*print.wpLEL" print\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to print \\code{wpLEL}\n##'\n##' This function prints a \\code{wpLEL} object\n##' @param x object of class \\code{wpLEL} to be printed\n##' @param ... optional arguments for \\code{print} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nprint.wpLEL <- function(\n x,\n ...\n ) {\n print.default(x)\n invisible(x)\n}" nil) (7814 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.default.single" fitOptim\.wpLEL\.default\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.default.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL}} wind profile.\n##' @title fitOptim.wpLEL.default.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.default.single <- function(\n z,\n u,\n LAI,\n initial = c(dep=25, z0=0.8*28, na=9, zjoint=0.2*2),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n ) {\n ## Function to be minimised\n wpLELMin <- function(par, z, u, ua, h, za, z0sol) {\n if (\n isTRUE(\n parameterOK(\n z = z,\n ua = ua,\n dep = par[1], # par$dep,\n z0 = par[2], # par$z0,\n na = par[3], # par$na,\n zjoint = par[4], # par$zjoint\n h = h,\n za = za,\n z0sol = z0sol\n )\n )\n ) {\n p <- wpLELDefault(\n z = z,\n ua = ua,\n dep = par[1], # par$dep,\n z0 = par[2], # par$z0,\n na = par[3], # par$na,\n zjoint = par[4], # par$zjoint\n h = h,\n za = za,\n z0sol = z0sol,\n check = FALSE\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n } else {\n result <- NA\n }\n return( result )\n } \n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.default.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"dep\"],\n initial[\"z0\"],\n initial[\"na\"],\n initial[\"zjoint\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n ...\n )\n result$wp <- wpLELDefault(\n z = z,\n ua = ua,\n dep = result$fit$par[\"dep\"],\n z0 = result$fit$par[\"z0\"],\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (7942 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahat.single" fitOptim\.wpLEL\.mahat\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.mahat.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL.mahat} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL.mahat}} wind profile.\n##' @title fitOptim.wpLEL.mahat.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf area index\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahat.single <- function(\n z,\n u,\n LAI,\n initial = c(na=9, zjoint=0.2*2, y=3),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za, z0sol, LAI) {\n result <- NA\n try({\n p <- wpLELMahat(\n z = z,\n ua = ua,\n na = par[1], # na\n zjoint = par[2], # zjoint\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n y = par[3] # y\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.mahat.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"na\"],\n initial[\"zjoint\"],\n initial[\"y\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n ...\n )\n result$wp <- wpLELMahat(\n z = z,\n ua = ua,\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n y = result$fit$par[\"y\"]\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8053 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.LE.single" fitOptim\.wpLEL\.LE\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.LE.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values (\\code{u} and \\code{z}) to a \\code{link{wpLEL}} wind profile.\n##' @title fitOptim.wpLEL.LE.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.LE.single <- function(\n z,\n u,\n LAI,\n initial = c(dep=25, z0=0.8*28, na=9),\n h = 28,\n za = 37,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za) {\n result <- NA\n try({\n p <- wpLELLE(\n z = z,\n ua = ua,\n dep = par[1], # par$dep,\n z0 = par[2], # par$z0,\n na = par[3], # par$na,\n h = h,\n za = za\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.LE.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"dep\"],\n initial[\"z0\"],\n initial[\"na\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n## z0sol = z0sol,\n ...\n )\n result$wp <- wpLELLE(\n z = z,\n ua = ua,\n dep = result$fit$par[\"dep\"],\n z0 = result$fit$par[\"z0\"],\n na = result$fit$par[\"na\"],\n h = h,\n za = za\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8157 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahatLE.single" fitOptim\.wpLEL\.mahatLE\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.mahatLE.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL.mahatLE} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL.mahatLE}} wind profile.\n##' @title fitOptim.wpLEL.mahatLE.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahatLE.single <- function(\n z,\n u,\n LAI,\n initial = c(na=9, y=3),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za, z0sol, LAI) {\n result <- NA\n try({\n p <- wpLELMahatLE(\n z = z,\n ua = ua,\n na = par[1], # na\n h = h,\n za = za,\n LAI = LAI,\n y = par[2] # y\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.mahatLE.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"na\"],\n initial[\"y\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n ...\n )\n result$wp <- wpLELMahatLE(\n z = z,\n ua = ua,\n na = result$fit$par[\"na\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n y = result$fit$par[\"y\"]\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8264 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.castanea.single" fitOptim\.wpLEL\.castanea\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.castanea.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL}} wind profile.\n##' @title fitOptim.wpLEL.castanea.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.castanea.single <- function(\n z,\n u,\n LAI,\n initial = c(zjoint=0.2*2),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za, z0sol, LAI) {\n result <- NA\n try({\n p <- wpLELCastanea(\n z = z,\n ua = ua,\n zjoint = par[1], # par$zjoint\n h = h,\n za = za,\n z0sol = z0sol,\n LAI=LAI\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.castanea.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"zjoint\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n ...\n )\n result$wp <- wpLELCastanea(\n z = z,\n ua = ua,\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8370 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.default.multiple" fitOptim\.wpLEL\.default\.multiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.default.multiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param wso Wind speed profiles in the format as read from \\code{loadWS(wide=TRUE, ...)}\n##' @param initial initial\n##' @param h h\n##' @param za za\n##' @param z0sol z0sol \n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' @param ... additional arguments to be passed on to \\code{optim()}\n##' @return an oject of class \\code{wpFit} containing the result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.default.multiple <- function(\n wso,\n initial = c(dep=25, z0=0.8*28, na=9, zjoint=0.2*2),\n h = 28,\n za = 37,\n z0sol = 0.001,\n silentError = TRUE,\n ...\n ) {\n\n ## Function to be minimised\n minFUN <- function(\n par,\n ## ## passed in par:\n ## dep\n ## z0\n ## na\n ## zjoint\n ## ## passed in the other arguments:\n z,\n h, za, z0sol,\n ## the data to be fitted to\n wsFit\n ) {\n mse <- sapply(\n wsFit,\n function(u) {\n p <- NULL\n try( {\n p <- wpLELDefault(\n z = z,\n ua = u[length(u)],\n ##\n h = h,\n za = za,\n z0sol = z0sol,\n ## \n dep = par[1],\n z0 = par[2],\n na = par[3],\n zjoint = par[4]\n )\n },\n silent = silentError\n )\n if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)])^2 ) / length(p$u) ) \n } else {\n result <- NA\n }\n return( result )\n }\n )\n mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n mse <- sum( ( mse^2 ) / length(mse), na.rm=TRUE )\n } else {\n mse <- NA\n }\n return(mse)\n }\n \n ## construct result list\n result <- list()\n result$method <- \"fitOptim.wpLEL.default.multiple\"\n result$initial <- initial\n result$dot <- list(...)\n ## result$z <- z\n ## result$u <- u\n ## Do the optimisation\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n result$fit <- optim(\n par = initial,\n fn = minFUN,\n ##\n z = z,\n h = h,\n za = za,\n z0sol = z0sol,\n ##\n wsFit = wso,\n ...\n )\n ## calculate sample wind profile\n if ( (length(z) > 0) & (is.numeric(z)) ) {\n z <- seq(0.1, max(z), 0.1)\n } else {\n z <- seq(0.1, 37, 0.1)\n }\n result$wp <- wpLELDefault(\n z = z,\n ua = mean(wso[2,][[1]]),\n dep = result$fit$par[\"dep\"],\n z0 = result$fit$par[\"z0\"],\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol\n )\n ##\n \n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8502 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahat.multiple" fitOptim\.wpLEL\.mahat\.multiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.mahat.multiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param wso Wind speed profiles in the format as read from \\code{loadWS(wide=TRUE, ...)}\n##' @param initial initial parameter values for fit \n##' @param h height\n##' @param za za\n##' @param z0sol z0sol\n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' @param ... additional values to be passed on to \\code{optim}\n##' @return an object of class \\code{wpFit} containing the result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahat.multiple <- function(\n wso,\n initial = c(na=9, zjoint=0.2*2, y=3),\n h = 28,\n za = 37,\n z0sol = 0.001,\n silentError = TRUE,\n ...\n ) {\n \n ## Function to be minimised\n minFUN <- function(\n par,\n ## ## passed in par:\n ## na\n ## zjoint\n ## y\n ## ## passed in the other arguments:\n z,\n h, za, z0sol,\n ## the data to be fitted to\n wsFit\n ) {\n mse <- sapply(\n wsFit,\n function(u) {\n p <- NULL\n try( {\n p <- wpLELMahat(\n z = z,\n ua = u[length(u)],\n na = par[1],\n zjoint = par[2],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = u[[1]],\n y = par[3]\n )\n },\n silent = silentError\n )\n if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)])^2 ) / length(p$u) ) \n } else {\n result <- NA\n }\n return( result )\n }\n )\n mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n mse <- sum( ( mse^2 ) / length(mse), na.rm=TRUE )\n } else {\n mse <- NA\n }\n return(mse)\n }\n \n ## construct result list\n result <- list()\n result$method <- \"fitOptim.wpLEL.mahat.multiple\"\n result$initial <- initial\n result$dot <- list(...)\n ## result$z <- z\n ## result$u <- u\n ## Do the optimisation\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n result$fit <- optim(\n par = initial,\n fn = minFUN,\n ##\n z = z,\n h = h,\n za = za,\n z0sol = z0sol,\n ##\n wsFit = wso,\n ...\n )\n ## calculate sample wind profile\n if ( (length(z) > 0) & (is.numeric(z)) ) {\n z <- seq(0.1, max(z), 0.1)\n } else {\n z <- seq(0.1, 37, 0.1)\n }\n result$wp <- wpLELMahat(\n z = z,\n ua = mean(as.numeric(wso[2,])),\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = mean(as.numeric(wso[1,])),\n y = result$fit$par[\"y\"]\n )\n ##\n \n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8634 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.ownFree.multiple" fitOptim\.wpLEL\.ownFree\.multiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.ownFree.multiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param wso Wind speed profiles in the format as read from \\code{loadWS(wide=TRUE, ...)}\n##' @param initial initial parameter values for \\code{optim()}\n##' @param z0 z0\n##' @param na na\n##' @param zjoint zjoint \n##' @param h h\n##' @param za za\n##' @param z0sol z0sol\n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' @param ... additional argumaents to be passed to \\code{optim}\n##' @return an oject of class \\code{wpFit} containing the result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.ownFree.multiple <- function(\n wso,\n initial = unlist(\n list(\n dep = c(a=0.5, b=0.02, c=-2),\n z0 = c(a=0.23, b=0.25, c=10),\n na = c(a=0.23, b=0.25, c=10),\n zjoint = c(a=0.23, b=0.25, c=10)\n )\n ),\n h = 28,\n za = 37,\n z0sol = 0.001,\n silentError = TRUE,\n ...\n ) {\n\n ## Function to be minimised\n minFUN <- function(\n par,\n ## ## passed in par:\n ## dep.a, dep.b, dep.c,\n ## z0.a, z0.b, z0.c,\n ## na.a, na.b, na.c,\n ## zjoint.a, zjoint.b, zjoint.c,\n ## ## passed in the other arguments:\n z,\n h, za, z0sol,\n ## the data to be fitted to\n wsFit\n ) {\n mse <- sapply(\n wsFit,\n function(u) {\n p <- NULL\n try( {\n p <- wpLELOwnFree(\n z = z,\n ua = u[length(u)],\n ##\n h = h,\n za = za,\n z0sol = z0sol,\n ## .a .b .c\n dep.a = par[ 1], dep.b = par[ 2], dep.c = par[ 3],\n z0.a = par[ 4], z0.b = par[ 5], z0.c = par[ 6],\n na.a = par[ 7], na.b = par[ 8], na.c = par[ 9],\n zjoint.a = par[10], zjoint.b = par[11], zjoint.c = par[12],\n LAI = u[[1]]\n )\n },\n silent = silentError\n )\n if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)])^2 ) / length(p$u) ) \n } else {\n result <- NA\n }\n return( result )\n }\n )\n ## maxMse <- quantile(mse, probs=c(0, (1 - exclHighMseProp), 0.5, 1))\n ## mse <- mse[mse <= maxMse[2]]\n mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n mse <- sum( ( mse^2 ) / length(mse), na.rm=TRUE )\n } else {\n mse <- NA\n }\n ## print(mse)\n return(mse)\n }\n \n ## construct result list\n result <- list()\n result$method <- \"fitOptim.wpLEL.ownFree.multiple\"\n result$initial <- initial\n result$dot <- list(...)\n result$wpLELParameter <- list(\n h = h,\n za = za,\n z0sol = z0sol\n )\n ## result$z <- z\n ## result$u <- u\n ## Do the optimisation\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n result$fit <- optim(\n par = initial,\n fn = minFUN,\n ##\n z = z,\n h = h,\n za = za,\n z0sol = z0sol,\n ##\n wsFit = wso,\n ...\n )\n ## calculate sample wind profile\n if ( (length(z) > 0) & (is.numeric(z)) ) {\n z <- seq(0.1, max(z), 0.1)\n } else {\n z <- seq(0.1, 37, 0.1)\n }\n \n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8772 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Goodness%20of%20fit%20for%20wpLELFit" Goodness\ of\ fit\ for\ wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/gof.wpLELfit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Calculate goodnes of fit of fit compared to object of class \\code{wpLELFit}\n##'\n##' Uses gofFun to calculate the goodnes of fit between \\code{fit} and\n##' the observed wind profile \\code{wp}\n##' \n##' @title gof.wpLELfit\n##' @param fit fit of the wind profile of the type \\code{wpLELFit}\n##' @param wp wind profile as returned in the wide format of \\code{loadWS}\n##' @param gofFun function returning the goodnes of fit.\n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' This function accepts the two argumentsa \\code{obs, exp}.\n##' These can be assumed of being of the same length. An example is the =default function:\n##' \n##' \\code{ function(obs, exp){ sum( ( (exp - obs)^2 ) / length(obs) ) } }\n##' \n##' @return vector of the goodnes of fit values, one per row in \\code{wp}\n##' @author Rainer M. Krug\n##' @export\ngof.wpLELFit <- function(\n fit,\n wp,\n gofFun = function(obs, exp){ sum( ( (exp - obs)^2 ) / length(obs), na.rm=TRUE ) },\n silentError = TRUE\n ) {\n gofs <- sapply(\n 1:nrow(wp),\n function(i) {\n o <- dfFromLong(wp[i,])\n names(o)[ncol(o)] <- \"ws\"\n gof <- NA\n try( {\n e <- wpLEL(\n fit$wp,\n z = o$z,\n ua = wp[i, \"ua\"],\n LAI = wp[i,\"lai\"]\n )\n gof <- gofFun(\n obs = o$ws,\n exp = e$u\n )\n gof\n },\n silent = silentError\n )\n return(gof)\n\n }\n )\n}" nil) (8832 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.wpLELFit" plot\.wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to plot \\code{wpLELFit}\n##'\n##' This function a \\code{wpLELFit} object by plotting the fitted line\n##' smoothly and adding the original points to the graph.\n##' @param x object of class \\code{wpLELFit} to be plotted \n##' @param z numeric vector at which the line should be calculated. If\n##' missing, \\code{x$z} will be used. the more points, the smoother\n##' the line.\n##' @param plotWPValues if \\code{TRUE}, the values and value lines are\n##' drawn\n##' @param plotWPLines if \\code{TRUE}, the lines of the profile are drawn\n##' @param plotOrgPoints if \\code{TRUE}, the original points are drawn\n##' @param add if \\code{TRUE}, the plot wil be added to an existing plot\n##' @param ... additional arguments for plotting the \\bold{original} points of the fit using the \\code{poiunts} function\n##' are plotted\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nplot.wpLELFit <- function(\n x,\n z,\n plotWPValues = TRUE,\n plotWPLines = TRUE,\n plotOrgPoints = TRUE,\n add = FALSE,\n ...\n ) {\n xu <- x$wp\n ## plot values (dep, ...)\n plot.wpLEL(\n xu,\n z,\n plotWPValues = plotWPValues,\n plotWPPoints = FALSE,\n plotWPLines = FALSE,\n add = add\n )\n ## plot fitted lines \n plot.wpLEL(\n xu,\n z,\n plotWPValues = FALSE,\n plotWPPoints = FALSE,\n plotWPLines = plotWPLines,\n add = TRUE\n )\n ## plot original points \n points(\n x$u,\n x$z,\n type = ifelse(plotOrgPoints, \"p\", \"n\"),\n ...\n )\n}" nil) (8890 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*print.wpLELFit" print\.wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLELFit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to print \\code{wpLELFit}\n##'\n##' This function prints a \\code{wpLELFit} object\n##' @param x object of class \\code{wpLELFit} to be printed\n##' @param ... optional arguments for \\code{print} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nprint.wpLELFit <- function(\n x,\n ...\n ) {\n print.default(x)\n invisible(x)\n}" nil) (8920 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpFitEach" wpFitEach ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpFitEach.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title wpLELFitEach\n##' @param new if \\code{TRUE} the cache is re-created - if\n##' \\code{FALSE} the results are read from the cache.\n##' @param suffix suffix for cache\n##' @param FUN name of the function to be used for fitting. It has to\n##' take the arguments \\code{z} and \\code{u}, but can also take\n##' additional arguments.\n##' @param cores number of cores to be used for analysis - defaults to the number of cores mius one, but is at least 1.\n##' @param minSpeedIncreaseWide minimum wind speed difference - see \\link{loadWS} for details\n##' @param maxWindSpeedWide maximum wind speed - see \\link{loadWS} for details\n##' @param maxWindSpeedOneWide standardise highest sampled wind speed to one - see \\link{loadWS} for details\n##' @param WAI Wood Area Index, argument \\code{WAI} of function\n##' \\code{loadWS()}. Will be added to lai from raw data.\n##' @param selectWPFit a function returning \\bold{a vector} where each\n##' element represents the indices of loaded wind profiles which will\n##' be used for fitting the parameter. The function takes one value,\n##' i.e. \\code{wso} which is the \\code{data.frame} of the loaded wind\n##' profiles, as returned by the function\n##'\n##' code{\n##' wso <- loadWS(\n##' wide = TRUE,\n##' onlyComplete = TRUE,\n##' minSpeedIncreaseWide,\n##' maxWindSpeedWide,\n##' maxWindSpeedOneWide,\n##' WAI = WAI\n##' )\n##' }\n##'\n##' Examples are:\n##'\n##' \\code{selectWPFit = function(wso){TRUE}}\n##'\n##' which would select all elements in \\code{wso}.This is the default.\n##' \n##' \\code{selectWPFit = function(wso){sample(1:nrow(wso), 100)}}\n##' \n##' which would create vector of 100 randomly selected wind profiles\n##' \\bold{selected} for fitting or\n##'\n##' \\code{selectWPFit = function(wso){-sample(1:nrow(wso), 500)}}\n##'\n##' which would create vector of 500 randomly selected wind profiles\n##' \\bold{excluded} from fitting\n##'\n##' @param ... additional arguments passed to FUN\n##' @return an oject of class \\code{wpLELFitList} (i.e. \\code{list}) of\n##' the length of the number wind profiles to fit. Each element\n##' contains the result of an individual fit.\n##' @author Rainer M. Krug\n##' @export\nwpFitEach <- function(\n new = FALSE,\n suffix = \"\",\n FUN = \"wpLEFitSingle\",\n cores = detectCores() - 1,\n minSpeedIncreaseWide = 0,\n maxWindSpeedWide = 10,\n maxWindSpeedOneWide = FALSE,\n WAI = 0,\n selectWPFit = function(wso) { TRUE },\n ...\n ) {\n if (cores==0) {\n cores <- 1\n }\n fn <- paste0(CACHE, \"/wpFitEach.\", FUN, suffix, \".rds\")\n FUN <- get(FUN)\n if (new) {\n unlink(fn)\n }\n if (file.exists(fn)) {\n dat <- readRDS(fn)\n } else {\n ## Load wind priofile data\n wso <- loadWS(\n wide = TRUE,\n onlyComplete = TRUE,\n minSpeedIncreaseWide,\n maxWindSpeedWide,\n maxWindSpeedOneWide,\n WAI = WAI\n )\n \n ## #################################\n ## From now on, LAI (later u[[1]]) is LAI = LAI + WAI)\n ## #################################\n\n ## Get indices for fitting. Must only be done once as the\n ## functions might contain random number generation!\n indFit <- selectWPFit(wso)\n\n ## Save \"metadata\"\n ## construct result list\n md <- list()\n md$method <- \"wpFitEach\"\n md$FUN <- FUN\n md$loadWSParm <- list(\n minSpeedIncreaseWide = minSpeedIncreaseWide,\n maxWindSpeedWide = maxWindSpeedWide,\n maxWindSpeedOneWide = maxWindSpeedOneWide,\n WAI = WAI\n )\n md$selectWPFit <- list(\n fun = selectWPFit,\n indices = indFit\n )\n md$dot <- list(...)\n saveRDS(md, paste0(fn, \".metadata.rds\"))\n \n z <- dfFromLong(wso[1,])$z \n ws <- wso[,grep(\"^h[[:digit:]]\", names(wso))]\n ws <- cbind(ua=wso$ua, ws)\n ws <- cbind(lai=wso$lai, ws)\n ws <- as.data.frame(t(ws))\n \n ##\n i <- 0\n no <- ceiling(ncol(ws) / cores)\n dat <- mclapply(\n ws[,indFit],\n function(u) {\n f <- FUN(\n z = z,\n u = u[-(1:2)],\n LAI = u[1],\n ...\n )\n if (!is.null(f)) {\n f$lai <- u[1]\n f$ua <- u[2]\n }\n i <<- i + 1\n if (round(i, -2)==i){\n cat(i, \"\\tof about\\t\", no, \"\\r\")\n }\n return(f)\n },\n mc.cores = cores\n )\n class(dat) <- c(\"wpLELFitList\", class(dat))\n saveRDS(dat, fn)\n }\n if (!(\"wpLELFitList\" %in% class(dat))) {\n class(dat) <- c(\"wpLELFitList\", class(dat))\n }\n return(dat)\n}" nil) (9085 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpFitMultiple" wpFitMultiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpFitMultiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title wpLELFitEach\n##' @param new if \\code{TRUE} the cache is re-created - if\n##' \\code{FALSE} the results are read from the cache.\n##' @param suffix suffix for cache\n##' @param FUN Name of function to be used for fitting TODO\n##' @param cores number of cores to be used for analysis - defaults to the number of cores mius one, but is at least 1.\n##' @param minSpeedIncreaseWide minimum wind speed difference - see \\link{loadWS} for details\n##' @param maxWindSpeedWide maximum wind speed - see \\link{loadWS} for details\n##' @param maxWindSpeedOneWide standardise highest sampled wind speed to one - see \\link{loadWS} for details\n##' @param WAI Wood Area Index, argument \\code{WAI} of function\n##' \\code{loadWS()}. Will be added to lai from raw data.\n##' @param minUstar minimum value of ustar for wind profiles to be\n##' included. Values smaller than 0 will include all wind profiles.\n##' @param selectWPFit a function returning \\bold{a list} where each\n##' element of the list represents the indices of loaded wind profiles\n##' which will be used for fitting the parameter. The function takes\n##' one value, i.e. \\code{wso} which is the \\code{data.frame} of the\n##' loaded wind profiles, as returned by the function\n##'\n##' code{\n##' wso <- loadWS(\n##' wide = TRUE,\n##' onlyComplete = TRUE,\n##' minSpeedIncreaseWide,\n##' maxWindSpeedWide,\n##' maxWindSpeedOneWide,\n##' WAI = WAI\n##' )\n##' }\n##'\n##' An exapmle is\n##'\n##' \\code{selectWPFit = function(wso){lapply(1:5, function(x){sample(1:nrow(wso), 100)})}}\n##' \n##' which would create a list of 5 elements where each consists of 100\n##' randomly selected wind profiles \\bold{selected} for fitting or\n##'\n##' \\code{selectWPFit = function(wso){lapply(1:10, function(x){-sample(1:nrow(wso), 500)})}}\n##'\n##' which would create a list of 10 elements where each consists of 500\n##' randomly selected wind profiles \\bold{excluded} from fitting\n##'\n##' @param ... additional parameter passed to FUN ( mainly for the function \\code{optim()} )\n##' @return an oject of class \\code{wpLELFitList} (i.e. \\code{list}) of\n##' the length of the number wind profiles to fit. Each element\n##' contains the result of an individual fit.\n##' @author Rainer M. Krug\n##' @export\nwpFitMultiple <- function(\n new = FALSE,\n suffix = \"\",\n FUN = \"fitOptim.wpLEL.ownFree.multiple\",\n cores = detectCores() - 1,\n minSpeedIncreaseWide = 0,\n maxWindSpeedWide = 10,\n maxWindSpeedOneWide = FALSE,\n minUstar = 0.25,\n WAI = 0,\n selectWPFit = function(wso) { lapply(1:5, function(x){sample(1:nrow(wso), 100)}) },\n ...\n ) {\n if (cores==0) {\n cores <- 1\n }\n fn <- paste0(CACHE, \"/wpFitMultiple.\", FUN, suffix, \".rds\")\n FUN <- get(FUN)\n if (new) {\n unlink(fn)\n }\n if (file.exists(fn)) {\n dat <- readRDS(fn)\n } else {\n\n ## Load Wind Profiles\n wso <- loadWS(\n wide = TRUE,\n onlyComplete = TRUE,\n minSpeedIncreaseWide = minSpeedIncreaseWide,\n maxWindSpeedWide = maxWindSpeedWide,\n maxWindSpeedOneWide = maxWindSpeedOneWide,\n minUstar = minUstar,\n WAI = WAI\n )\n \n ## #################################\n ## From now on, LAI (later u[[1]]) is LAI = LAI + WAI)\n ## #################################\n\n ## Get indices for fitting. Must only be done once as the\n ## functions might contain random number generation!\n indFit <- selectWPFit(wso)\n\n ## Save \"metadata\"\n ## construct result list\n md <- list()\n md$method <- \"wpFitMultiple\"\n md$FUN <- FUN\n md$loadWSParm <- list(\n minSpeedIncreaseWide = minSpeedIncreaseWide,\n maxWindSpeedWide = maxWindSpeedWide,\n maxWindSpeedOneWide = maxWindSpeedOneWide,\n minUstar = minUstar,\n WAI = WAI\n )\n md$selectWPFit <- list(\n fun = selectWPFit,\n indices = indFit\n )\n md$dot <- list(...)\n saveRDS(md, paste0(fn, \".metadata.rds\"))\n \n ## Format the data\n z <- dfFromLong(wso[1,])$z \n ws <- wso[,grep(\"^h[[:digit:]]\", names(wso))]\n ws <- cbind(ua=wso$ua, ws)\n ws <- cbind(lai=wso$lai, ws)\n ws <- as.data.frame(t(ws))\n\n ## Do the fitting\n i <- 0\n no <- ceiling(ncol(ws) / cores)\n dat <- mclapply(\n indFit,\n function(s) {\n f <- FUN(\n wso = ws[,s],\n ...\n )\n i <<- i + 1\n if (round(i, -2)==i){\n cat(i, \"\\tof about\\t\", no, \"\\r\")\n }\n return(f)\n },\n mc.cores = cores\n )\n class(dat) <- c(\"wpLELFitList\", class(dat))\n saveRDS(dat, fn)\n }\n if (!(\"wpLELFitList\" %in% class(dat))) {\n class(dat) <- c(\"wpLELFitList\", class(dat))\n }\n return(dat)\n}" nil) (9242 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.wpLELFitList" plot\.wpLELFitList:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFitList.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to plot \\code{wpLELFitList}\n##'\n##' This function plots an \\code{wpLELFitList} object by plotting the\n##' lines of each fit on each other. The indices can be specified by\n##' using y.\n##' @param x object of class \\code{wpLELFitList} to be plotted \n##' @param y default \\code{NULL}; numeric vector of indices specifying\n##' the fits in \\code{x} to be plotted. If \\code{NULL} all will be plotted.\n##' @param ... optional arguments for \\code{plot} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nplot.wpLELFitList <- function(\n x,\n y = NULL,\n ...\n ) {\n if (is.null(y)) {\n y <- 1:length(x)\n }\n plot(\n x[[1]],\n add = FALSE,\n ...\n )\n ##\n for (i in y[-1]) {\n plot(\n x[[i]],\n add = TRUE,\n ...\n )\n }\n invisible()\n}" nil) (9283 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*print.wpLELFitList" print\.wpLELFitList:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLELFitList.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to print \\code{wpLELFitList}\n##'\n##' This function prints a \\code{wpLELFitList} object\n##' @param x object of class \\code{wpLELFitList} to be printed\n##' @param ... optional arguments for \\code{print} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nprint.wpLELFitList <- function(\n x,\n ...\n) {\n cat( \"Number of fits: \" )\n cat(length(x), \"\\n\")\n invisible(x)\n}" nil) (9311 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*airRest%20Generic%20function%20definition" airRest\ Generic\ function\ definition:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/airRest.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "airRest <- function(x, zsource) UseMethod(\"airRest\")" nil) (9318 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*airRest.wpLEL" airRest\.wpLEL ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/airRest.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function for \\code{airRest} to calculate aerial resistance\n##'\n##' Calculate aerial resistance based on \\code{wpLEL} object\n##' @param x object of class \\code{wpLEL}\n##' @param zsource if \\code{NULL} (default), \\code{zsource = z0 + dep}, unless the numerical value\n##' @return object of class \\code{airRest}.\n##' This object contains the following elements:\n##' \\itemize{\n##' \\item{method} : {the method used to generate the aerial profile (the name of this function)}\n##' \\item{wp} : {the wind profile on which the aerial resistance is based}\n##' \\item{I1} : {aerial resistance top log profile}\n##' \\item{I2} : {aerial resistance from h to zsource}\n##' \\item{I3} : {aerial resistance for exp profile}\n##' \\item{I4} : {aerial resistance lower exp profile}\n##' \\item{ras} : {aerial resistance from z0sol to top}\n##' \\item{rac} : {aerial resistance from zsource to za}\n##' }\n##' @author Rainer M. Krug\n##' @export\nairRest.wpLEL <- function(\n x,\n zsource = NULL\n) {\n ## resistance top log profile\n ## LEL - from za (very top) to dep (above canopy, log profile)\n ## LE - from za (very top) to dep (above canopy, log profile)\n I1 <- 1 / (x$vk*x$ustar) * log( (x$za-x$dep)/(x$h-x$dep) )\n\n ## resistance for exp profile\n ## LEL - from dep to zjoint (into canopy, exp profile)\n ## LE - from dep to z0sol (into canopy, exp profile)\n if (x$zjoint == 0) {\n ## log-exp profile\n I3 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp( x$na * (1 - x$z0sol/x$h) ) - 1 )\n } else {\n ## log-exp-log profile\n I3 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp( x$na * (1 - x$zjoint/x$h) ) - 1 )\n }\n\n ## resistance lower exp profile\n ## LEL - from zjoint to z0sol\n ## LE - 0\n if (x$zjoint == 0) {\n ## log-exp profile\n I4 <- 0\n } else {\n ## log-exp-log profile\n I4 <- 1 / (x$vk*x$ustarsol) * log( x$zjoint/x$z0sol )\n }\n ##\n\n ## resistance from z0sol to za\n ras = I1 + I3 + I4\n\n\n ## resistance from h to zsource (into canopy, exp profile or exp-log profile depending if zsource > zjoint or not)\n ## LEL (zsource > zjoint) - exp profile\n ## LEL (zsource < zjoint) - exp & log profile\n ## LE - exp profile\n if (is.null(zsource)) {\n zsource <- x$z0 + x$dep \n }\n if (x$zjoint==0) {\n ## log-exp profile\n I2 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp(x$na*(1 - zsource/x$h)) - 1 )\n } else {\n ## log-exp-log profile\n if (zsource < x$zjoint) {# never happen\n I2_1 <- ( 1/(x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp(x$na*(1 - x$zjoint/x$h)) - 1 )\n I2_2 <- ( 1/(x$vk*x$ustarsol) ) * ( log(x$zjoint/zsource) )\n I2 <- I2_1 + I2_2\n } else {\n I2 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp(x$na*(1- (zsource)/x$h)) - 1 )\n }\n }\n ##\n ## resistance from zsource to za\n rac <- I1 + I2\n\n ar <- list()\n ar$method <- \"airRest.wpLEL\"\n ar$wp <- x\n ar$I1 <- I1\n ar$I2 <- I2\n ar$I3 <- I3\n ar$I4 <- I4\n ar$ras <- ras\n ar$rac <- rac\n class(ar) <- \"airRest\"\n return(ar)\n}" nil) (9414 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.arLEL" plot\.arLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.arLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "plot.arLEL <- function(\n x,\n plotWPPoints = TRUE,\n plotWPValues = TRUE,\n plotARValues = TRUE,\n ...\n) {\n plot.wpLEL(\n x,\n plotWPPoints = plotWPPoints,\n plotWPValues = plotWPValues,\n ...\n )\n if (plotARValues) {\n mx <- par(\"usr\")[2]\n with(\n x,\n {\n ## arrows(\n ## x0 = c(0, 0, 0 ,0 ,0 ,0),\n ## y0 = c(z0+dep, za, h, hsource, dep, zjoint),\n ## x1 = c(4, 4, 4 ,4 ,4 ,4),\n ## y1 = c(z0+dep, za, h, hsource, dep, zjoint),\n ## length = 0,\n ## col = \"grey\",\n ## lty = \"dotted\"\n ## )\n \n \n text(mx*0.4, (za+h)/2., paste(\"R1=\", round(R1, 2) ) )\n text(mx*0.65, (z0h+dep+h)/2., paste(\"R2z0h=\", round(R2z0h, 2), \"R2z0=\", round(R2z0, 2) ) )\n text(mx*0.6, (z0+h)/2., paste(\"R3=\", round(R3, 2) ) )\n text(mx*0.6, (2*z0+h)/3., paste(\"R4log=\", round(R4log, 2), \"R4exp=\", round(R4exp, 2) ) )\n text(mx*0.5, 2, paste(\"racz0h=\", round(racz0h, 2), \"racz0=\", round(racz0, 2) ) )\n text(mx*0.5, 1, paste(\"raslog=\", round(raslog, 2), \"rasexp=\", round(rasexp, 2) ) )\n }\n )\n }\n invisible(NULL)\n}" nil) (9464 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans%20Generic%20function%20definition" evapoTrans\ Generic\ function\ definition:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans <- function(x) UseMethod(\"evapoTrans\")" nil) (9471 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.default" evapoTrans\.default:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.default.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans.default <- function(\n ras,\n rac,\n Ta = 20,\n frach = 1,\n Rnhsol = 600,\n RH = 50, # deltae = 5,\n gsol = 0.001\n) {\n ## mb (Monteith, 1990)\n es <- 6.1078 * exp( 17.269 * Ta/(Ta+ 237.3) ) # mb\n ea <- es * RH/100\n deltae <- es - ea\n Landah <- -2.37273 * Ta + 2501 # J.g-1\n Cph <- 1.01 # J.g-1.degreeC-1\n Rauh <- -4.111 * Ta + 1289.764 # g/m3\n Psyh <- Rauh * Cph * 8.31 * (Ta + 273.15) / (100*18*Landah) # mb.degreeC-1\n deltah <- Landah * 18 * es / ( 8.31 * (Ta + 273.15)^2 ) # mb.degreetC-1 Monteith p.10\n \n ## ETR du sol\n ETRhrsol <- frach * 3.6 *\n (deltah * Rnhsol) /\n (Landah * (deltah + Psyh * (1 + 1/(gsol * ras) )))\n ETRhcsol <- frach * 3.6 *\n (Rauh * Cph * deltae/ras) /\n (Landah * (deltah + Psyh * (1 + 1/(gsol * ras) )))\n ETRhsol <- ETRhrsol+ETRhcsol\n\n ## ETP couvert\n ETPch <- frach * 3.6 *\n (Rauh * Cph * deltae / rac) /\n ( Landah * (deltah + Psyh) )\n etp <- list(\n etrHrsol = ETRhrsol,\n etrHcsol = ETRhcsol,\n etrHsol = ETRhsol,\n etpCh = ETPch\n )\n etp$input <- list(\n ras = ras,\n rac = rac,\n Ta = Ta,\n frach = frach,\n Rnhsol = Rnhsol,\n RH = RH,\n gsol = gsol\n )\n class(etp) <- c(\"evapoTrans\", \"list\")\n attr(etp, \"method\") <- \"default\"\n return( etp )\n}" nil) (9530 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.airRest" evapoTrans\.airRest:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.airRest.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans.airRest <- function(\n x,\n Ta = 20,\n frach = 1,\n Rnhsol = 600,\n RH = 50, # deltae = 5,\n gsol = 0.001\n) {\n etp <- evapoTrans.default(\n ras = x$ras,\n rac = x$rac,\n Ta = Ta,\n frach = frach,\n Rnhsol = Rnhsol,\n RH = RH,\n gsol = gsol\n )\n etp$input$airRest <- x\n attr(etp, \"method\") <- \"airRest\"\n return( etp )\n}" nil) (9559 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.wpLEL" evapoTrans\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans.wpLEL <- function(\n x,\n Ta = 20,\n frach = 1,\n Rnhsol = 600,\n RH = 50, # deltae = 5,\n gsol = 0.001\n) {\n etp <- evapoTrans.airRest(\n x = airRest(x),\n Ta = Ta,\n frach = frach,\n Rnhsol = Rnhsol,\n RH = RH,\n gsol = gsol\n )\n attr(etp, \"method\") <- \"wpLEL\"\n return( etp )\n}" nil) (9588 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*lhc.etp.R" lhc\.etp ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/lhc.etp.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL} and calculates the aeril resistance.\n##'\n##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL}. The object \\code{x} is used at a template to fill in\n##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL} and calculates the aeril resistance.\n##'\n##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL}. The object \\code{x} is used at a template to fill in\n##' the missing values.\n##' @title lhc.wpLEL\n##' @param x object of type \\code{wpLEL} which will be used as a\n##' template for the returned Latin Hyper Cube \n##' @param n size of Latin Hypercube sample\n##' @param Min list of named named elements for minimum value of each column in the\n##' Latin Hypercube. \\code{names(Min)} has to be the same as \\code{names(Max)}!\n##' @param Max list of named named elements for maximum values for each column in the\n##' Latin Hypercube. \\code{names(Min)} has to be the same as \\code{names(Max)}!\n##' @param suffix suffix for file in cache\n##' @param new if \\code{TRUE} the cache is recreated, if \\code{FALSE}, the\n##' default, the cached values will be read\n##' @param cores number of cores to be used for the evaluation\n##' @return returns Latin Hypercube \\code{data.frame}\n##' @author Rainer M. Krug\n##' @export\nlhc.etp <- function(\n x,\n n,\n Min,\n Max,\n suffix,\n new = FALSE,\n cores = parallel::detectCores() - 1\n) {\n if (missing(suffix)) {\n suffix <- paste0(\".\", paste(names(Min), sep = \"\", collapse=\"-\"))\n } else {\n suffix <- paste0(\".\", paste(names(Min), sep = \"\", collapse=\"-\"), suffix)\n }\n fn <- paste0(CACHE, \"/lhc.etp.\", x$parametrization, suffix, \".rds\")\n if (new) {\n unlink(fn)\n }\n if (file.exists(fn)) {\n result <- readRDS(fn)\n } else {\n if (length(Min) != length(Max)) {stop(\"Min and Max have to have the same length!\")}\n if (!all.equal(names(Min), names(Max) )) {stop(\"Min and Max have to have the same names!\")}\n ## Build random Latin Hypercube\n dat <- lhs::randomLHS(n=n, k=length(Min))\n colnames(dat) <- names(Min)\n ## Transform the 0..1 values to the selected range\n dat <- sweep(\n x = dat,\n MARGIN = 2,\n Max-Min,\n '*'\n )\n dat <- sweep(\n x = dat,\n MARGIN = 2,\n Min,\n '+'\n )\n ## ## Exculde cases where conditions 6) and 7) are not met\n ## if (all(c(\"z0\", \"dep\", \"zjoint\") %in% names(Min))) {\n ## depz0 <- dat[,\"dep\"] + dat[,\"z0\"]\n ## i <- depz0 < h & depz0 > dat[,\"zjoint\"]\n ## dat <- dat[i,]\n ## }\n\n dat <- as.data.frame(t(dat))\n ##\n wphelp <- function(...) {wpLEL.wpLEL(x, ...)}\n no <- ceiling(ncol(dat) / cores)\n i <- 0\n result <- mclapply(\n dat,\n function(s) {\n names(s) <- rownames(dat)\n s <- as.list(s)\n s$wp <- do.call(wphelp, s)\n \n depz0 <- s$wp[[\"dep\"]] + s$wp[[\"z0\"]]\n if (depz0 < s$wp[[\"h\"]] & depz0 > s$wp[[\"zjoint\"]]) {\n ar <- airRest(s$wp)\n etp <- evapoTrans.airRest(\n x = ar,\n Ta = s[[\"Ta\"]],\n frach = 1,\n Rnhsol = s[[\"Rnhsol\"]],\n RH = s[[\"RH\"]],\n gsol = s[[\"gsol\"]]\n )\n ##\n s$I1 <- ar$I1\n s$I2 <- ar$I2\n s$I3 <- ar$I3\n s$I4 <- ar$I4\n s$ras <- ar$ras\n s$rac <- ar$rac\n ##\n s$etrHrsol <- etp$etrHrsol\n s$etrHcsol <- etp$etrHcsol\n s$etrHsol <- etp$etrHsol\n s$etpCh <- etp$etpCh\n class(s) = c(\"lhcAirRest\", class(s))\n } else {\n s <- NULL\n }\n i <<- i + 1\n if (round(i, -2) == i) {\n cat(i, \"\\t of about \\t\", no, \"\\t\\t\\r\")\n }\n return(s)\n },\n mc.cores = cores\n )\n cat(\"\\n\")\n result <- result[!sapply(result, is.null)]\n saveRDS(result, fn)\n }\n return(result)\n}" nil) (9720 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*tests" tests:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./tests/wpLELTest.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "## stopifnot(require(energyBalance))\n\n## Tolerance for numerical comparisons\nepsilon <- 1.0e-9\n\nua <- 3.136\nza <- 37\nz <- seq(\n from = 0,\n to = za,\n by = 0.1\n)\n\n## Test 1\nu <- wpLEL(\n z,\n ua = ua,\n dep = 14,\n z0 = 2.8,\n na = 7,\n zjoint = 14.31625,\n h = 28,\n za = 37,\n z0sol = 0.01\n)\nu.s <- readRDS(\"./tests/u.rds\")\nstopifnot( max(abs(unlist(u) - unlist(u.s)), na.rm=TRUE ) < epsilon)\n\nu <- airRest(u)\nu.s <- readRDS(\"./tests/u.ar.rds\")\nstopifnot( max(abs(unlist(u) - unlist(u.s)), na.rm=TRUE ) < epsilon)\n\n## Test 2\nWAI <- 0.5\nLAI <- 0\nu1 <- wpLEL(\n z,\n ua = ua,\n dep = function(PAI) {1.1*h*log(1+(Cd*PAI)^0.25)},\n PAI = WAI + LAI\n)\nu1.s <- readRDS(\"./tests/u1.rds\")\nstopifnot( max(abs(unlist(u1) - unlist(u1.s)), na.rm=TRUE ) < epsilon)\n\nu1 <- airRest(u1)\nu1.s <- readRDS(\"./tests/u1.ar.rds\")\nstopifnot( max(abs(unlist(u1) - unlist(u1.s)), na.rm=TRUE ) < epsilon)\n\n## Test 3\nWAI <- 0.5\nLAI <- 6\nu2 <- wpLEL(\n z,\n ua = ua,\n dep = function(PAI) {1.1*h*log(1+(Cd*PAI)^0.25)},\n PAI = WAI + LAI\n)\nu2.s <- readRDS(\"./tests/u2.rds\")\nstopifnot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=TRUE ) < epsilon)\n\nu2 <- airRest(u2)\nu2.s <- readRDS(\"./tests/u2.ar.rds\")\nstopifnot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=TRUE ) < epsilon)" nil) (9828 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Package%20Documentation" Package\ Documentation:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalancePaper/R/EnergyBalancePaper.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' EnergyBalancePaper: Companion package for paper\n#'\n#' Companion package for the paper \\bold{TO BE ADDED} This packagee\n#' contains thew data and the functions used to analyse the date and\n#' to create the plots in the paper. In addition it also contains\n#' further scripts for analysis and plots not included in the paper.\n#' \n#' @section EnergyBalancePaper functions and data:\n#' Data: To Be added ...\n#' Functions: To Be added ...\n#'\n#' @docType package\n#' @name EnergyBalancePaper\nNULL\n#> NULL" nil) ...))
mapc(#[(by-lang) "\b@.\bA.\306 \v\"A\206.\0 .\307\306 .\"A\203#.\310\306 .\"A!\206$. \311P!.\r\312.\x0e\313\314\n\"-\207" [by-lang lang specs org-babel-tangle-lang-exts ext org-src-lang-modes assoc intern symbol-name "-mode" nil mapc #[(spec) "\306\211.\307!.\b\310!\211.G\311V\205.\0\n).\b\312!. \313\230\203%.\314\315 !\2027. \316\230\203/.\317\2027. G\311V\2057. \211.\205P.\x0e,\203O. \313\230\203O.\r\320.,Q\202P.\r\211.-\2054.\b\321!\322.-!..\211./\203w.\x0e.\203w.\x0e/\316\230\204w.\323..\324\"\210*\325.-!\203\217.\x0e-\326\327.0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203\247.\317\335\336\217\210\v\203\277.\x0e-.3\235\204\277.\v\337Pc\210.-.3B.3\340.4!\210\341 .5\331\332!.6r.6q\210\342\216\325.-!\203\340.\343.-!\210db\210\344\345\346.48\"A\316\230\204\371.`eU\204\371.\337c\210.5c\210\347\317\211.-#\210.\a\v\203.\x01\f\204.\x01\350.\x0e7T.7.-\fB.8\351.8.0\352\353$\203+.\x0e0\2023.\x0e8.0B\211.0)..\207" [get-spec tangle sheb she-bang tangle-mode base-name #[(name) "\302\b\303 8\"A\207" [name spec assoc 4] 4] :tangle :shebang 0 :tangle-mode "yes" file-name-sans-extension buffer-file-name "no" nil "." :mkdirp file-name-directory make-directory parents file-exists-p mapcar car delete-file generate-new-buffer " *temp*" ((byte-code "\301\b!\203\n.\302\b!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) fboundp (funcall lang-f) ((error)) "\n" org-babel-spec-to-string buffer-string ((byte-code "\301\b!\203\n.\302\b!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) insert-file-contents assoc :padline 4 write-region 493 cl-member :test #[(a b) "\b@ @\232\207" [a b] 2] ext file-name fnd m path-collector temp-buffer ...] 6] lang-f she-banged] 5] (("R" (5939 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/data/fileNames.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "CACHE <- file.path( \".\", \"cache\")\nSQLITEDB <- file.path(CACHE, \"energyBalance.sqlite\")" nil) (5950 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Package%20Documentation" Package\ Documentation:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/EnergyBalance.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' EnergyBalance: A package for computating wind profiles and\n#' aerodynamic resistances.\n#'\n#' The EnergyBalance package provides functiuons to\n#' fit wind profiles, calculate the aerial resistance and plot the profiles.\n#' \n#' @section EnergyBalance functions:\n#' To Be added ...\n#'\n#' @docType package\n#' @name EnergyBalance\n#' @importFrom parallel detectCores\n#' @importFrom parallel mclapply\n#' @importFrom lhs randomLHS\n#' @importFrom RSQLite SQLite\n#' @import DBI\n#' @import magrittr\nNULL\n#> NULL" nil) (5973 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/CACHE.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' Cache for computations in package\n#'\n#' CACHE to be used for the computations. The cac=he holde =temporary\n#' as well as final results of the computations which are saved\n#' automatically to avoid re-computqtion. \n#' \n#' @format Character vector of length one.\n#' @name CACHE\n#' @docType data\nNULL" nil) (5986 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*SQLITEDB" SQLITEDB:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/SQLITEDB.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' SQLite Database with processed input data\n#'\n#' File name and path to the sqlite database which holds the processed\n#' wind speeds and LAI and the indices to increase access speed.\n#' \n#' @format Character vector of length one.\n#' @name SQLITEDB\n#' @docType data\nNULL" nil) (6000 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*getplotlim" getplotlim:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/getplotlim.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Return the limits of the plot\n##'\n##' Return the limits, as set by \\code{xlim = } and \\code{ylim = }. \n##' @param lim if \\code{xlim} or \\code{ylim} return the xorresponding\n##' limits, if code{xlimylim} retur list with each limit as an\n##' element.\n##' @return either vector with two elements containing the x or y\n##' limits or a list of two elements, xlim and ylim.\n##' @author Rainer M. Krug\n##' @export\ngetplotlim<-function(lim = c(\"xlim\", \"ylim\")) {\n usr <- par('usr')\n xr <- (usr[2] - usr[1]) / 27 # 27 = (100 + 2*4) / 4\n yr <- (usr[4] - usr[3]) / 27\n return(\n switch(\n EXPR = paste(sort(lim), collapse=\"\"),\n xlim = c(usr[1] + xr, usr[2] - xr),\n ylim = c(usr[3] + yr, usr[4] - yr),\n xlimylim = list(\n xlim = c(usr[1] + xr, usr[2] - xr),\n ylim = c(usr[3] + yr, usr[4] - yr)\n ),\n stop(\"Invalid value for lim!\")\n ) \n )\n}" nil) (6032 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Input%20data%20directory%20discovery%20functions" Input\ data\ directory\ discovery\ functions:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/inputDataDir.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Returns input data dir\n##'\n##' Returns input data dir (the directory with the wind and LAI\n##' input files are located in). If the package \\code{EnergyBalancePaper} is\n##' installed, the data included in this package is returned,\n##' otherwist the directory \\code{paste0{getwd(), \"/inputdata\"}} is\n##' returned.\n##' \n##' @title inputDataDir\n##' @return input data directory for win=d and LAI data\n##' @author Rainer M. Krug\n##' @export\ninputDataDir <- function() {\n file.path(\n ifelse(\n \"package:EnergyBalancePaper\" %in% search(),\n system.file(package = \"EnergyBalancePaper\"),\n getwd()\n ),\n \"inputdata\"\n )\n}" nil) (6120 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*importVentToDB" importVentToDB:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/importVentToDB.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Import wind data\n##'\n##' Import data into sqlite db and fit =default= to each wind profile\n##' to obtain the parameters, e.g. ustar for selecting.\n##' @param h canopy height in meter. Needed for estimate of ustar (u*)\n##' @param fn file name of wind date\n##' @return invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\nimportVentToDB <- function(fn, h) {\n wsw <- read.csv(\n file = fn,\n stringsAsFactors = FALSE,\n header = TRUE\n )\n names(wsw) <- c(\n \"date\",\n \"time\",\n \"julien\",\n \"h03\",\n \"h11\",\n \"h17\",\n \"h23\",\n \"h29\",\n \"h37\"\n )\n ## Add columns for wpLELDefault parameter values\n wsw$ua <- NA\n wsw$dep <- NA\n wsw$z0 <- NA\n wsw$na <- NA\n wsw$zjoint <- NA\n wsw$h <- NA\n wsw$za <- NA\n wsw$ustar <- NA\n ## Fit wpLELDefault and save parameter\n\n for (i in 1:nrow(wsw)) {\n if(floor(i/20)*20 == i) { cat(i, \" \") }\n wp <- dfFromLong(wsw[i,])\n if ( !any( is.na( c(wp$z, wp[,3]) ) ) ){\n wpf <- fitOptim.wpLEL.default.single(\n z = wp$z,\n u = wp[,3],\n ## lower = c(dep=0, z0=0.001, na=0.01, zjoint=0),\n initial = c(dep=2, z0=2, na=2, zjoint=3)\n ## upper = c(dep=27, z0=h, na=20, zjoint=h),\n ## method = \"L-BFGS-B\"\n )\n wsw$ua[i] <- wpf$wp[[\"ua\"]]\n wsw$dep[i] <- wpf$fit$par[[\"dep\"]]\n wsw$z0[i] <- wpf$fit$par[[\"z0\"]]\n wsw$na[i] <- wpf$fit$par[[\"na\"]]\n wsw$zjoint[i] <- wpf$fit$par[[\"zjoint\"]]\n wsw$h[i] <- wpf$wp[[\"h\"]]\n wsw$za[i] <- wpf$wp[[\"za\"]]\n wsw$ustar[i] <- wpf$wp[[\"ustar\"]]\n }\n }\n \n wsl <- data.frame(\n date = wsw$date,\n time = wsw$time,\n julien = wsw$julien,\n z = rep(\n c(3,11,17,23,29,37),\n times = rep( nrow(wsw), 6 )\n ),\n ws = c(\n wsw$h03,\n wsw$h11,\n wsw$h17,\n wsw$h23,\n wsw$h29,\n wsw$h37\n ),\n ua = wsw$ua,\n dep = wsw$dep,\n z0 = wsw$z0,\n na = wsw$na,\n zjoint = wsw$zjoint,\n h = wsw$h,\n za = wsw$za,\n ustar = wsw$ustar\n )\n ##\n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try({\n ## WindSpeed_w\n DBI::dbWriteTable(db, \"WindSpeed_w\", wsw, overwrite=TRUE)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsw_dt ON WindSpeed_w (date, time)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsw_jt ON WindSpeed_w (julien, time)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsw_date ON WindSpeed_w (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsw_time ON WindSpeed_w (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsw_julien ON WindSpeed_w (julien)\")\n ## WindSpeed_l\n DBI::dbWriteTable(db, \"WindSpeed_l\", wsl, overwrite=TRUE)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsl_dth ON WindSpeed_l (date, time, z)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsl_jth ON WindSpeed_l (julien, time, z)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_date ON WindSpeed_l (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_time ON WindSpeed_l (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_julien ON WindSpeed_l (julien)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_h ON WindSpeed_l (h )\")\n }\n )\n DBI::dbDisconnect(db)\n invisible()\n}" nil) (6245 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*importLAIToDB" importLAIToDB:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/importLAIToDB.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Import LAI data\n##'\n##' Import LAI data into sqlite db\n##' @param fn file name of LAI data\n##' @return invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\nimportLAIToDB <- function(fn) {\n lai <- read.csv(\n file = fn,\n stringsAsFactors = FALSE,\n header = TRUE\n )\n names(lai) <- c(\n \"doy\",\n \"lai\"\n )\n ##\n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try(\n {\n DBI::dbWriteTable(db, \"LeafAreaIndex\", lai, overwrite=TRUE)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX lai_doy ON LeafAreaIndex (doy)\")\n DBI::dbGetQuery(db, \"CREATE INDEX lai_h ON LeafAreaIndex (lai)\")\n }\n )\n DBI::dbDisconnect(db)\n}" nil) (6353 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*createWsLAI" createWsLAI:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/createWsLAI.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Finalize sqlight databaes of input data\n##'\n##' Create combined wind speed and LAI table and associated indices in sqlite database.\n##' @return invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\ncreateWsLAI <- function(\n ){\n sql_l <- paste(\n \"CREATE TABLE\",\n \" WindSpeedLAI_l\",\n \"AS SELECT\",\n \" WindSpeed_l.*, LeafAreaIndex.lai AS lai\",\n \"FROM\", \n \" WindSpeed_l\",\n \"LEFT OUTER JOIN\",\n \" LeafAreaIndex\",\n \"ON\",\n \" julien=DOY\"\n )\n sql_w <- paste(\n \"CREATE TABLE\",\n \" WindSpeedLAI_w\",\n \"AS SELECT\",\n \" WindSpeed_w.*, LeafAreaIndex.lai AS lai\",\n \"FROM\", \n \" WindSpeed_w\",\n \"LEFT OUTER JOIN\",\n \" LeafAreaIndex\",\n \"ON\",\n \" julien=DOY\"\n )\n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try({\n ##\n DBI::dbGetQuery( conn = db, statement = \"DROP TABLE IF EXISTS WindSpeedLAI_l\")\n DBI::dbGetQuery( conn = db, statement = sql_l)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslail_dth ON WindSpeedLAI_l (date, time, z)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslail_jth ON WindSpeedLAI_l (julien, time, z)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_date ON WindSpeedLAI_l (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_time ON WindSpeedLAI_l (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_julien ON WindSpeedLAI_l (julien)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_h ON WindSpeedLAI_l (z )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_lai ON WindSpeedLAI_l (lai)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_ustar ON WindSpeedLAI_l (ustar)\")\n ##\n DBI::dbGetQuery( conn = db, statement = \"DROP TABLE IF EXISTS WindSpeedLAI_w\")\n DBI::dbGetQuery( conn = db, statement = sql_w)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslaiw_dth ON WindSpeedLAI_w (date, time)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslaiw_jth ON WindSpeedLAI_w (julien, time)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_date ON WindSpeedLAI_w (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_time ON WindSpeedLAI_w (time )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_julien ON WindSpeedLAI_w (julien)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_lai ON WindSpeedLAI_w (lai)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_ustar ON WindSpeedLAI_w (ustar)\")\n }\n )\n DBI::dbDisconnect(db)\n invisible(NULL)\n}" nil) (6421 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*createCache" createCache:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/createCache.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Re-create \\code{CACHE}\n##'\n##' Deletes all files in the cache (directory \\code{CACHE}) and re-creates them\n##' @title Recreate files in cache\n##' @name createCache\n##' @return invisible NULL\n##' @author Rainer M. Krug\n##' @export\n##' @param fnVent file name of Wind Profile csv file\n##' @param fnLAI file name of LAI csv file\n##' @param h height, needed for wind profile fit to obtain u^*\ncreateCache <- function(fnVent, fnLAI, h) {\n dir.create(CACHE, showWarnings = FALSE)\n unlink(SQLITEDB)\n importVentToDB(fnVent, h)\n importLAIToDB(fnLAI)\n createWsLAI()\n invisible(NULL)\n}" nil) (6446 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*loadWS" loadWS:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/loadWS.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Depending on the values of the arguments, different datasets are\n##' loaded, but all contain wind speed at different heights and lai\n##' data. The sql argument can be used to specify different\n##' conditions for the data returned.\n##'\n##' Loads wind speed data from sql database in cache\n##' @title Load wind speed data\n##' @param wide if TRUE, load wide format, if FALSE long format\n##' @param onlyComplete if \\code{TRUE}, load only datapoints without missing\n##' data in wind \\code{h*} and \\code{LAI}.\n##' @param minSpeedIncreaseWide numeric value or \\code{NULL}. If not \\code{NULL}, the following rules will be\n##' used to filter the wind profiles:\n##' \n##' \\itemize{\n##' \n##' \\item{ differences of wind speeds between each point and the\n##' adjacend lower sampling points has to be larger then the value of\n##' \\code{minSpeedIncreaseWide}}\n##'\n##' }\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @param maxWindSpeedWide numeric value or \\code{null}. If not\n##' \\code{NULL}, wind profiles with wind speeds higher then\n##' \\code{maxWindSpeedWide} will be filtered out.\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @param maxWindSpeedOneWide Logical - if \\code{TRUE} the wind profiles will\n##' be standardised to wind speed at highest sampling point to 1 and\n##' the original wind speed will be stored in a field \\code{ua}\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @param minUstar minimum ustar value to be included in analysis. The default is 0.25. \\bold{REFERENCE NEEDED}\n##' \n##' @param WAI Wood Area Index - default value \\code{0}. numeric value to be added to the field\n##' \\code{lai}. \n##' @param sql sql statement to be used instread of \\code{wide} and\n##' \\code{onlyComplete}. The sql statement is evauated and the result is\n##' returned.\n##'\n##' \\bold{Only Applies To \\code{wide==TRUE}}\n##' \n##' @return data.frame containing the data. If the \\code{wide==TRUE},\n##' the class is also set to \\code{wsw}, if \\code{wide==FALSE} to\n##' \\code{wsl}\n##' @author Rainer M. Krug\n##' @export\nloadWS <- function(\n wide = TRUE,\n onlyComplete = TRUE,\n minSpeedIncreaseWide = 0,\n maxWindSpeedWide = 10,\n maxWindSpeedOneWide = FALSE,\n minUstar = 0.25,\n WAI = 0,\n sql\n ) {\n if (wide) {\n tbln <- \"WindSpeedLAI_w\"\n } else {\n tbln <- \"WindSpeedLAI_l\"\n }\n try({ \n db <- dbConnect(RSQLite::SQLite(), SQLITEDB)\n if (missing(sql)) {\n if (!onlyComplete) {\n sql <- paste( \"SELECT * FROM\", tbln ) \n } else {\n f <- c( \"LAI\", grep(\"^h.\", dbListFields(db, tbln), value=TRUE))\n f <- paste(f, \"IS NOT NULL\", collapse = \" AND \")\n sql <- paste( \"SELECT * FROM \", tbln, \"WHERE\", f, \"AND ustar >=\", minUstar)\n }\n }\n ws <- DBI::dbGetQuery(db, sql)\n } \n )\n dbDisconnect(db)\n ##\n if (length(grep(\"date|time\", names(ws))) >= 2) {\n ws$date <- as.Date(ws$date, format = \"%d/%m/%y\")\n ws$dateTime <- as.POSIXct(paste(ws$date, ws$time), format=\"%Y-%m-%d %H:%M\")\n ##\n ws <- ws[\n c(\n \"date\",\n \"time\",\n \"dateTime\",\n grep(\"date|time|dateTime\", names(ws), invert=TRUE, value=TRUE)\n )\n ]\n ##\n }\n if (wide) {\n class(ws) <- c(class(ws), \"wsw\")\n h <- rownames(dfFromLong(ws[2,]))\n if (!is.null(minSpeedIncreaseWide)) {\n ws <- ws[\n ws[,h] %>%\n as.matrix %>%\n t %>%\n diff %>%\n data.frame %>%\n sapply(\n X = .,\n FUN = . %>%\n is_less_than(minSpeedIncreaseWide) %>%\n any\n ) %>%\n not,\n ]\n }\n if (!is.null(maxWindSpeedWide)) {\n ws <-\n ws[\n ws[,h] %>%\n apply(\n X = .,\n MARGIN = 1,\n FUN = max\n ) %>%\n is_less_than(maxWindSpeedWide),\n ]\n }\n ua <- dfFromLong(ws[1,]) %>% extract(\"z\") %>% max %>% paste0(\"h\", .)\n ws$ua <- ws[[ua]]\n if (maxWindSpeedOneWide) {\n for (i in h) {\n ws[i] <- ws[i] / ws[ua] \n }\n }\n } else {\n class(ws) <- c(class(ws), \"wsl\")\n }\n if (!is.null(WAI)) {\n ws$lai <- ws$lai + WAI\n }\n return(ws)\n}" nil) (6596 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*dfFromLong" dfFromLong:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/dfFromLong.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Extract the height from the column names in the database, where\n##' the column names of the height have to follow the format\n##' \\code{h[:digit:]}.\n##'\n##' Extract the height\n##' @title Extract height from column names\n##' @param x column names\n##' @return heights as encoded in the column names in the order as given\n##' @author Rainer M. Krug\n##' @export\ndfFromLong <- function(\n x\n ) {\n hCols <- grep(\n pattern = \"^h[[:digit:]]\",\n x = names(x),\n value = FALSE\n )\n h <- gsub(\"h\", \"\", names(x)[hCols])\n h <- as.numeric(h)\n u <- as.matrix(x[hCols])\n if(is.vector(u)) {\n result <- data.frame(\n index = hCols,\n z = h,\n u = u\n )\n } else { # is.matrix(u) == TRUE\n result <- data.frame(\n index = hCols,\n z = h,\n u = t(u)\n )\n }\n rownames(result) <- names(x)[hCols]\n return(result)\n}" nil) (6646 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL%20Generic%20function%20definition" wpLEL\ Generic\ function\ definition:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to create \\code{wpLEL} object.\n##'\n##' The returned object of class \\code{wpLEL} contains the following fields:\n##' \\itemize{\n##' \\item{\\code{parametrization}} {parametrization used to create this object. Possible values are \"default\" and \"Mahat2013\"}\n##' \n##' \\item{\\code{dep}} {some info}\n##' \\item{\\code{z0}} {some info}\n##' \\item{\\code{na}} {some info}\n##' \\item{\\code{zjoint}} {some info}\n##' \\item{\\code{h}} {some info}\n##' \\item{\\code{za}} {some info}\n##' \\item{\\code{z0sol}} {some info}\n##' \n##' \\item{\\code{vk}} {some info}\n##' \\item{\\code{ua}} {some info}\n##' \\item{\\code{ustar}} {some info}\n##' \\item{\\code{z0h}} {some info}\n##' \\item{\\code{uzjoint}} {some info}\n##' \\item{\\code{ustarsol}} {some info}\n##'\n##' \\item{\\code{noU}} {some info}\n##' }\n##' @title wpLEL\n##' @param x object from which to calculat the \\code{wpLEL} object\n##' @param ... optional arguments for the generic functions\n##' @return objerct of class \\code{wpLEL}\n##' @author Rainer M. Krug\n##' @export\nwpLEL <- function(x, ...) UseMethod(\"wpLEL\")" nil) (6681 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*parameterOK" parameterOK:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/parmeterOK.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Check parameter for validity\n##'\n##' Check parameter for validity. If they are valid, the function\n##' returns \\code{TRUE}, if not, it returns the error messages.\n##' @title parameterOK\n##' @param z z\n##' @param ua ua\n##' @param dep dep\n##' @param z0 z0\n##' @param na na\n##' @param zjoint zjoint\n##' @param h h\n##' @param za za\n##' @param z0sol z0sol\n##' @return \\code{TRUE} if parameter are OK, otherwise a named\n##' \\code{character} vector where the names are the parameter which\n##' are not OK and the values the error messages to be used\n##' @author Rainer M. Krug\n##' @export\nparameterOK <- function(\n z,\n ua,\n dep,\n z0,\n na,\n zjoint,\n h,\n za,\n z0sol\n ) {\n result <- NULL\n ## z 0 <= z\n if (any( z < 0 )) {\n result <- c(result, z = \"All z have to be larger or equal than zero!\\n\")\n }\n ## ua 0 <= ua\n if (ua < 0 ) {\n result <- c(result, ua = \"ua has to be larger or equal than zero!\\n\")\n }\n ## dep 0 <= dep < h\n if ((dep < 0) | (dep >= h) ) {\n result <- c(result, dep = \"dep has to be larger or equal than zero and smaller than h!\\n\")\n }\n ## z0 0 < z0 <= h\n if ((z0 <= 0) | (z0 > h)) {\n result <- c(result, z0 = \"z0 has to be larger than zero and smaller or equal than h!\\n\")\n } \n ## na 0 < na\n if (na < 0 ) {\n result <- c(result, na = \"na has to be larger or equal than zero!\\n\")\n } \n ## zjoint\n if ((zjoint < 0) | (zjoint > h)) {\n result <- c(result, zjoint = \"zjoint has to larger or equal than 0 and smaller or equal than h!\\n\")\n }\n ## h h >= 0\n if (h < 0 ) {\n result <- c(result, h = \"h has to be larger or equal than zero!\\n\")\n }\n ## za za > h\n if (za <= h ) {\n result <- c(result, za = \"za has to be larger than h!\\n\")\n }\n ## z0sol 0 < z0sol POSSIBLY < h/10 ???\n if (z0sol <= 0 ) {\n result <- c(result, z0sol = \"z0sol has to be larger than zero!\\n\")\n }\n ## ###\n ## dep, z0, h dep + z0 < h\n if ((dep + z0) > h) {\n result <- c(result, \"(dep + z0) has to be smaller than h!\\n\")\n }\n \n if (is.null(result)) {\n result <- TRUE\n }\n return(result)\n}" nil) (6775 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELDefault" wpLELDefault ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELDefault.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param dep zero-plane displacement height. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{dep}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' dep = function(LAI, ...) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the argument\n##' \\code{parametrization} accordingly (in this example\n##' \"Mahat\") to adjust further analysis accordingly!\n##' @param z0 roughness length at canopy level. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{z0}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' z0 = function(LAI, ...) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the\n##' argument \\code{parametrization} accordingly (in this\n##' example \"Mahat\") to adjust further analysis accordingly!\n##' @param na exponential decay coefficient\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @param ... further argumewnts which will be passed to the user\n##' defined function \\code{dep} and \\code{z0}.\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELDefault <- function(\n z,\n ua,\n dep,\n z0,\n na, # = 7,\n zjoint,\n h, # = 28,\n za, # = 37,\n z0sol,# = 0.001,\n noU = FALSE,\n check = TRUE\n ){ \n vk <- 0.41\n \n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n stop(ok)\n }\n \n ## profil5.m l29 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::29]]\n ## ustar = ua * vk / log( (za - dep) / z0) \n ustar <- ua * vk / log( (za - dep) / z0)\n\n ## profil5.m l30 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::30]]\n ## z0h = z0 * exp( -6.27 * vk * ( ustar^(1/3) ) ); % Calcul de Z0h (Thom)\n z0h <- z0 * exp( -6.27 * vk * ( ustar^(1/3) ) )\n\n ## profil5.m l32 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::32]]\n ## zjoint = z0h + dep;\n ## if (missing(zjoint)) {zjoint <- z0h + dep}\n\n ## profil5.m l33 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::33]]\n ## uzjoint = ustar / vk * log( (hauteur - dep)/z0 ) * exp( - na * (1 - zjoint/hauteur) );\n uzjoint <- (ustar / vk) * log( (h - dep)/z0 ) * exp( - na * (1 - zjoint/h ) )\n\n ## profil5.m l34 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::34]]\n ## ustarsol = uzjoint * vk / log( (zjoint/z0sol))\n ustarsol <- ifelse(\n (zjoint == 0),\n as.numeric(NA),\n uzjoint * vk / log( zjoint / z0sol )\n )\n \n ##\n result <- list(\n z = NA,\n u = NA,\n u.onlyTop = NA\n )\n\n if (!noU) {\n result$z <- as.numeric(z)\n ##\n result$u <- as.numeric(\n sapply(\n z,\n function(z) {\n if (z >= h) {\n ## profil5.m l36 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::37]]\n u <- ( ustar/vk ) * log( (z-dep) / z0 )\n } else if (z >= zjoint) {\n ## profil5.m l40 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::41]]\n uh <- ( ustar/vk ) * log( (h-dep) / z0 )\n u <- uh * exp( -na*(1-(z/h)) )\n } else if (z >= 0) {\n ## profil5.m l42 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::42]]\n u <- ( ustarsol/vk ) * log( (z ) / z0sol )\n } else {\n u <- NA\n }\n return(u)\n }\n )\n )\n names(result$u) <- paste0(\"h\", z)\n ##\n result$u.onlyTop = as.numeric(\n sapply(\n z,\n function(z) {\n zd <- ((z-dep) / z0)\n if (zd < 0){\n u <- NA\n } else {\n u <- ( ustar/vk ) * log( (z-dep) / z0 )\n }\n if (!is.na(u)) {\n if (u < 0) {\n u <- NA\n }\n }\n return(u)\n }\n )\n )\n }\n ##\n result$parametrization <- \"default\"\n result$dep <- as.numeric(dep)\n result$z0 <- as.numeric(z0)\n result$na <- as.numeric(na)\n result$zjoint <- as.numeric(zjoint)\n result$h <- as.numeric(h)\n result$za <- as.numeric(za)\n result$z0sol <- as.numeric(z0sol)\n \n result$vk <- as.numeric(vk)\n result$ua <- as.numeric(ua)\n result$ustar <- as.numeric(ustar)\n result$z0h <- as.numeric(z0h)\n result$uzjoint <- as.numeric(uzjoint)\n result$ustarsol <- as.numeric(ustarsol)\n ##\n result$noU <- noU\n result$check <- check\n ##\n class(result) <- c(\"wpLEL\")\n return(result)\n}" nil) (6981 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELMahat" wpLEL\.mahat ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELMahat.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape using Mahat parametrisation\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile based on Mahat parametrization\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param na exponential decay coefficient\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param LAI Leaf Area Index to be used for the calculation of \\code{dep}\n##' @param y integer indicating three basic forest profiles\n##' \\itemize{\n##' \\item{y = 1} : {young pine}\n##' \\item{y = 2} : {leafed decideous tree}\n##' \\item{y = 3} : {old pine with long stems and clumping at the top}\n##' }\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELMahat <- function(\n z,\n ua,\n na,\n zjoint,\n h,\n za,\n z0sol,\n LAI,\n y,\n noU = FALSE,\n check = TRUE\n){ \n depFUN <- function(LAI, ...) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n dep <- depFUN(LAI, h, y)\n ##\n z0FUN <- function(LAI, ...) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n z0 <- z0FUN(LAI, h, y)\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = FALSE\n )\n ##\n result$z0FUN <- z0FUN\n result$depFUN <- depFUN\n result$LAI <- as.numeric(LAI)\n result$y <- as.numeric(y)\n result$check <- check\n ##\n result$parametrization <- \"mahat\"\n ##\n return(result)\n}" nil) (7084 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELLE" wpLELLE ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELLE.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile using Log-Exp shape\n##'\n##' Creates Log-Exp shaped wind profile oblect \\code{wpLEL} based on\n##' input parameter. Uses \\code{wpLELDefault()} with \\code{zjoint=0}\n##' and \\code{z0sol=NA}.\n##' @title Log-Exp wind profile\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param dep zero-plane displacement height. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{dep}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' dep = function(LAI, ...) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the argument\n##' \\code{parametrization} accordingly (in this example\n##' \"Mahat\") to adjust further analysis accordingly!\n##' @param z0 roughness length at canopy level. The argument can be a\n##' numeric value or a function which is evaluated in the context of\n##' the function, i.e. can use all arguments to calculate\n##' \\code{z0}. The last argument has to be \\code{...}. An example for\n##' the usage of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' z0 = function(LAI, ...) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n##'\n##' where \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an additional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as all arguments in\n##' the function \\code{wpLELDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When using a function, it should be taken care to set the\n##' argument \\code{parametrization} accordingly (in this\n##' example \"Mahat\") to adjust further analysis accordingly!\n##' @param na exponential decay coefficient\n##' @param h canopy height h\n##' @param za ???????\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param ... further argumewnts which will be passed to the user\n##' defined function \\code{dep} and \\code{z0}.\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELLE <- function(\n z,\n ua,\n dep,\n z0,\n na,\n h,\n za,\n noU = FALSE,\n check = TRUE\n ){\n zjoint <- 0\n z0sol <- 0.1\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = TRUE\n )\n ##\n result$check <- check\n result$parametrization <- \"LE\"\n return(result)\n}" nil) (7204 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELMahatLE" wpLELMahatLE ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELMahatLE.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape using Mahat parametrisation\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile based on Mahat parametrization\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param na exponential decay coefficient\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param LAI Leaf Area Index to be used for the calculation of \\code{dep}\n##' @param y integer indicating three basic forest profiles\n##' \\itemize{\n##' \\item{y = 1} : {young pine}\n##' \\item{y = 2} : {leafed decideous tree}\n##' \\item{y = 3} : {old pine with long stems and clumping at the top}\n##' }\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELMahatLE <- function(\n z,\n ua,\n na,\n h,\n za,\n z0sol,\n LAI,\n y,\n noU = FALSE,\n check = TRUE\n){ \n depFUN <- function(LAI, h, y) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n dep <- depFUN(LAI, h, y)\n z0FUN <- function(LAI, h, y) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n z0 <- z0FUN(LAI, h, y)\n zjoint <- 0\n z0sol <- 0.1\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = FALSE\n )\n ##\n result$depFUN <- depFUN\n result$z0FUN <- z0FUN\n result$LAI <- as.numeric(LAI)\n result$y <- as.numeric(y)\n result$check <- check\n result$parametrization <- \"mahatLE\"\n ##\n return(result)\n}" nil) (7307 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELCastanea" wpLELCastanea ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELCastanea.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind profile\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @param z0sol roughness length at soil level (???????)\n##' @param LAI Leaf Area Index\n##' @param WAI Wood Area Index, default=1.1\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELCastanea <- function(\n z,\n ua,\n zjoint,\n h,\n za,\n z0sol,\n LAI,\n WAI = 1.1,\n noU = FALSE,\n check = TRUE\n){\n depFUN <- function(h) {(2/3) * h}\n dep <- depFUN(h) # Oke 1972\n ##\n z0FUN <- function(h) {0.1 * h}\n z0 <- z0FUN(h) # Granier\n ##\n naFUN <- function(LAI, WAI) {\n na <- 2.6 * (LAI + WAI)^0.36\n if (na > 4) {\n na <- 4\n }\n return(na)\n }\n na <- naFUN(LAI, WAI)\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua, \n dep = na,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h, \n za = za,\n z0sol = z0sol, \n noU = noU,\n check = FALSE\n )\n result$depFUN <- depFUN\n result$z0FUN <- z0FUN\n result$naFUN <- naFUN\n result$LAI <- as.numeric(LAI)\n result$WAI <- as.numeric(WAI)\n result$check <- check\n result$parametrization <- \"castanea\"\n return(result)\n}" nil) (7415 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELOwnFree" wpLELOwnFree ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELOwnFree.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log shape using ownFree parametrisation\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parameter.\n##' dep, z0, na and zoint are parametrized using:\n##'\n##' x = h * ( x.a + ( LAI ^ x.b ) / x.c )\n##'\n##' where x is dep, z0, na and zjoint respectively.\n##' \n##' @title Log-Exp-Log wind profile based on Mahat parametrization\n##' @param z height above ground\n##' @param ua wind speed at highest point of z\n##' @param h canopy height h\n##' @param za za\n##' @param z0sol roughness length at soil level\n##' @param dep.a see Details\n##' @param dep.b see Details\n##' @param dep.c see Details\n##' @param z0.a see Details\n##' @param z0.b see Details\n##' @param z0.c see Details\n##' @param na.a see Details\n##' @param na.b see Details\n##' @param na.c see Details\n##' @param zjoint.a see Details\n##' @param zjoint.b see Details\n##' @param zjoint.c see Details\n##' @param LAI Leaf Area Index to be used for the calculation of \\code{dep}\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @param na exponential decay coefficient\n##' @param zjoint height at which the logarithmic changes to\n##' exponential (\"lower canopy end\")\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELOwnFree <- function(\n z,\n ua,\n\n h,\n za,\n z0sol,\n\n dep.a, dep.b, dep.c,\n z0.a, z0.b, z0.c,\n na.a, na.b, na.c,\n zjoint.a, zjoint.b, zjoint.c,\n\n LAI,\n noU = FALSE,\n check = TRUE\n ){ \n depFUN <- function(LAI, h, dep.a, dep.b, dep.c) { h * ( dep.a + ( LAI ^ dep.b ) / dep.c ) }\n z0FUN <- function(LAI, h, z0.a, z0.b, z0.c) { h * ( z0.a + ( LAI ^ z0.b ) / z0.c ) }\n naFUN <- function(LAI, h, na.a, na.b, na.c) { h * ( na.a + ( LAI ^ na.b ) / na.c ) }\n zjointFUN <- function(LAI, h, zjoint.a, zjoint.b, zjoint.c) { h * (zjoint.a + ( LAI ^ zjoint.b ) / zjoint.c ) }\n ##\n dep <- depFUN(LAI, h, dep.a, dep.b, dep.c)\n z0 <- depFUN(LAI, h, z0.a, z0.b, z0.c)\n na <- depFUN(LAI, h, na.a, na.b, na.c)\n zjoint <- zjointFUN(LAI, h, zjoint.a, zjoint.b, zjoint.c)\n ##\n ok <- ifelse(\n check,\n parameterOK(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol\n ),\n TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = z,\n ua = ua,\n dep = dep,\n z0 = z0,\n na = na,\n zjoint = zjoint,\n h = h,\n za = za,\n z0sol = z0sol,\n noU = noU,\n check = FALSE\n )\n ##\n result$depFUN <- depFUN\n result$dep.a <- dep.a\n result$dep.b <- dep.b\n result$dep.c <- dep.c\n ##\n result$naFUN <- naFUN\n result$na.a <- na.a\n result$na.b <- na.b\n result$na.c <- na.c\n ##\n result$z0FUN <- z0FUN\n result$z0.a <- z0.a\n result$z0.b <- z0.b\n result$z0.c <- z0.c\n ##\n result$zjointFUN <- zjointFUN\n result$zjoint.a <- zjoint.a\n result$zjoint.b <- zjoint.b\n result$zjoint.c <- zjoint.c\n ##\n result$LAI <- as.numeric(LAI)\n result$check <- check\n result$parametrization <- \"ownFree\"\n ##\n return(result)\n}" nil) (7547 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL.wpLEL" wpLEL\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLEL.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Creates a new \\code{wpLEL} object from a \\code{wpLEL} object\n##'\n##' \n##' Creates an \\code{wpLEL} object from a \\code{wpLEL} object by\n##' calling \\code{wpLELDefault()} with the arguments in \\code{...} given\n##' arguments and the from \\code{x} extracted arguments.\n##' @title Log-Exp-Log wind profile\n##' @param x object of class \\code{wpLEL} to be used as source\n##' for the parameter to create the \\code{wpLEL} object\n##' @param ... \\bold{named} arguments which will be used to create the\n##' new \\code{wpLEL} object using the \\code{wpLELDefault} function.\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\nwpLEL.wpLEL <- function(\n x,\n ...\n){\n iff <- function(test, yes, no) {\n if (test) {\n yes\n } else {\n no\n }\n }\n dot <- list(...)\n u <- switch(\n x$parametrization,\n \"default\" = wpLELDefault( \n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n dep = iff(exists(\"dep\", dot), dot[[\"dep\"]], x[[\"depOrg\"]]),\n z0 = iff(exists(\"z0\", dot), dot[[\"z0\"]], x[[\"z0Org\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n zjoint = iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]])\n ),\n \"mahat\" = wpLELMahat(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n zjoint = iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n y = iff(exists(\"y\", dot), dot[[\"y\"]], x[[\"y\"]])\n ),\n \"LE\" = wpLELLE(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n dep = iff(exists(\"dep\", dot), dot[[\"dep\"]], x[[\"depOrg\"]]),\n z0 = iff(exists(\"z0\", dot), dot[[\"z0\"]], x[[\"z0Org\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]])\n ),\n \"mahatLE\" = wpLELMahatLE(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n na = iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n y = iff(exists(\"y\", dot), dot[[\"y\"]], x[[\"y\"]])\n ),\n \"castanea\" = wpLELCastanea(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n zjoint = iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n WAI = iff(exists(\"WAI\", dot), dot[[\"WAI\"]], x[[\"WAI\"]])\n ),\n \"ownFree\" = wpLELOwnFree(\n z = iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua = iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n h = iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za = iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol = iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n \n dep.a = iff(exists(\"dep.a\", dot), dot[[\"dep.a\"]], x[[\"dep.a\"]]),\n dep.b = iff(exists(\"dep.b\", dot), dot[[\"dep.b\"]], x[[\"dep.b\"]]),\n dep.c = iff(exists(\"dep.c\", dot), dot[[\"dep.c\"]], x[[\"dep.c\"]]),\n\n z0.a = iff(exists(\"z0.a\", dot), dot[[\"z0.a\"]], x[[\"z0.a\"]]),\n z0.b = iff(exists(\"z0.b\", dot), dot[[\"z0.b\"]], x[[\"z0.b\"]]),\n z0.c = iff(exists(\"z0.c\", dot), dot[[\"z0.c\"]], x[[\"z0.c\"]]),\n\n na.a = iff(exists(\"na.a\", dot), dot[[\"na.a\"]], x[[\"na.a\"]]),\n na.b = iff(exists(\"na.b\", dot), dot[[\"na.b\"]], x[[\"na.b\"]]),\n na.c = iff(exists(\"na.c\", dot), dot[[\"na.c\"]], x[[\"na.c\"]]),\n\n zjoint.a = iff(exists(\"zjoint.a\", dot), dot[[\"zjoint.a\"]], x[[\"zjoint.a\"]]),\n zjoint.b = iff(exists(\"zjoint.b\", dot), dot[[\"zjoint.b\"]], x[[\"zjoint.b\"]]),\n zjoint.c = iff(exists(\"zjoint.c\", dot), dot[[\"zjoint.c\"]], x[[\"zjoint.c\"]]),\n\n noU = iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI = iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]])\n ),\n stop(\"No valid parametrization\")\n )\n return(u)\n}" nil) (7668 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL.wpLELFit" wpLEL\.wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLEL.wpLELFit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Creates an \\code{wpLEL} object from a \\code{wpLELFit} object\n##'\n##' \n##' Creates an \\code{wpLEL} object from a \\code{wpLELFit} object by\n##' calling \\code{wpLELDefault()} with the extracted\n##' parameter.\n##' @title Log-Exp-Log wind profile\n##' @param x object of class \\code{wpLELFit} to be used as source\n##' for the parameter to ctreate the \\code{wpLEL} object\n##' @param ... additional arguments which are discarded\n##' @return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\nwpLEL.wpLELFit <- function(\n x,\n ...\n){ \n return(x$wp)\n}" nil) (7695 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.wpLEL" plot\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Plot \\code{wpLEL} object\n##'\n##' Generic function to plot \\code{wpLEL} object\n##' @param x object of class \\code{wpLEL} to be plotted\n##' @param z numeric vector at which the line should be calculated. If\n##' missing, \\code{x$z} will be used. the more points, the smoother\n##' the line.\n##' @param xlab x label\n##' @param ylab y label\n##' @param plotWPValues if \\code{TRUE}, the values and value lines are\n##' plotted\n##' @param plotWPPoints if \\code{TRUE}, the points in \\code{x$u; x$z}\n##' are plotted\n##' @param plotWPLines if \\code{TRUE}, the wind profile line is plotted\n##' @param add if \\code{TRUE}, the plot wil be added to an existing plot\n##' @param ... optional arguments for \\code{plot} method\n##' @return incisible NULL\n##' @author Rainer M. Krug\n##' @export\nplot.wpLEL <- function(\n x,\n z,\n xlab = \"Wind Speed (m/s)\",\n ylab = \"Height above ground (m)\",\n plotWPValues = TRUE,\n plotWPPoints = TRUE,\n plotWPLines = TRUE,\n add = FALSE,\n ...\n) {\n if (missing(z)) {z <- x$z}\n u <- wpLEL(x, z=z)\n ## setup plot if !add\n if (!add) {\n plot(\n x = c(0, max(x$u, u$u)),\n y = c(0, max(x$z, u$z)),\n type= \"n\",\n xlab = xlab,\n ylab = ylab\n )\n }\n ## plot points\n points(\n x = x$u,\n y = x$z,\n type= ifelse(plotWPPoints, \"p\", \"n\"),\n ...\n )\n lines(\n x = u$u.onlyTop,\n y = u$z,\n type = ifelse(plotWPLines, \"l\", \"n\"),\n lty = \"dotted\",\n col = \"blue\"\n )\n lines(\n x = u$u,\n y = u$z,\n type = ifelse(plotWPLines, \"l\", \"n\"),\n lty = \"solid\",\n col = \"black\"\n )\n if (plotWPValues) {\n mx <- par(\"usr\")[2]\n with(\n x,\n {\n arrows(\n x0 = c(0, 0, 0 ,0 ,0),\n y0 = c(z0+dep, za, h, dep, zjoint),\n x1 = c(4, 4, 4 ,4 ,4 ,4),\n y1 = c(z0+dep, za, h, dep, zjoint),\n length = 0,\n col = \"grey\",\n lty = \"dotted\"\n )\n text(mx, z0, paste('z0', round(z0, 2), sep=\" = \" ), pos = 2)\n text(mx, za, paste('za', round(za, 2), sep=\" = \" ), pos = 2)\n text(mx, h, paste('hauteur', round(h, 2), sep=\" = \" ), pos = 2)\n text(mx, dep, paste('dep', round(dep, 2), sep=\" = \" ), pos = 2)\n text(mx, zjoint, paste('zjoint', round(zjoint, 2), sep=\" = \" ), pos = 2)\n }\n )\n }\n invisible(NULL)\n}" nil) (7786 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*print.wpLEL" print\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to print \\code{wpLEL}\n##'\n##' This function prints a \\code{wpLEL} object\n##' @param x object of class \\code{wpLEL} to be printed\n##' @param ... optional arguments for \\code{print} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nprint.wpLEL <- function(\n x,\n ...\n ) {\n print.default(x)\n invisible(x)\n}" nil) (7814 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.default.single" fitOptim\.wpLEL\.default\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.default.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL}} wind profile.\n##' @title fitOptim.wpLEL.default.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.default.single <- function(\n z,\n u,\n LAI,\n initial = c(dep=25, z0=0.8*28, na=9, zjoint=0.2*2),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n ) {\n ## Function to be minimised\n wpLELMin <- function(par, z, u, ua, h, za, z0sol) {\n if (\n isTRUE(\n parameterOK(\n z = z,\n ua = ua,\n dep = par[1], # par$dep,\n z0 = par[2], # par$z0,\n na = par[3], # par$na,\n zjoint = par[4], # par$zjoint\n h = h,\n za = za,\n z0sol = z0sol\n )\n )\n ) {\n p <- wpLELDefault(\n z = z,\n ua = ua,\n dep = par[1], # par$dep,\n z0 = par[2], # par$z0,\n na = par[3], # par$na,\n zjoint = par[4], # par$zjoint\n h = h,\n za = za,\n z0sol = z0sol,\n check = FALSE\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n } else {\n result <- NA\n }\n return( result )\n } \n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.default.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"dep\"],\n initial[\"z0\"],\n initial[\"na\"],\n initial[\"zjoint\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n ...\n )\n result$wp <- wpLELDefault(\n z = z,\n ua = ua,\n dep = result$fit$par[\"dep\"],\n z0 = result$fit$par[\"z0\"],\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (7942 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahat.single" fitOptim\.wpLEL\.mahat\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.mahat.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL.mahat} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL.mahat}} wind profile.\n##' @title fitOptim.wpLEL.mahat.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf area index\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahat.single <- function(\n z,\n u,\n LAI,\n initial = c(na=9, zjoint=0.2*2, y=3),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za, z0sol, LAI) {\n result <- NA\n try({\n p <- wpLELMahat(\n z = z,\n ua = ua,\n na = par[1], # na\n zjoint = par[2], # zjoint\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n y = par[3] # y\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.mahat.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"na\"],\n initial[\"zjoint\"],\n initial[\"y\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n ...\n )\n result$wp <- wpLELMahat(\n z = z,\n ua = ua,\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n y = result$fit$par[\"y\"]\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8053 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.LE.single" fitOptim\.wpLEL\.LE\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.LE.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values (\\code{u} and \\code{z}) to a \\code{link{wpLEL}} wind profile.\n##' @title fitOptim.wpLEL.LE.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.LE.single <- function(\n z,\n u,\n LAI,\n initial = c(dep=25, z0=0.8*28, na=9),\n h = 28,\n za = 37,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za) {\n result <- NA\n try({\n p <- wpLELLE(\n z = z,\n ua = ua,\n dep = par[1], # par$dep,\n z0 = par[2], # par$z0,\n na = par[3], # par$na,\n h = h,\n za = za\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.LE.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"dep\"],\n initial[\"z0\"],\n initial[\"na\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n## z0sol = z0sol,\n ...\n )\n result$wp <- wpLELLE(\n z = z,\n ua = ua,\n dep = result$fit$par[\"dep\"],\n z0 = result$fit$par[\"z0\"],\n na = result$fit$par[\"na\"],\n h = h,\n za = za\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8157 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahatLE.single" fitOptim\.wpLEL\.mahatLE\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.mahatLE.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL.mahatLE} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL.mahatLE}} wind profile.\n##' @title fitOptim.wpLEL.mahatLE.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahatLE.single <- function(\n z,\n u,\n LAI,\n initial = c(na=9, y=3),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za, z0sol, LAI) {\n result <- NA\n try({\n p <- wpLELMahatLE(\n z = z,\n ua = ua,\n na = par[1], # na\n h = h,\n za = za,\n LAI = LAI,\n y = par[2] # y\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.mahatLE.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"na\"],\n initial[\"y\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n ...\n )\n result$wp <- wpLELMahatLE(\n z = z,\n ua = ua,\n na = result$fit$par[\"na\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n y = result$fit$par[\"y\"]\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8264 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.castanea.single" fitOptim\.wpLEL\.castanea\.single ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.castanea.single.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} to a given wind profile using the\n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL}} wind profile.\n##' @title fitOptim.wpLEL.castanea.single\n##' @param z height at which wind speeds are measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param initial Initial values for the parameters to be optimized\n##' over (will be passed on to the \\code{\\link{optim}} function as\n##' \\code{par}). The parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=10, z0=0.2, na=2, zjoint=0.5)}\n##' @param h constant value for \\code{h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param za constant value for \\code{za} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefault()}\n##' @param ... further arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @return object of class \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used for fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.castanea.single <- function(\n z,\n u,\n LAI,\n initial = c(zjoint=0.2*2),\n h = 28,\n za = 37,\n z0sol = 0.001,\n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za, z0sol, LAI) {\n result <- NA\n try({\n p <- wpLELCastanea(\n z = z,\n ua = ua,\n zjoint = par[1], # par$zjoint\n h = h,\n za = za,\n z0sol = z0sol,\n LAI=LAI\n )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = TRUE\n )\n return( result )\n }\n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.castanea.single\"\n result$initial <- initial\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- optim(\n par = c(\n initial[\"zjoint\"]\n ),\n fn = wpLELMin,\n z = z,\n u = u,\n ua = ua,\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI,\n ...\n )\n result$wp <- wpLELCastanea(\n z = z,\n ua = ua,\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = LAI\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8370 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.default.multiple" fitOptim\.wpLEL\.default\.multiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.default.multiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param wso Wind speed profiles in the format as read from \\code{loadWS(wide=TRUE, ...)}\n##' @param initial initial\n##' @param h h\n##' @param za za\n##' @param z0sol z0sol \n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' @param ... additional arguments to be passed on to \\code{optim()}\n##' @return an oject of class \\code{wpFit} containing the result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.default.multiple <- function(\n wso,\n initial = c(dep=25, z0=0.8*28, na=9, zjoint=0.2*2),\n h = 28,\n za = 37,\n z0sol = 0.001,\n silentError = TRUE,\n ...\n ) {\n\n ## Function to be minimised\n minFUN <- function(\n par,\n ## ## passed in par:\n ## dep\n ## z0\n ## na\n ## zjoint\n ## ## passed in the other arguments:\n z,\n h, za, z0sol,\n ## the data to be fitted to\n wsFit\n ) {\n mse <- sapply(\n wsFit,\n function(u) {\n p <- NULL\n try( {\n p <- wpLELDefault(\n z = z,\n ua = u[length(u)],\n ##\n h = h,\n za = za,\n z0sol = z0sol,\n ## \n dep = par[1],\n z0 = par[2],\n na = par[3],\n zjoint = par[4]\n )\n },\n silent = silentError\n )\n if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)])^2 ) / length(p$u) ) \n } else {\n result <- NA\n }\n return( result )\n }\n )\n mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n mse <- sum( ( mse^2 ) / length(mse), na.rm=TRUE )\n } else {\n mse <- NA\n }\n return(mse)\n }\n \n ## construct result list\n result <- list()\n result$method <- \"fitOptim.wpLEL.default.multiple\"\n result$initial <- initial\n result$dot <- list(...)\n ## result$z <- z\n ## result$u <- u\n ## Do the optimisation\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n result$fit <- optim(\n par = initial,\n fn = minFUN,\n ##\n z = z,\n h = h,\n za = za,\n z0sol = z0sol,\n ##\n wsFit = wso,\n ...\n )\n ## calculate sample wind profile\n if ( (length(z) > 0) & (is.numeric(z)) ) {\n z <- seq(0.1, max(z), 0.1)\n } else {\n z <- seq(0.1, 37, 0.1)\n }\n result$wp <- wpLELDefault(\n z = z,\n ua = mean(wso[2,][[1]]),\n dep = result$fit$par[\"dep\"],\n z0 = result$fit$par[\"z0\"],\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol\n )\n ##\n \n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8502 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahat.multiple" fitOptim\.wpLEL\.mahat\.multiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.mahat.multiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param wso Wind speed profiles in the format as read from \\code{loadWS(wide=TRUE, ...)}\n##' @param initial initial parameter values for fit \n##' @param h height\n##' @param za za\n##' @param z0sol z0sol\n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' @param ... additional values to be passed on to \\code{optim}\n##' @return an object of class \\code{wpFit} containing the result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahat.multiple <- function(\n wso,\n initial = c(na=9, zjoint=0.2*2, y=3),\n h = 28,\n za = 37,\n z0sol = 0.001,\n silentError = TRUE,\n ...\n ) {\n \n ## Function to be minimised\n minFUN <- function(\n par,\n ## ## passed in par:\n ## na\n ## zjoint\n ## y\n ## ## passed in the other arguments:\n z,\n h, za, z0sol,\n ## the data to be fitted to\n wsFit\n ) {\n mse <- sapply(\n wsFit,\n function(u) {\n p <- NULL\n try( {\n p <- wpLELMahat(\n z = z,\n ua = u[length(u)],\n na = par[1],\n zjoint = par[2],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = u[[1]],\n y = par[3]\n )\n },\n silent = silentError\n )\n if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)])^2 ) / length(p$u) ) \n } else {\n result <- NA\n }\n return( result )\n }\n )\n mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n mse <- sum( ( mse^2 ) / length(mse), na.rm=TRUE )\n } else {\n mse <- NA\n }\n return(mse)\n }\n \n ## construct result list\n result <- list()\n result$method <- \"fitOptim.wpLEL.mahat.multiple\"\n result$initial <- initial\n result$dot <- list(...)\n ## result$z <- z\n ## result$u <- u\n ## Do the optimisation\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n result$fit <- optim(\n par = initial,\n fn = minFUN,\n ##\n z = z,\n h = h,\n za = za,\n z0sol = z0sol,\n ##\n wsFit = wso,\n ...\n )\n ## calculate sample wind profile\n if ( (length(z) > 0) & (is.numeric(z)) ) {\n z <- seq(0.1, max(z), 0.1)\n } else {\n z <- seq(0.1, 37, 0.1)\n }\n result$wp <- wpLELMahat(\n z = z,\n ua = mean(as.numeric(wso[2,])),\n na = result$fit$par[\"na\"],\n zjoint = result$fit$par[\"zjoint\"],\n h = h,\n za = za,\n z0sol = z0sol,\n LAI = mean(as.numeric(wso[1,])),\n y = result$fit$par[\"y\"]\n )\n ##\n \n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8634 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.ownFree.multiple" fitOptim\.wpLEL\.ownFree\.multiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.ownFree.multiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param wso Wind speed profiles in the format as read from \\code{loadWS(wide=TRUE, ...)}\n##' @param initial initial parameter values for \\code{optim()}\n##' @param z0 z0\n##' @param na na\n##' @param zjoint zjoint \n##' @param h h\n##' @param za za\n##' @param z0sol z0sol\n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' @param ... additional argumaents to be passed to \\code{optim}\n##' @return an oject of class \\code{wpFit} containing the result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.ownFree.multiple <- function(\n wso,\n initial = unlist(\n list(\n dep = c(a=0.5, b=0.02, c=-2),\n z0 = c(a=0.23, b=0.25, c=10),\n na = c(a=0.23, b=0.25, c=10),\n zjoint = c(a=0.23, b=0.25, c=10)\n )\n ),\n h = 28,\n za = 37,\n z0sol = 0.001,\n silentError = TRUE,\n ...\n ) {\n\n ## Function to be minimised\n minFUN <- function(\n par,\n ## ## passed in par:\n ## dep.a, dep.b, dep.c,\n ## z0.a, z0.b, z0.c,\n ## na.a, na.b, na.c,\n ## zjoint.a, zjoint.b, zjoint.c,\n ## ## passed in the other arguments:\n z,\n h, za, z0sol,\n ## the data to be fitted to\n wsFit\n ) {\n mse <- sapply(\n wsFit,\n function(u) {\n p <- NULL\n try( {\n p <- wpLELOwnFree(\n z = z,\n ua = u[length(u)],\n ##\n h = h,\n za = za,\n z0sol = z0sol,\n ## .a .b .c\n dep.a = par[ 1], dep.b = par[ 2], dep.c = par[ 3],\n z0.a = par[ 4], z0.b = par[ 5], z0.c = par[ 6],\n na.a = par[ 7], na.b = par[ 8], na.c = par[ 9],\n zjoint.a = par[10], zjoint.b = par[11], zjoint.c = par[12],\n LAI = u[[1]]\n )\n },\n silent = silentError\n )\n if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)])^2 ) / length(p$u) ) \n } else {\n result <- NA\n }\n return( result )\n }\n )\n ## maxMse <- quantile(mse, probs=c(0, (1 - exclHighMseProp), 0.5, 1))\n ## mse <- mse[mse <= maxMse[2]]\n mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n mse <- sum( ( mse^2 ) / length(mse), na.rm=TRUE )\n } else {\n mse <- NA\n }\n ## print(mse)\n return(mse)\n }\n \n ## construct result list\n result <- list()\n result$method <- \"fitOptim.wpLEL.ownFree.multiple\"\n result$initial <- initial\n result$dot <- list(...)\n result$wpLELParameter <- list(\n h = h,\n za = za,\n z0sol = z0sol\n )\n ## result$z <- z\n ## result$u <- u\n ## Do the optimisation\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n result$fit <- optim(\n par = initial,\n fn = minFUN,\n ##\n z = z,\n h = h,\n za = za,\n z0sol = z0sol,\n ##\n wsFit = wso,\n ...\n )\n ## calculate sample wind profile\n if ( (length(z) > 0) & (is.numeric(z)) ) {\n z <- seq(0.1, max(z), 0.1)\n } else {\n z <- seq(0.1, 37, 0.1)\n }\n \n class(result) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8772 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Goodness%20of%20fit%20for%20wpLELFit" Goodness\ of\ fit\ for\ wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/gof.wpLELfit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Calculate goodnes of fit of fit compared to object of class \\code{wpLELFit}\n##'\n##' Uses gofFun to calculate the goodnes of fit between \\code{fit} and\n##' the observed wind profile \\code{wp}\n##' \n##' @title gof.wpLELfit\n##' @param fit fit of the wind profile of the type \\code{wpLELFit}\n##' @param wp wind profile as returned in the wide format of \\code{loadWS}\n##' @param gofFun function returning the goodnes of fit.\n##' @param silentError sielence error message during fitting. Fitting\n##' is done in a \\code{try()} block so this is purely cosmetical and\n##' affects the verbosity.\n##' This function accepts the two argumentsa \\code{obs, exp}.\n##' These can be assumed of being of the same length. An example is the =default function:\n##' \n##' \\code{ function(obs, exp){ sum( ( (exp - obs)^2 ) / length(obs) ) } }\n##' \n##' @return vector of the goodnes of fit values, one per row in \\code{wp}\n##' @author Rainer M. Krug\n##' @export\ngof.wpLELFit <- function(\n fit,\n wp,\n gofFun = function(obs, exp){ sum( ( (exp - obs)^2 ) / length(obs), na.rm=TRUE ) },\n silentError = TRUE\n ) {\n gofs <- sapply(\n 1:nrow(wp),\n function(i) {\n o <- dfFromLong(wp[i,])\n names(o)[ncol(o)] <- \"ws\"\n gof <- NA\n try( {\n e <- wpLEL(\n fit$wp,\n z = o$z,\n ua = wp[i, \"ua\"],\n LAI = wp[i,\"lai\"]\n )\n gof <- gofFun(\n obs = o$ws,\n exp = e$u\n )\n gof\n },\n silent = silentError\n )\n return(gof)\n\n }\n )\n}" nil) (8832 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.wpLELFit" plot\.wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to plot \\code{wpLELFit}\n##'\n##' This function a \\code{wpLELFit} object by plotting the fitted line\n##' smoothly and adding the original points to the graph.\n##' @param x object of class \\code{wpLELFit} to be plotted \n##' @param z numeric vector at which the line should be calculated. If\n##' missing, \\code{x$z} will be used. the more points, the smoother\n##' the line.\n##' @param plotWPValues if \\code{TRUE}, the values and value lines are\n##' drawn\n##' @param plotWPLines if \\code{TRUE}, the lines of the profile are drawn\n##' @param plotOrgPoints if \\code{TRUE}, the original points are drawn\n##' @param add if \\code{TRUE}, the plot wil be added to an existing plot\n##' @param ... additional arguments for plotting the \\bold{original} points of the fit using the \\code{poiunts} function\n##' are plotted\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nplot.wpLELFit <- function(\n x,\n z,\n plotWPValues = TRUE,\n plotWPLines = TRUE,\n plotOrgPoints = TRUE,\n add = FALSE,\n ...\n ) {\n xu <- x$wp\n ## plot values (dep, ...)\n plot.wpLEL(\n xu,\n z,\n plotWPValues = plotWPValues,\n plotWPPoints = FALSE,\n plotWPLines = FALSE,\n add = add\n )\n ## plot fitted lines \n plot.wpLEL(\n xu,\n z,\n plotWPValues = FALSE,\n plotWPPoints = FALSE,\n plotWPLines = plotWPLines,\n add = TRUE\n )\n ## plot original points \n points(\n x$u,\n x$z,\n type = ifelse(plotOrgPoints, \"p\", \"n\"),\n ...\n )\n}" nil) (8890 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*print.wpLELFit" print\.wpLELFit:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLELFit.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to print \\code{wpLELFit}\n##'\n##' This function prints a \\code{wpLELFit} object\n##' @param x object of class \\code{wpLELFit} to be printed\n##' @param ... optional arguments for \\code{print} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nprint.wpLELFit <- function(\n x,\n ...\n ) {\n print.default(x)\n invisible(x)\n}" nil) (8920 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpFitEach" wpFitEach ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpFitEach.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title wpLELFitEach\n##' @param new if \\code{TRUE} the cache is re-created - if\n##' \\code{FALSE} the results are read from the cache.\n##' @param suffix suffix for cache\n##' @param FUN name of the function to be used for fitting. It has to\n##' take the arguments \\code{z} and \\code{u}, but can also take\n##' additional arguments.\n##' @param cores number of cores to be used for analysis - defaults to the number of cores mius one, but is at least 1.\n##' @param minSpeedIncreaseWide minimum wind speed difference - see \\link{loadWS} for details\n##' @param maxWindSpeedWide maximum wind speed - see \\link{loadWS} for details\n##' @param maxWindSpeedOneWide standardise highest sampled wind speed to one - see \\link{loadWS} for details\n##' @param WAI Wood Area Index, argument \\code{WAI} of function\n##' \\code{loadWS()}. Will be added to lai from raw data.\n##' @param selectWPFit a function returning \\bold{a vector} where each\n##' element represents the indices of loaded wind profiles which will\n##' be used for fitting the parameter. The function takes one value,\n##' i.e. \\code{wso} which is the \\code{data.frame} of the loaded wind\n##' profiles, as returned by the function\n##'\n##' code{\n##' wso <- loadWS(\n##' wide = TRUE,\n##' onlyComplete = TRUE,\n##' minSpeedIncreaseWide,\n##' maxWindSpeedWide,\n##' maxWindSpeedOneWide,\n##' WAI = WAI\n##' )\n##' }\n##'\n##' Examples are:\n##'\n##' \\code{selectWPFit = function(wso){TRUE}}\n##'\n##' which would select all elements in \\code{wso}.This is the default.\n##' \n##' \\code{selectWPFit = function(wso){sample(1:nrow(wso), 100)}}\n##' \n##' which would create vector of 100 randomly selected wind profiles\n##' \\bold{selected} for fitting or\n##'\n##' \\code{selectWPFit = function(wso){-sample(1:nrow(wso), 500)}}\n##'\n##' which would create vector of 500 randomly selected wind profiles\n##' \\bold{excluded} from fitting\n##'\n##' @param ... additional arguments passed to FUN\n##' @return an oject of class \\code{wpLELFitList} (i.e. \\code{list}) of\n##' the length of the number wind profiles to fit. Each element\n##' contains the result of an individual fit.\n##' @author Rainer M. Krug\n##' @export\nwpFitEach <- function(\n new = FALSE,\n suffix = \"\",\n FUN = \"wpLEFitSingle\",\n cores = detectCores() - 1,\n minSpeedIncreaseWide = 0,\n maxWindSpeedWide = 10,\n maxWindSpeedOneWide = FALSE,\n WAI = 0,\n selectWPFit = function(wso) { TRUE },\n ...\n ) {\n if (cores==0) {\n cores <- 1\n }\n fn <- paste0(CACHE, \"/wpFitEach.\", FUN, suffix, \".rds\")\n FUN <- get(FUN)\n if (new) {\n unlink(fn)\n }\n if (file.exists(fn)) {\n dat <- readRDS(fn)\n } else {\n ## Load wind priofile data\n wso <- loadWS(\n wide = TRUE,\n onlyComplete = TRUE,\n minSpeedIncreaseWide,\n maxWindSpeedWide,\n maxWindSpeedOneWide,\n WAI = WAI\n )\n \n ## #################################\n ## From now on, LAI (later u[[1]]) is LAI = LAI + WAI)\n ## #################################\n\n ## Get indices for fitting. Must only be done once as the\n ## functions might contain random number generation!\n indFit <- selectWPFit(wso)\n\n ## Save \"metadata\"\n ## construct result list\n md <- list()\n md$method <- \"wpFitEach\"\n md$FUN <- FUN\n md$loadWSParm <- list(\n minSpeedIncreaseWide = minSpeedIncreaseWide,\n maxWindSpeedWide = maxWindSpeedWide,\n maxWindSpeedOneWide = maxWindSpeedOneWide,\n WAI = WAI\n )\n md$selectWPFit <- list(\n fun = selectWPFit,\n indices = indFit\n )\n md$dot <- list(...)\n saveRDS(md, paste0(fn, \".metadata.rds\"))\n \n z <- dfFromLong(wso[1,])$z \n ws <- wso[,grep(\"^h[[:digit:]]\", names(wso))]\n ws <- cbind(ua=wso$ua, ws)\n ws <- cbind(lai=wso$lai, ws)\n ws <- as.data.frame(t(ws))\n \n ##\n i <- 0\n no <- ceiling(ncol(ws) / cores)\n dat <- mclapply(\n ws[,indFit],\n function(u) {\n f <- FUN(\n z = z,\n u = u[-(1:2)],\n LAI = u[1],\n ...\n )\n if (!is.null(f)) {\n f$lai <- u[1]\n f$ua <- u[2]\n }\n i <<- i + 1\n if (round(i, -2)==i){\n cat(i, \"\\tof about\\t\", no, \"\\r\")\n }\n return(f)\n },\n mc.cores = cores\n )\n class(dat) <- c(\"wpLELFitList\", class(dat))\n saveRDS(dat, fn)\n }\n if (!(\"wpLELFitList\" %in% class(dat))) {\n class(dat) <- c(\"wpLELFitList\", class(dat))\n }\n return(dat)\n}" nil) (9085 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpFitMultiple" wpFitMultiple ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpFitMultiple.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wind profiles using the function\n##' \\code{loadWS} and fits each one using the function\n##' \\code{FUN}. The results are stored in \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each single\n##' one using the function provided in \\code{FUN}. Results are cached.\n##' @title wpLELFitEach\n##' @param new if \\code{TRUE} the cache is re-created - if\n##' \\code{FALSE} the results are read from the cache.\n##' @param suffix suffix for cache\n##' @param FUN Name of function to be used for fitting TODO\n##' @param cores number of cores to be used for analysis - defaults to the number of cores mius one, but is at least 1.\n##' @param minSpeedIncreaseWide minimum wind speed difference - see \\link{loadWS} for details\n##' @param maxWindSpeedWide maximum wind speed - see \\link{loadWS} for details\n##' @param maxWindSpeedOneWide standardise highest sampled wind speed to one - see \\link{loadWS} for details\n##' @param WAI Wood Area Index, argument \\code{WAI} of function\n##' \\code{loadWS()}. Will be added to lai from raw data.\n##' @param minUstar minimum value of ustar for wind profiles to be\n##' included. Values smaller than 0 will include all wind profiles.\n##' @param selectWPFit a function returning \\bold{a list} where each\n##' element of the list represents the indices of loaded wind profiles\n##' which will be used for fitting the parameter. The function takes\n##' one value, i.e. \\code{wso} which is the \\code{data.frame} of the\n##' loaded wind profiles, as returned by the function\n##'\n##' code{\n##' wso <- loadWS(\n##' wide = TRUE,\n##' onlyComplete = TRUE,\n##' minSpeedIncreaseWide,\n##' maxWindSpeedWide,\n##' maxWindSpeedOneWide,\n##' WAI = WAI\n##' )\n##' }\n##'\n##' An exapmle is\n##'\n##' \\code{selectWPFit = function(wso){lapply(1:5, function(x){sample(1:nrow(wso), 100)})}}\n##' \n##' which would create a list of 5 elements where each consists of 100\n##' randomly selected wind profiles \\bold{selected} for fitting or\n##'\n##' \\code{selectWPFit = function(wso){lapply(1:10, function(x){-sample(1:nrow(wso), 500)})}}\n##'\n##' which would create a list of 10 elements where each consists of 500\n##' randomly selected wind profiles \\bold{excluded} from fitting\n##'\n##' @param ... additional parameter passed to FUN ( mainly for the function \\code{optim()} )\n##' @return an oject of class \\code{wpLELFitList} (i.e. \\code{list}) of\n##' the length of the number wind profiles to fit. Each element\n##' contains the result of an individual fit.\n##' @author Rainer M. Krug\n##' @export\nwpFitMultiple <- function(\n new = FALSE,\n suffix = \"\",\n FUN = \"fitOptim.wpLEL.ownFree.multiple\",\n cores = detectCores() - 1,\n minSpeedIncreaseWide = 0,\n maxWindSpeedWide = 10,\n maxWindSpeedOneWide = FALSE,\n minUstar = 0.25,\n WAI = 0,\n selectWPFit = function(wso) { lapply(1:5, function(x){sample(1:nrow(wso), 100)}) },\n ...\n ) {\n if (cores==0) {\n cores <- 1\n }\n fn <- paste0(CACHE, \"/wpFitMultiple.\", FUN, suffix, \".rds\")\n FUN <- get(FUN)\n if (new) {\n unlink(fn)\n }\n if (file.exists(fn)) {\n dat <- readRDS(fn)\n } else {\n\n ## Load Wind Profiles\n wso <- loadWS(\n wide = TRUE,\n onlyComplete = TRUE,\n minSpeedIncreaseWide = minSpeedIncreaseWide,\n maxWindSpeedWide = maxWindSpeedWide,\n maxWindSpeedOneWide = maxWindSpeedOneWide,\n minUstar = minUstar,\n WAI = WAI\n )\n \n ## #################################\n ## From now on, LAI (later u[[1]]) is LAI = LAI + WAI)\n ## #################################\n\n ## Get indices for fitting. Must only be done once as the\n ## functions might contain random number generation!\n indFit <- selectWPFit(wso)\n\n ## Save \"metadata\"\n ## construct result list\n md <- list()\n md$method <- \"wpFitMultiple\"\n md$FUN <- FUN\n md$loadWSParm <- list(\n minSpeedIncreaseWide = minSpeedIncreaseWide,\n maxWindSpeedWide = maxWindSpeedWide,\n maxWindSpeedOneWide = maxWindSpeedOneWide,\n minUstar = minUstar,\n WAI = WAI\n )\n md$selectWPFit <- list(\n fun = selectWPFit,\n indices = indFit\n )\n md$dot <- list(...)\n saveRDS(md, paste0(fn, \".metadata.rds\"))\n \n ## Format the data\n z <- dfFromLong(wso[1,])$z \n ws <- wso[,grep(\"^h[[:digit:]]\", names(wso))]\n ws <- cbind(ua=wso$ua, ws)\n ws <- cbind(lai=wso$lai, ws)\n ws <- as.data.frame(t(ws))\n\n ## Do the fitting\n i <- 0\n no <- ceiling(ncol(ws) / cores)\n dat <- mclapply(\n indFit,\n function(s) {\n f <- FUN(\n wso = ws[,s],\n ...\n )\n i <<- i + 1\n if (round(i, -2)==i){\n cat(i, \"\\tof about\\t\", no, \"\\r\")\n }\n return(f)\n },\n mc.cores = cores\n )\n class(dat) <- c(\"wpLELFitList\", class(dat))\n saveRDS(dat, fn)\n }\n if (!(\"wpLELFitList\" %in% class(dat))) {\n class(dat) <- c(\"wpLELFitList\", class(dat))\n }\n return(dat)\n}" nil) (9242 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.wpLELFitList" plot\.wpLELFitList:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFitList.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to plot \\code{wpLELFitList}\n##'\n##' This function plots an \\code{wpLELFitList} object by plotting the\n##' lines of each fit on each other. The indices can be specified by\n##' using y.\n##' @param x object of class \\code{wpLELFitList} to be plotted \n##' @param y default \\code{NULL}; numeric vector of indices specifying\n##' the fits in \\code{x} to be plotted. If \\code{NULL} all will be plotted.\n##' @param ... optional arguments for \\code{plot} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nplot.wpLELFitList <- function(\n x,\n y = NULL,\n ...\n ) {\n if (is.null(y)) {\n y <- 1:length(x)\n }\n plot(\n x[[1]],\n add = FALSE,\n ...\n )\n ##\n for (i in y[-1]) {\n plot(\n x[[i]],\n add = TRUE,\n ...\n )\n }\n invisible()\n}" nil) (9283 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*print.wpLELFitList" print\.wpLELFitList:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLELFitList.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function to print \\code{wpLELFitList}\n##'\n##' This function prints a \\code{wpLELFitList} object\n##' @param x object of class \\code{wpLELFitList} to be printed\n##' @param ... optional arguments for \\code{print} method\n##' @return NULL\n##' @author Rainer M. Krug\n##' @export\nprint.wpLELFitList <- function(\n x,\n ...\n) {\n cat( \"Number of fits: \" )\n cat(length(x), \"\\n\")\n invisible(x)\n}" nil) (9311 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*airRest%20Generic%20function%20definition" airRest\ Generic\ function\ definition:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/airRest.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "airRest <- function(x, zsource) UseMethod(\"airRest\")" nil) (9318 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*airRest.wpLEL" airRest\.wpLEL ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/airRest.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic function for \\code{airRest} to calculate aerial resistance\n##'\n##' Calculate aerial resistance based on \\code{wpLEL} object\n##' @param x object of class \\code{wpLEL}\n##' @param zsource if \\code{NULL} (default), \\code{zsource = z0 + dep}, unless the numerical value\n##' @return object of class \\code{airRest}.\n##' This object contains the following elements:\n##' \\itemize{\n##' \\item{method} : {the method used to generate the aerial profile (the name of this function)}\n##' \\item{wp} : {the wind profile on which the aerial resistance is based}\n##' \\item{I1} : {aerial resistance top log profile}\n##' \\item{I2} : {aerial resistance from h to zsource}\n##' \\item{I3} : {aerial resistance for exp profile}\n##' \\item{I4} : {aerial resistance lower exp profile}\n##' \\item{ras} : {aerial resistance from z0sol to top}\n##' \\item{rac} : {aerial resistance from zsource to za}\n##' }\n##' @author Rainer M. Krug\n##' @export\nairRest.wpLEL <- function(\n x,\n zsource = NULL\n) {\n ## resistance top log profile\n ## LEL - from za (very top) to dep (above canopy, log profile)\n ## LE - from za (very top) to dep (above canopy, log profile)\n I1 <- 1 / (x$vk*x$ustar) * log( (x$za-x$dep)/(x$h-x$dep) )\n\n ## resistance for exp profile\n ## LEL - from dep to zjoint (into canopy, exp profile)\n ## LE - from dep to z0sol (into canopy, exp profile)\n if (x$zjoint == 0) {\n ## log-exp profile\n I3 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp( x$na * (1 - x$z0sol/x$h) ) - 1 )\n } else {\n ## log-exp-log profile\n I3 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp( x$na * (1 - x$zjoint/x$h) ) - 1 )\n }\n\n ## resistance lower exp profile\n ## LEL - from zjoint to z0sol\n ## LE - 0\n if (x$zjoint == 0) {\n ## log-exp profile\n I4 <- 0\n } else {\n ## log-exp-log profile\n I4 <- 1 / (x$vk*x$ustarsol) * log( x$zjoint/x$z0sol )\n }\n ##\n\n ## resistance from z0sol to za\n ras = I1 + I3 + I4\n\n\n ## resistance from h to zsource (into canopy, exp profile or exp-log profile depending if zsource > zjoint or not)\n ## LEL (zsource > zjoint) - exp profile\n ## LEL (zsource < zjoint) - exp & log profile\n ## LE - exp profile\n if (is.null(zsource)) {\n zsource <- x$z0 + x$dep \n }\n if (x$zjoint==0) {\n ## log-exp profile\n I2 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp(x$na*(1 - zsource/x$h)) - 1 )\n } else {\n ## log-exp-log profile\n if (zsource < x$zjoint) {# never happen\n I2_1 <- ( 1/(x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp(x$na*(1 - x$zjoint/x$h)) - 1 )\n I2_2 <- ( 1/(x$vk*x$ustarsol) ) * ( log(x$zjoint/zsource) )\n I2 <- I2_1 + I2_2\n } else {\n I2 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( exp(x$na*(1- (zsource)/x$h)) - 1 )\n }\n }\n ##\n ## resistance from zsource to za\n rac <- I1 + I2\n\n ar <- list()\n ar$method <- \"airRest.wpLEL\"\n ar$wp <- x\n ar$I1 <- I1\n ar$I2 <- I2\n ar$I3 <- I3\n ar$I4 <- I4\n ar$ras <- ras\n ar$rac <- rac\n class(ar) <- \"airRest\"\n return(ar)\n}" nil) (9414 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.arLEL" plot\.arLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.arLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "plot.arLEL <- function(\n x,\n plotWPPoints = TRUE,\n plotWPValues = TRUE,\n plotARValues = TRUE,\n ...\n) {\n plot.wpLEL(\n x,\n plotWPPoints = plotWPPoints,\n plotWPValues = plotWPValues,\n ...\n )\n if (plotARValues) {\n mx <- par(\"usr\")[2]\n with(\n x,\n {\n ## arrows(\n ## x0 = c(0, 0, 0 ,0 ,0 ,0),\n ## y0 = c(z0+dep, za, h, hsource, dep, zjoint),\n ## x1 = c(4, 4, 4 ,4 ,4 ,4),\n ## y1 = c(z0+dep, za, h, hsource, dep, zjoint),\n ## length = 0,\n ## col = \"grey\",\n ## lty = \"dotted\"\n ## )\n \n \n text(mx*0.4, (za+h)/2., paste(\"R1=\", round(R1, 2) ) )\n text(mx*0.65, (z0h+dep+h)/2., paste(\"R2z0h=\", round(R2z0h, 2), \"R2z0=\", round(R2z0, 2) ) )\n text(mx*0.6, (z0+h)/2., paste(\"R3=\", round(R3, 2) ) )\n text(mx*0.6, (2*z0+h)/3., paste(\"R4log=\", round(R4log, 2), \"R4exp=\", round(R4exp, 2) ) )\n text(mx*0.5, 2, paste(\"racz0h=\", round(racz0h, 2), \"racz0=\", round(racz0, 2) ) )\n text(mx*0.5, 1, paste(\"raslog=\", round(raslog, 2), \"rasexp=\", round(rasexp, 2) ) )\n }\n )\n }\n invisible(NULL)\n}" nil) (9464 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans%20Generic%20function%20definition" evapoTrans\ Generic\ function\ definition:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans <- function(x) UseMethod(\"evapoTrans\")" nil) (9471 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.default" evapoTrans\.default:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.default.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans.default <- function(\n ras,\n rac,\n Ta = 20,\n frach = 1,\n Rnhsol = 600,\n RH = 50, # deltae = 5,\n gsol = 0.001\n) {\n ## mb (Monteith, 1990)\n es <- 6.1078 * exp( 17.269 * Ta/(Ta+ 237.3) ) # mb\n ea <- es * RH/100\n deltae <- es - ea\n Landah <- -2.37273 * Ta + 2501 # J.g-1\n Cph <- 1.01 # J.g-1.degreeC-1\n Rauh <- -4.111 * Ta + 1289.764 # g/m3\n Psyh <- Rauh * Cph * 8.31 * (Ta + 273.15) / (100*18*Landah) # mb.degreeC-1\n deltah <- Landah * 18 * es / ( 8.31 * (Ta + 273.15)^2 ) # mb.degreetC-1 Monteith p.10\n \n ## ETR du sol\n ETRhrsol <- frach * 3.6 *\n (deltah * Rnhsol) /\n (Landah * (deltah + Psyh * (1 + 1/(gsol * ras) )))\n ETRhcsol <- frach * 3.6 *\n (Rauh * Cph * deltae/ras) /\n (Landah * (deltah + Psyh * (1 + 1/(gsol * ras) )))\n ETRhsol <- ETRhrsol+ETRhcsol\n\n ## ETP couvert\n ETPch <- frach * 3.6 *\n (Rauh * Cph * deltae / rac) /\n ( Landah * (deltah + Psyh) )\n etp <- list(\n etrHrsol = ETRhrsol,\n etrHcsol = ETRhcsol,\n etrHsol = ETRhsol,\n etpCh = ETPch\n )\n etp$input <- list(\n ras = ras,\n rac = rac,\n Ta = Ta,\n frach = frach,\n Rnhsol = Rnhsol,\n RH = RH,\n gsol = gsol\n )\n class(etp) <- c(\"evapoTrans\", \"list\")\n attr(etp, \"method\") <- \"default\"\n return( etp )\n}" nil) (9530 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.airRest" evapoTrans\.airRest:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.airRest.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans.airRest <- function(\n x,\n Ta = 20,\n frach = 1,\n Rnhsol = 600,\n RH = 50, # deltae = 5,\n gsol = 0.001\n) {\n etp <- evapoTrans.default(\n ras = x$ras,\n rac = x$rac,\n Ta = Ta,\n frach = frach,\n Rnhsol = Rnhsol,\n RH = RH,\n gsol = gsol\n )\n etp$input$airRest <- x\n attr(etp, \"method\") <- \"airRest\"\n return( etp )\n}" nil) (9559 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.wpLEL" evapoTrans\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.wpLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans.wpLEL <- function(\n x,\n Ta = 20,\n frach = 1,\n Rnhsol = 600,\n RH = 50, # deltae = 5,\n gsol = 0.001\n) {\n etp <- evapoTrans.airRest(\n x = airRest(x),\n Ta = Ta,\n frach = frach,\n Rnhsol = Rnhsol,\n RH = RH,\n gsol = gsol\n )\n attr(etp, \"method\") <- \"wpLEL\"\n return( etp )\n}" nil) (9588 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*lhc.etp.R" lhc\.etp ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/lhc.etp.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL} and calculates the aeril resistance.\n##'\n##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL}. The object \\code{x} is used at a template to fill in\n##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL} and calculates the aeril resistance.\n##'\n##' Create latin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL}. The object \\code{x} is used at a template to fill in\n##' the missing values.\n##' @title lhc.wpLEL\n##' @param x object of type \\code{wpLEL} which will be used as a\n##' template for the returned Latin Hyper Cube \n##' @param n size of Latin Hypercube sample\n##' @param Min list of named named elements for minimum value of each column in the\n##' Latin Hypercube. \\code{names(Min)} has to be the same as \\code{names(Max)}!\n##' @param Max list of named named elements for maximum values for each column in the\n##' Latin Hypercube. \\code{names(Min)} has to be the same as \\code{names(Max)}!\n##' @param suffix suffix for file in cache\n##' @param new if \\code{TRUE} the cache is recreated, if \\code{FALSE}, the\n##' default, the cached values will be read\n##' @param cores number of cores to be used for the evaluation\n##' @return returns Latin Hypercube \\code{data.frame}\n##' @author Rainer M. Krug\n##' @export\nlhc.etp <- function(\n x,\n n,\n Min,\n Max,\n suffix,\n new = FALSE,\n cores = parallel::detectCores() - 1\n) {\n if (missing(suffix)) {\n suffix <- paste0(\".\", paste(names(Min), sep = \"\", collapse=\"-\"))\n } else {\n suffix <- paste0(\".\", paste(names(Min), sep = \"\", collapse=\"-\"), suffix)\n }\n fn <- paste0(CACHE, \"/lhc.etp.\", x$parametrization, suffix, \".rds\")\n if (new) {\n unlink(fn)\n }\n if (file.exists(fn)) {\n result <- readRDS(fn)\n } else {\n if (length(Min) != length(Max)) {stop(\"Min and Max have to have the same length!\")}\n if (!all.equal(names(Min), names(Max) )) {stop(\"Min and Max have to have the same names!\")}\n ## Build random Latin Hypercube\n dat <- lhs::randomLHS(n=n, k=length(Min))\n colnames(dat) <- names(Min)\n ## Transform the 0..1 values to the selected range\n dat <- sweep(\n x = dat,\n MARGIN = 2,\n Max-Min,\n '*'\n )\n dat <- sweep(\n x = dat,\n MARGIN = 2,\n Min,\n '+'\n )\n ## ## Exculde cases where conditions 6) and 7) are not met\n ## if (all(c(\"z0\", \"dep\", \"zjoint\") %in% names(Min))) {\n ## depz0 <- dat[,\"dep\"] + dat[,\"z0\"]\n ## i <- depz0 < h & depz0 > dat[,\"zjoint\"]\n ## dat <- dat[i,]\n ## }\n\n dat <- as.data.frame(t(dat))\n ##\n wphelp <- function(...) {wpLEL.wpLEL(x, ...)}\n no <- ceiling(ncol(dat) / cores)\n i <- 0\n result <- mclapply(\n dat,\n function(s) {\n names(s) <- rownames(dat)\n s <- as.list(s)\n s$wp <- do.call(wphelp, s)\n \n depz0 <- s$wp[[\"dep\"]] + s$wp[[\"z0\"]]\n if (depz0 < s$wp[[\"h\"]] & depz0 > s$wp[[\"zjoint\"]]) {\n ar <- airRest(s$wp)\n etp <- evapoTrans.airRest(\n x = ar,\n Ta = s[[\"Ta\"]],\n frach = 1,\n Rnhsol = s[[\"Rnhsol\"]],\n RH = s[[\"RH\"]],\n gsol = s[[\"gsol\"]]\n )\n ##\n s$I1 <- ar$I1\n s$I2 <- ar$I2\n s$I3 <- ar$I3\n s$I4 <- ar$I4\n s$ras <- ar$ras\n s$rac <- ar$rac\n ##\n s$etrHrsol <- etp$etrHrsol\n s$etrHcsol <- etp$etrHcsol\n s$etrHsol <- etp$etrHsol\n s$etpCh <- etp$etpCh\n class(s) = c(\"lhcAirRest\", class(s))\n } else {\n s <- NULL\n }\n i <<- i + 1\n if (round(i, -2) == i) {\n cat(i, \"\\t of about \\t\", no, \"\\t\\t\\r\")\n }\n return(s)\n },\n mc.cores = cores\n )\n cat(\"\\n\")\n result <- result[!sapply(result, is.null)]\n saveRDS(result, fn)\n }\n return(result)\n}" nil) (9720 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*tests" tests:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./tests/wpLELTest.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "## stopifnot(require(energyBalance))\n\n## Tolerance for numerical comparisons\nepsilon <- 1.0e-9\n\nua <- 3.136\nza <- 37\nz <- seq(\n from = 0,\n to = za,\n by = 0.1\n)\n\n## Test 1\nu <- wpLEL(\n z,\n ua = ua,\n dep = 14,\n z0 = 2.8,\n na = 7,\n zjoint = 14.31625,\n h = 28,\n za = 37,\n z0sol = 0.01\n)\nu.s <- readRDS(\"./tests/u.rds\")\nstopifnot( max(abs(unlist(u) - unlist(u.s)), na.rm=TRUE ) < epsilon)\n\nu <- airRest(u)\nu.s <- readRDS(\"./tests/u.ar.rds\")\nstopifnot( max(abs(unlist(u) - unlist(u.s)), na.rm=TRUE ) < epsilon)\n\n## Test 2\nWAI <- 0.5\nLAI <- 0\nu1 <- wpLEL(\n z,\n ua = ua,\n dep = function(PAI) {1.1*h*log(1+(Cd*PAI)^0.25)},\n PAI = WAI + LAI\n)\nu1.s <- readRDS(\"./tests/u1.rds\")\nstopifnot( max(abs(unlist(u1) - unlist(u1.s)), na.rm=TRUE ) < epsilon)\n\nu1 <- airRest(u1)\nu1.s <- readRDS(\"./tests/u1.ar.rds\")\nstopifnot( max(abs(unlist(u1) - unlist(u1.s)), na.rm=TRUE ) < epsilon)\n\n## Test 3\nWAI <- 0.5\nLAI <- 6\nu2 <- wpLEL(\n z,\n ua = ua,\n dep = function(PAI) {1.1*h*log(1+(Cd*PAI)^0.25)},\n PAI = WAI + LAI\n)\nu2.s <- readRDS(\"./tests/u2.rds\")\nstopifnot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=TRUE ) < epsilon)\n\nu2 <- airRest(u2)\nu2.s <- readRDS(\"./tests/u2.ar.rds\")\nstopifnot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=TRUE ) < epsilon)" nil) (9828 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Package%20Documentation" Package\ Documentation:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalancePaper/R/EnergyBalancePaper.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' EnergyBalancePaper: Companion package for paper\n#'\n#' Companion package for the paper \\bold{TO BE ADDED} This packagee\n#' contains thew data and the functions used to analyse the date and\n#' to create the plots in the paper. In addition it also contains\n#' further scripts for analysis and plots not included in the paper.\n#' \n#' @section EnergyBalancePaper functions and data:\n#' Data: To Be added ...\n#' Functions: To Be added ...\n#'\n#' @docType package\n#' @name EnergyBalancePaper\nNULL\n#> NULL" nil) ...) ("RDescr" (5910 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*DESCRIPTION%20File" DESCRIPTION\ File:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "no") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "no") (:tangle . "./package/EnergyBalance/DESCRIPTION") (:exports . "code") (:results . "replace") (:eval . "never") (:no-expand . "TRUE") (:hlines . "no") (:session . "none")) "Package: EnergyBalance\nType: Package\nTitle: Fitting of Wind Profile, Calculation of Aerodynamic Resistance\nVersion: 0.0.1 \nDate: 2015-08-25\nAuthor: Rainer M. Krug\nMaintainer: Rainer M Krug <Rainer@krugs.de>\nDescription: Contains function to fit, evaluate and plot wind profiles of the Log-Exp-Log family of shapes.\nLicense: GPL-3\nLazyData: true\nDepends: DBI, RSQLite\nImports: magrittr, parallel, lhs" nil) (5933 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*.Rbuiltignore%20File" \.Rbuiltignore\ File:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "no") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "no") (:tangle . "./package/EnergyBalance/.Rbuildignore") (:exports . "code") (:results . "replace") (:eval . "never") (:no-expand . "TRUE") (:hlines . "no") (:session . "none")) ".DS_Store\n.Rhistory" nil) (9798 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*DESCRIPTION%20File" DESCRIPTION\ File:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "no") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "no") (:tangle . "./package/EnergyBalancePaper/DESCRIPTION") (:exports . "code") (:results . "replace") (:eval . "never") (:no-expand . "TRUE") (:hlines . "no") (:session . "none")) "Package: EnergyBalancePaper\nType: Package\nTitle: Paper Accompanying Package\nVersion: 0.0.1 \nDate: 12.11.2014\nAuthor: Rainer M. Krug\nMaintainer: Rainer M Krug <Rainer@krugs.de>\nDescription: Accompanying package for the paper XXXXX containig data and scripts used in the analysis and the functions to create the graphs.\nLicense: GPL-3\nLazyData: true\nDepends: EnergyBalance, tgp" nil) (9820 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*.Rbuiltignore%20File" \.Rbuiltignore\ File:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-type . value) (:comments . "no") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "no") (:tangle . "./package/EnergyBalance/.Rbuildignore") (:exports . "code") (:results . "replace") (:eval . "never") (:no-expand . "TRUE") (:hlines . "no") (:session . "none")) "" nil))))
org-babel-tangle(nil)
call-interactively(org-babel-tangle nil nil)
command-execute(org-babel-tangle)
--8<---------------cut here---------------end--------------->8---
--
Rainer M. Krug, PhD (Conservation Ecology, SUN), MSc (Conservation Biology, UCT), Dipl. Phys. (Germany)
Centre of Excellence for Invasion Biology
Stellenbosch University
South Africa
Tel : +33 - (0)9 53 10 27 44
Cell: +33 - (0)6 85 62 59 98
Fax : +33 - (0)9 58 10 27 44
Fax (D): +49 - (0)3 21 21 25 22 44
email: Rainer@krugs.de
Skype: RMkrug
PGP: 0x0F52F982
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 480 bytes --]
^ permalink raw reply [flat|nested] 2+ messages in thread
* SOLVED: Error when tangling subtree - but works for whole document
2015-09-04 10:05 Error when tangling subtree - but works for whole document Rainer M Krug
@ 2015-09-04 10:11 ` Rainer M Krug
0 siblings, 0 replies; 2+ messages in thread
From: Rainer M Krug @ 2015-09-04 10:11 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 1123 bytes --]
The problem is that tangling in an indirect buffer does not work.
I'll post another email concerning this.
Thanks,
Rainer
Rainer M Krug <Rainer@krugs.de> writes:
> Hi
>
> I get an error #(wrong-type-argument stringp nil)# when I tangle a
> subtree, but tangling the whole document works.
>
> ,----
> | GNU Emacs 24.5.1 (x86_64-apple-darwin14.5.0, Carbon Version 157
> | AppKit 1348.17) of 2015-08-28 on Rainers-MacBook-Pro.local
> | Org-mode version 8.3.1 (release_8.3.1-166-g5bfdfc @ /Users/rainerkrug/.emacs.d/org-mode/lisp/)
> `----
>
> The backtrace is below
>
> Let me know if you need any further info
>
> Thanks,
>
> Rainer
>
[snip: Long Backtrace (11 lines)]
--
Rainer M. Krug, PhD (Conservation Ecology, SUN), MSc (Conservation Biology, UCT), Dipl. Phys. (Germany)
Centre of Excellence for Invasion Biology
Stellenbosch University
South Africa
Tel : +33 - (0)9 53 10 27 44
Cell: +33 - (0)6 85 62 59 98
Fax : +33 - (0)9 58 10 27 44
Fax (D): +49 - (0)3 21 21 25 22 44
email: Rainer@krugs.de
Skype: RMkrug
PGP: 0x0F52F982
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 480 bytes --]
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2015-09-04 10:11 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-09-04 10:05 Error when tangling subtree - but works for whole document Rainer M Krug
2015-09-04 10:11 ` SOLVED: " Rainer M Krug
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).