emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* 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).