[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[O] Error when tangling subtree - but works for whole document
|
From: |
Rainer M Krug |
|
Subject: |
[O] Error when tangling subtree - but works for whole document |
|
Date: |
Fri, 04 Sep 2015 12:05:03 +0200 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.5 (darwin) |
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!.\310!\211.G\311V\205. \n).\312!.
\313\230\203%.\314\315 !\2027. \316\230\203/.\317\2027. G\311V\2057.
\211.\205P.,\203O. \313\230\203O.
\320.,Q\202P.
\211.-\2054.\321!\322.-!..\211./\203w..\203w./\316\230\204w.\323..\324\"\210*\325.-!\203\217.-\326\327.0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203\247.\317\335\336\217\210 \203\277.-.3\235\204\277. \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. \203.\f\204.\350.7T.7.-\fB.8\351.8.0\352\353$\203+.0\2023.8.0B\211.0)..\207"
[get-spec tangle sheb she-bang tangle-mode base-name #[(name) "\302\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!\203\n.\302!\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!\203\n.\302!\210\301\207" [temp-buffer buffer-name kill-buffer] 2))
insert-file-contents assoc :padline 4 write-region 493 cl-member :test #[(a 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!.\310!\211.G\311V\205. \n).\312!.
\313\230\203%.\314\315 !\2027. \316\230\203/.\317\2027. G\311V\2057.
\211.\205P.,\203O. \313\230\203O.
\320.,Q\202P.
\211.-\2054.\321!\322.-!..\211./\203w..\203w./\316\230\204w.\323..\324\"\210*\325.-!\203\217.-\326\327.0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203\247.\317\335\336\217\210 \203\277.-.3\235\204\277. \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. \203.\f\204.\350.7T.7.-\fB.8\351.8.0\352\353$\203+.0\2023.8.0B\211.0)..\207"
[get-spec tangle sheb she-bang tangle-mode base-name #[(name) "\302\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!\203\n.\302!\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!\203\n.\302!\210\301\207" [temp-buffer buffer-name kill-buffer] 2))
insert-file-contents assoc :padline 4 write-region 493 cl-member :test #[(a 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) "address@hidden \"A\206. .\307\306
.\"A\203#.\310\306 .\"A!\206$. \311P!.
\312.\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!.\310!\211.G\311V\205. \n).\312!. \313\230\203%.\314\315
!\2027. \316\230\203/.\317\2027. G\311V\2057. \211.\205P.,\203O.
\313\230\203O.
\320.,Q\202P.
\211.-\2054.\321!\322.-!..\211./\203w..\203w./\316\230\204w.\323..\324\"\210*\325.-!\203\217.-\326\327.0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203\247.\317\335\336\217\210 \203\277.-.3\235\204\277. \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. \203.\f\204.\350.7T.7.-\fB.8\351.8.0\352\353$\203+.0\2023.8.0B\211.0)..\207"
[get-spec tangle sheb she-bang tangle-mode base-name #[(name) "\302\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!\203\n.\302!\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!\203\n.\302!\210\301\207" [temp-buffer buffer-name kill-buffer] 2))
insert-file-contents assoc :padline 4 write-region 493 cl-member :test #[(a 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) "address@hidden \"A\206. .\307\306
.\"A\203#.\310\306 .\"A!\206$. \311P!.
\312.\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!.\310!\211.G\311V\205. \n).\312!. \313\230\203%.\314\315
!\2027. \316\230\203/.\317\2027. G\311V\2057. \211.\205P.,\203O.
\313\230\203O.
\320.,Q\202P.
\211.-\2054.\321!\322.-!..\211./\203w..\203w./\316\230\204w.\323..\324\"\210*\325.-!\203\217.-\326\327.0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203\247.\317\335\336\217\210 \203\277.-.3\235\204\277. \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. \203.\f\204.\350.7T.7.-\fB.8\351.8.0\352\353$\203+.0\2023.8.0B\211.0)..\207"
[get-spec tangle sheb she-bang tangle-mode base-name #[(name) "\302\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!\203\n.\302!\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!\203\n.\302!\210\301\207" [temp-buffer buffer-name kill-buffer] 2))
insert-file-contents assoc :padline 4 write-region 493 cl-member :test #[(a 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
<address@hidden>\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 <address@hidden>\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: address@hidden
Skype: RMkrug
PGP: 0x0F52F982
signature.asc
Description: PGP signature
- [O] Error when tangling subtree - but works for whole document,
Rainer M Krug <=