From mboxrd@z Thu Jan 1 00:00:00 1970 From: Rainer M Krug Subject: Error when tangling subtree - but works for whole document Date: Fri, 04 Sep 2015 12:05:03 +0200 Message-ID: Mime-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:36575) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZXnsf-0000Cu-4h for emacs-orgmode@gnu.org; Fri, 04 Sep 2015 06:06:37 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZXns4-0001jI-70 for emacs-orgmode@gnu.org; Fri, 04 Sep 2015 06:06:01 -0400 Received: from mail-wi0-f180.google.com ([209.85.212.180]:37201) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZXns3-0001j9-2K for emacs-orgmode@gnu.org; Fri, 04 Sep 2015 06:05:24 -0400 Received: by wicfx3 with SMTP id fx3so12445828wic.0 for ; Fri, 04 Sep 2015 03:05:22 -0700 (PDT) Received: from Rainers-MacBook-Pro.local (arn78-1-88-186-171-7.fbx.proxad.net. [88.186.171.7]) by smtp.gmail.com with ESMTPSA id j7sm3119510wjz.11.2015.09.04.03.05.14 for (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Fri, 04 Sep 2015 03:05:20 -0700 (PDT) List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable 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 13= 48.17) of 2015-08-28 on Rainers-MacBook-Pro.local | Org-mode version 8.3.1 (release_8.3.1-166-g5bfdfc @ /Users/rainerkrug/.em= acs.d/org-mode/lisp/) `---- The backtrace is below Let me know if you need any further info Thanks, Rainer =2D-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/EnergyBalan= ce/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:rowname-names) (:= result-params "replace") (:result-type . value) (:comments . "link") (:sheb= ang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./= package/EnergyBalance/data/fileNames.R") (:exports . "both") (:results . "r= eplace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes= ") (:tangle-mode . 292) (:hlines . "no")) "CACHE <- file.path( \".\", \"cac= he\")\nSQLITEDB <- file.path(CACHE, \"energyBalance.sqlite\")" nil)) #[(spec) "\306\211.\307!.\310!\211.G\311V\205.=00\n).\312!. \313\230\20= 3%.\314\315 !\2027. \316\230\203/.\317\2027. G\311V\2057. \211.\205P.=0E,\2= 03O. \313\230\203O.=0D\320.,Q\202P.=0D\211.-\2054.\321!\322.-!..\211./\203= w.=0E.\203w.=0E/\316\230\204w.\323..\324\"\210*\325.-!\203\217.=0E-\326\327= .0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203\247.\317= \335\336\217\210=0B\203\277.=0E-.3\235\204\277.=0B\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.-#\2= 10.=07=0B\203.=01\f\204.=01\350.=0E7T.7.-\fB.8\351.8.0\352\353$\203+.=0E0\2= 023.=0E8.0B\211.0)..\207" [get-spec tangle sheb she-bang tangle-mode base-n= ame #[(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 la= ng-f) ((error)) "\n" org-babel-spec-to-string buffer-string ((byte-code "\3= 01!\203\n.\302!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) in= sert-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 "replac= e") (: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 . 29= 2) (:hlines . "no")) "CACHE <- file.path( \".\", \"cache\")\nSQLITEDB <- f= ile.path(CACHE, \"energyBalance.sqlite\")" nil)) mapc(#[(spec) "\306\211.\307!.\310!\211.G\311V\205.=00\n).\312!. \313\2= 30\203%.\314\315 !\2027. \316\230\203/.\317\2027. G\311V\2057. \211.\205P.= =0E,\203O. \313\230\203O.=0D\320.,Q\202P.=0D\211.-\2054.\321!\322.-!..\211= ./\203w.=0E.\203w.=0E/\316\230\204w.\323..\324\"\210*\325.-!\203\217.=0E-\3= 26\327.0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203\24= 7.\317\335\336\217\210=0B\203\277.=0E-.3\235\204\277.=0B\337Pc\210.-.3B.3\3= 40.4!\210\341 .5\331\332!.6r.6q\210\342\216\325.-!\203\340.\343.-!\210db\21= 0\344\345\346.48\"A\316\230\204\371.`eU\204\371.\337c\210.5c\210\347\317\21= 1.-#\210.=07=0B\203.=01\f\204.=01\350.=0E7T.7.-\fB.8\351.8.0\352\353$\203+.= =0E0\2023.=0E8.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 :she= bang 0 :tangle-mode "yes" file-name-sans-extension buffer-file-name "no" ni= l "." :mkdirp file-name-directory make-directory parents file-exists-p mapc= ar car delete-file generate-new-buffer " *temp*" ((byte-code "\301!\203\n.= \302!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) fboundp (func= all lang-f) ((error)) "\n" org-babel-spec-to-string buffer-string ((byte-co= de "\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-buf= fer ...] 6] ((5939 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalan= ce.org::*CACHE" CACHE:1 ((:colname-names) (:rowname-names) (:result-params = "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:ca= che . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/Energy= Balance/data/fileNames.R") (:exports . "both") (:results . "replace") (:ses= sion . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mo= de . 292) (:hlines . "no")) "CACHE <- file.path( \".\", \"cache\")\nSQLITED= B <- file.path(CACHE, \"energyBalance.sqlite\")" nil) (5950 nil "file:~/Do= cuments/Projects/EnergyBalance/EnergyBalance.org::*Package%20Documentation"= Package\ Documentation:1 ((:colname-names) (:rowname-names) (:result-param= s "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:= cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/Ener= gyBalance/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 p= ackage provides functiuons to\n#' fit wind profiles, calculate the aerial r= esistance 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#' @imp= ortFrom lhs randomLHS\n#' @importFrom RSQLite SQLite\n#' @import DBI\n#' @i= mport magrittr\nNULL\n#> NULL" nil) (5973 nil "file:~/Documents/Projects/En= ergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:rowname-= names) (:result-params "replace") (:result-type . value) (:comments . "link= ") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tan= gle . "./package/EnergyBalance/R/CACHE.R") (:exports . "both") (:results . = "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "y= es") (:tangle-mode . 292) (:hlines . "no")) "#' Cache for computations in p= ackage\n#'\n#' CACHE to be used for the computations. The cac=3Dhe holde = =3Dtemporary\n#' as well as final results of the computations which are sav= ed\n#' automatically to avoid re-computqtion. \n#' \n#' @format Character v= ector of length one.\n#' @name CACHE\n#' @docType data\nNULL" nil) (5986 ni= l "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*SQLITEDB" SQ= LITEDB:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:re= sult-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:p= adline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/SQLIT= EDB.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBa= lance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines = . "no")) "#' SQLite Database with processed input data\n#'\n#' File name an= d 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 v= ector of length one.\n#' @name SQLITEDB\n#' @docType data\nNULL" nil) (6000= nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*getplotli= m" getplotlim:1 ((:colname-names) (:rowname-names) (:result-params "replace= ") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "n= o") (: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 l= imits, as set by \\code{xlim =3D } and \\code{ylim =3D }. \n##' @param lim = if \\code{xlim} or \\code{ylim} return the xorresponding\n##' limits, if co= de{xlimylim} retur list with each limit as an\n##' element.\n##' @return ei= ther vector with two elements containing the x or y\n##' limits or a list o= f two elements, xlim and ylim.\n##' @author Rainer M. Krug\n##' @export\nge= tplotlim<-function(lim =3D c(\"xlim\", \"ylim\")) {\n usr <- par('usr')\= n xr <- (usr[2] - usr[1]) / 27 # 27 =3D (100 + 2*4) / 4\n yr <- (usr[= 4] - usr[3]) / 27\n return(\n switch(\n EXPR =3D paste= (sort(lim), collapse=3D\"\"),\n xlim =3D c(usr[1] + xr, usr[2] -= xr),\n ylim =3D c(usr[3] + yr, usr[4] - yr),\n xlimy= lim =3D list(\n xlim =3D c(usr[1] + xr, usr[2] - xr),\n = ylim =3D 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 . "") (:c= ache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/Energ= yBalance/R/inputDataDir.R") (:exports . "both") (:results . "replace") (:se= ssion . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-m= ode . 292) (:hlines . "no")) "##' Returns input data dir\n##'\n##' Returns = input data dir (the directory with the wind and LAI\n##' input files are lo= cated in). If the package \\code{EnergyBalancePaper} is\n##' installed, th= e 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=3Dd and LAI data\n##= ' @author Rainer M. Krug\n##' @export\ninputDataDir <- function() {\n fi= le.path(\n ifelse(\n \"package:EnergyBalancePaper\" %in% = search(),\n system.file(package =3D \"EnergyBalancePaper\"),\n = getwd()\n ),\n \"inputdata\"\n )\n}" nil= ) (6120 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*im= portVentToDB" 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 . "replac= e") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:= tangle-mode . 292) (:hlines . "no")) "##' Import wind data\n##'\n##' Import= data into sqlite db and fit =3Ddefault=3D to each wind profile\n##' to obt= ain the parameters, e.g. ustar for selecting.\n##' @param h canopy height i= n 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 =3D fn,\n stringsAsFactors =3D FALSE,\n header =3D 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 co= lumns for wpLELDefault parameter values\n wsw$ua <- NA\n wsw$dep <- N= A\n wsw$z0 <- NA\n wsw$na <- NA\n wsw$zjoint <- NA\n wsw$h <- N= A\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 =3D=3D= 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 =3D wp$z,\n u =3D wp[,3],\n = ## lower =3D c(dep=3D0, z0=3D0.001, na=3D0.01, = zjoint=3D0),\n initial =3D c(dep=3D2, z0=3D2, na=3D2, = zjoint=3D3)\n ## upper =3D c(dep=3D27, z0= =3Dh, na=3D20, zjoint=3Dh),\n ## method= =3D \"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$f= it$par[[\"na\"]]\n wsw$zjoint[i] <- wpf$fit$par[[\"zjoint\"]]\n = wsw$h[i] <- wpf$wp[[\"h\"]]\n wsw$za[i] <- w= pf$wp[[\"za\"]]\n wsw$ustar[i] <- wpf$wp[[\"ustar\"]]\n = }\n }\n \n wsl <- data.frame(\n date =3D wsw$date,\n = time =3D wsw$time,\n julien =3D wsw$julien,\n z =3D= rep(\n c(3,11,17,23,29,37),\n times =3D rep( nrow(ws= w), 6 )\n ),\n ws =3D c(\n wsw$h03,\n = wsw$h11,\n wsw$h17,\n wsw$h23,\n ws= w$h29,\n wsw$h37\n ),\n ua =3D wsw$ua,\n = dep =3D wsw$dep,\n z0 =3D wsw$z0,\n na =3D w= sw$na,\n zjoint =3D wsw$zjoint,\n h =3D wsw$h,\n = za =3D wsw$za,\n ustar =3D wsw$ustar\n )\n ##\n db= <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try({\n ## = WindSpeed_w\n DBI::dbWriteTable(db, \"WindSpeed_w\", wsw, overwr= ite=3DTRUE)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsw_dt O= N WindSpeed_w (date, time)\")\n DBI::dbGetQuery(db, \"CREATE U= NIQUE INDEX wsw_jt ON WindSpeed_w (julien, time)\")\n DBI::dbGet= Query(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 (j= ulien)\")\n ## WindSpeed_l\n DBI::dbWriteTable(db, \"= WindSpeed_l\", wsl, overwrite=3DTRUE)\n DBI::dbGetQuery(db, \"CR= EATE UNIQUE INDEX wsl_dth ON WindSpeed_l (date, time, z)\")\n = DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsl_jth ON WindSpeed_l (julien, t= ime, z)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_date ON Wi= ndSpeed_l (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl_t= ime 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:~/Do= cuments/Projects/EnergyBalance/EnergyBalance.org::*importLAIToDB" importLAI= ToDB:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:resu= lt-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:pad= line . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/importL= AIToDB.R") (:exports . "both") (:results . "replace") (:session . "*R.Energ= yBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlin= es . "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 =3D fn,\n stringsAsFactors =3D FALS= E,\n header =3D 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, \"LeafA= reaIndex\", lai, overwrite=3DTRUE)\n DBI::dbGetQuery(db, \"CREAT= E UNIQUE INDEX lai_doy ON LeafAreaIndex (doy)\")\n DBI::dbGetQue= ry(db, \"CREATE INDEX lai_h ON LeafAreaIndex (lai)\")\n }\n )\n = DBI::dbDisconnect(db)\n}" nil) (6353 nil "file:~/Documents/Projects/Energ= yBalance/EnergyBalance.org::*createWsLAI" createWsLAI:1 ((:colname-names) (= :rowname-names) (:result-params "replace") (:result-type . value) (:comment= s . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "ye= s") (:tangle . "./package/EnergyBalance/R/createWsLAI.R") (:exports . "both= ") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never"= ) (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Finalize sq= light databaes of input data\n##'\n##' Create combined wind speed and LAI t= able and associated indices in sqlite database.\n##' @return invisible \\co= de{NULL}\n##' @author Rainer M. Krug\n##' @export\ncreateWsLAI <- function(= \n ){\n sql_l <- paste(\n \"CREATE TABLE\",\n \" WindS= peedLAI_l\",\n \"AS SELECT\",\n \" WindSpeed_l.*, LeafAreaIn= dex.lai AS lai\",\n \"FROM\", \n \" WindSpeed_l\",\n = \"LEFT OUTER JOIN\",\n \" LeafAreaIndex\",\n \"ON\",\n = \" julien=3DDOY\"\n )\n sql_w <- paste(\n \"CREATE TABLE\",\= n \" WindSpeedLAI_w\",\n \"AS SELECT\",\n \" WindSpe= ed_w.*, LeafAreaIndex.lai AS lai\",\n \"FROM\", \n \" WindSp= eed_w\",\n \"LEFT OUTER JOIN\",\n \" LeafAreaIndex\",\n = \"ON\",\n \" julien=3DDOY\"\n )\n db <- DBI::dbConnect(RSQL= ite::SQLite(), SQLITEDB)\n try({\n ##\n DBI::dbGet= Query( conn =3D db, statement =3D \"DROP TABLE IF EXISTS WindSpeedLAI_l\")\= n DBI::dbGetQuery( conn =3D db, statement =3D sql_l)\n = DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslail_dth ON WindSpeedLAI_l (d= ate, time, z)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsl= ail_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 Wind= SpeedLAI_l (julien)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsla= il_h ON WindSpeedLAI_l (z )\")\n DBI::dbGetQuery(db, \"= CREATE INDEX wslail_lai ON WindSpeedLAI_l (lai)\")\n DBI::dbG= etQuery(db, \"CREATE INDEX wslail_ustar ON WindSpeedLAI_l (ustar)\")\n = ##\n DBI::dbGetQuery( conn =3D db, statement =3D \"DROP = TABLE IF EXISTS WindSpeedLAI_w\")\n DBI::dbGetQuery( conn =3D db= , statement =3D sql_w)\n DBI::dbGetQuery(db, \"CREATE UNIQUE IND= EX wslaiw_dth ON WindSpeedLAI_w (date, time)\")\n DBI::dbGetQuer= y(db, \"CREATE UNIQUE INDEX wslaiw_jth ON WindSpeedLAI_w (julien, time)\")\= n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_date ON WindSpeedL= AI_w (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_tim= e ON WindSpeedLAI_w (time )\")\n DBI::dbGetQuery(db, \"CREATE= INDEX wslaiw_julien ON WindSpeedLAI_w (julien)\")\n DBI::dbGetQ= uery(db, \"CREATE INDEX wslaiw_lai ON WindSpeedLAI_w (lai)\")\n = DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_ustar ON WindSpeedLAI_w (usta= r)\")\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-pa= rams "replace") (:result-type . value) (:comments . "link") (:shebang . "")= (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/E= nergyBalance/R/createCache.R") (:exports . "both") (:results . "replace") (= :session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangl= e-mode . 292) (:hlines . "no")) "##' Re-create \\code{CACHE}\n##'\n##' Dele= tes all files in the cache (directory \\code{CACHE}) and re-creates them\n#= #' @title Recreate files in cache\n##' @name createCache\n##' @return invis= ible 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 =3D FA= LSE)\n unlink(SQLITEDB)\n importVentToDB(fnVent, h)\n importLAIToD= B(fnLAI)\n createWsLAI()\n invisible(NULL)\n}" nil) (6446 nil "file:~= /Documents/Projects/EnergyBalance/EnergyBalance.org::*loadWS" loadWS:1 ((:c= olname-names) (:rowname-names) (:result-params "replace") (:result-type . v= alue) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no"= ) (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/loadWS.R") (:expor= ts . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval= . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' D= epending on the values of the arguments, different datasets are\n##' loaded= , but all contain wind speed at different heights and lai\n##' data. The s= ql argument can be used to specify different\n##' conditions for the data r= eturned.\n##'\n##' Loads wind speed data from sql database in cache\n##' @t= itle Load wind speed data\n##' @param wide if TRUE, load wide format, if FA= LSE long format\n##' @param onlyComplete if \\code{TRUE}, load only datapoi= nts without missing\n##' data in wind \\code{h*} and \\code{LAI}.\n##' @par= am 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 th= e value of\n##' \\code{minSpeedIncreaseWide}}\n##'\n##' }\n##'\n##' \\bold{= Only Applies To \\code{wide=3D=3DTRUE}}\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=3D=3DTRUE}}\n##' \n##' @para= m 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{O= nly Applies To \\code{wide=3D=3DTRUE}}\n##' \n##' @param minUstar minimum u= star value to be included in analysis. The default is 0.25. \\bold{REFERENC= E 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 s= ql statement to be used instread of \\code{wide} and\n##' \\code{onlyComple= te}. The sql statement is evauated and the result is\n##' returned.\n##'\n#= #' \\bold{Only Applies To \\code{wide=3D=3DTRUE}}\n##' \n##' @return data.f= rame containing the data. If the \\code{wide=3D=3DTRUE},\n##' the class is = also set to \\code{wsw}, if \\code{wide=3D=3DFALSE} to\n##' \\code{wsl}\n##= ' @author Rainer M. Krug\n##' @export\nloadWS <- function(\n wide =3D TR= UE,\n onlyComplete =3D TRUE,\n minSpeedIncreaseWide =3D 0,\n maxWi= ndSpeedWide =3D 10,\n maxWindSpeedOneWide =3D FALSE,\n minUstar =3D 0= .25,\n WAI =3D 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=3DTRUE))\n f <- paste(f,= \"IS NOT NULL\", collapse =3D \" AND \")\n sql <- pas= te( \"SELECT * FROM \", tbln, \"WHERE\", f, \"AND ustar >=3D\", minUstar)\n= }\n }\n ws <- DBI::dbGetQuery(db, s= ql)\n } \n )\n dbDisconnect(db)\n ##\n if (length= (grep(\"date|time\", names(ws))) >=3D 2) {\n ws$date <- as.Date(ws$d= ate, format =3D \"%d/%m/%y\")\n ws$dateTime <- as.POSIXct(paste(ws$d= ate, ws$time), format=3D\"%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=3DTRUE, value=3DTRUE)\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 =3D .,\n FUN =3D . %>%\n = is_less_than(minSpeedIncrease= Wide) %>%\n any\n = ) %>%\n = not,\n ]\n }\n if (!is.nu= ll(maxWindSpeedWide)) {\n ws <-\n ws[\n = ws[,h] %>%\n apply(\n = X =3D .,\n MARGIN =3D 1,\n = FUN =3D 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/EnergyBalanc= e/EnergyBalance.org::*dfFromLong" dfFromLong:1 ((:colname-names) (:rowname-= names) (:result-params "replace") (:result-type . value) (:comments . "link= ") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tan= gle . "./package/EnergyBalance/R/dfFromLong.R") (:exports . "both") (:resul= ts . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp= . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Extract the height fr= om the column names in the database, where\n##' the column names of the hei= ght have to follow the format\n##' \\code{h[:digit:]}.\n##'\n##' Extract th= e 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 g= iven\n##' @author Rainer M. Krug\n##' @export\ndfFromLong <- function(\n = x\n ) {\n hCols <- grep(\n pattern =3D \"^h[[:digit:]]\",\n = x =3D names(x),\n value =3D FALSE\n )\n h <-= gsub(\"h\", \"\", names(x)[hCols])\n h <- as.numeric(h)\n u <- as.ma= trix(x[hCols])\n if(is.vector(u)) {\n result <- data.frame(\n = index =3D hCols,\n z =3D h,\n u =3D u= \n )\n } else { # is.matrix(u) =3D=3D TRUE\n result= <- data.frame(\n index =3D hCols,\n z =3D h,= \n u =3D t(u)\n )\n }\n rownames(resu= lt) <- names(x)[hCols]\n return(result)\n}" nil) (6646 nil "file:~/Docum= ents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL%20Generic%20function%= 20definition" wpLEL\ Generic\ function\ definition:1 ((:colname-names) (:ro= wname-names) (:result-params "replace") (:result-type . value) (:comments .= "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes")= (:tangle . "./package/EnergyBalance/R/wpLEL.R") (:exports . "both") (:resu= lts . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdir= p . "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 val= ues are \"default\" and \"Mahat2013\"}\n##' \n##' \\item{\\code{dep}} {so= me info}\n##' \\item{\\code{z0}} {some info}\n##' \\item{\\code{na}} {s= ome info}\n##' \\item{\\code{zjoint}} {some info}\n##' \\item{\\code{h}= } {some info}\n##' \\item{\\code{za}} {some info}\n##' \\item{\\code{z0= sol}} {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 calc= ulat the \\code{wpLEL} object\n##' @param ... optional arguments for the ge= neric functions\n##' @return objerct of class \\code{wpLEL}\n##' @author Ra= iner 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-par= ams "replace") (:result-type . value) (:comments . "link") (:shebang . "") = (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/En= ergyBalance/R/parmeterOK.R") (:exports . "both") (:results . "replace") (:s= ession . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-= mode . 292) (:hlines . "no")) "##' Check parameter for validity\n##'\n##' C= heck 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, oth= erwise a named\n##' \\code{character} vector where the names are the parame= ter 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 <=3D z\n if (any( z < 0 )) = {\n result <- c(result, z =3D \"All z have to be larger or equal tha= n zero!\\n\")\n }\n ## ua 0 <=3D ua\n if (ua < 0 ) {\n = result <- c(result, ua =3D \"ua has to be larger or equal than zero!\\n\")\= n }\n ## dep 0 <=3D dep < h\n if ((dep < 0) | (dep >=3D h) ) {\= n result <- c(result, dep =3D \"dep has to be larger or equal than z= ero and smaller than h!\\n\")\n }\n ## z0 0 < z0 <=3D h\n = if ((z0 <=3D 0) | (z0 > h)) {\n result <- c(result, z0 =3D \"z0 has = to be larger than zero and smaller or equal than h!\\n\")\n } \n ## n= a 0 < na\n if (na < 0 ) {\n result <- c(result, na =3D \"na ha= s to be larger or equal than zero!\\n\")\n } \n ## zjoint\n if ((z= joint < 0) | (zjoint > h)) {\n result <- c(result, zjoint =3D \"zjoi= nt has to larger or equal than 0 and smaller or equal than h!\\n\")\n }\= n ## h h >=3D 0\n if (h < 0 ) {\n result <- c(result, h = =3D \"h has to be larger or equal than zero!\\n\")\n }\n ## za za = > h\n if (za <=3D h ) {\n result <- c(result, za =3D \"za has to = be larger than h!\\n\")\n }\n ## z0sol 0 < z0sol POSSIBLY < h/10 ???= \n if (z0sol <=3D 0 ) {\n result <- c(result, z0sol =3D \"z0sol h= as to be larger than zero!\\n\")\n }\n ## ###\n ## dep, z0, h d= ep + 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/w= pLELDefault.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##' C= reates 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 f= unction which is evaluated in the context of\n##' the function, i.e. can us= e 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 param= etrisation by Mahat\n##' 2013:\n##'\n##' dep =3D function(LAI, ...) {h * (0= .05 + (LAI^0.02)/2 + (y-1)/20) }\n##'\n##' where \\code{h} will be the argu= ment \\code{h} and \\code{LAI} and\n##' \\code{y} need to be added as an ad= ditional argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The arg= ument \\code{...} is needed at the end as all arguments in\n##' the functio= n \\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 argume= nt\n##' \\code{parametrization} accordingly (in this example\n##' \"Mahat\"= ) to adjust further analysis accordingly!\n##' @param z0 roughness length a= t canopy level. The argument can be a\n##' numeric value or a function whic= h is evaluated in the context of\n##' the function, i.e. can use all argume= nts 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 =3D function(LAI, ...) {h * (0.23 - (LAI^0.2= 5)/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 argu= ment when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{= ...} is needed at the end as all arguments in\n##' the function \\code{wpLE= LDefault} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' Wh= en using a function, it should be taken care to set the\n##' argument \\cod= e{parametrization} accordingly (in this\n##' example \"Mahat\") to adjust f= urther 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 logarit= hmic changes to\n##' exponential (\"lower canopy end\")\n##' @param h canop= y height h\n##' @param za ???????\n##' @param z0sol roughness length at soi= l level (???????)\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate= and return u\n##' @return Object of class \\code{wpLEL}.\n##' @author Rain= er M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELDefault <- functio= n(\n z,\n ua,\n dep,\n z0,\n na, # =3D 7,\n zjoint,\n = h, # =3D 28,\n za, # =3D 37,\n z0sol,# =3D 0.001,\n noU = =3D FALSE,\n check =3D TRUE\n ){ \n vk <- 0.41\n \n ok <- = ifelse(\n check,\n parameterOK(\n z =3D z,\n = ua =3D ua,\n dep =3D dep,\n z0 = =3D z0,\n na =3D na,\n zjoint =3D zjoint,\n = h =3D h,\n za =3D za,\n z0sol =3D z0s= ol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n = stop(ok)\n }\n \n ## profil5.m l29 [[file:./package/EnergyBala= ncePaper/inst/matlab/org/profil5.m::29]]\n ## ustar =3D 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/profil= 5.m::30]]\n ## z0h =3D z0 * exp( -6.27 * vk * ( ustar^(1/3) ) ); % Calcu= l de Z0h (Thom)\n z0h <- z0 * exp( -6.27 * vk * ( ustar^(1/3) ) )\n\n = ## profil5.m l32 [[file:./package/EnergyBalancePaper/inst/matlab/org/pro= fil5.m::32]]\n ## zjoint =3D z0h + dep;\n ## if (= missing(zjoint)) {zjoint <- z0h + dep}\n\n ## profil5.m l33 [[file:./pac= kage/EnergyBalancePaper/inst/matlab/org/profil5.m::33]]\n ## uzjoint =3D= 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/EnergyBal= ancePaper/inst/matlab/org/profil5.m::34]]\n ## ustarsol =3D uzjoint * vk= / log( (zjoint/z0sol))\n ustarsol <- ifelse(\n (zjoint =3D=3D 0)= ,\n as.numeric(NA),\n uzjoint * vk / log( zjoint / z0sol )\n = )\n \n ##\n result <- list(\n z =3D NA,\n u = =3D NA,\n u.onlyTop =3D NA\n )\n\n if (!noU) {\n re= sult$z <- as.numeric(z)\n ##\n result$u <- as.numeric(\n = sapply(\n z,\n function(z) {\n = if (z >=3D h) {\n ## profil5.m l36 [[fil= e:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::37]]\n = u <- ( ustar/vk ) * log( (z-dep) / z0 )\n = } else if (z >=3D zjoint) {\n ## profil5.m l40 [[f= ile:./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 >=3D 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 =3D 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 r= eturn(u)\n }\n )\n )\n }\n #= #\n result$parametrization <- \"default\"\n result$dep <- as.nu= meric(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(v= k)\n result$ua <- as.numeric(ua)\n result$ustar <- as.nume= ric(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 c= lass(result) <- c(\"wpLEL\")\n return(result)\n}" nil) (6981 nil "file:~= /Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELMahat" wpLEL\.ma= hat ((:colname-names) (:rowname-names) (:result-params "replace") (:result-= type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padlin= e . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELMahat= .R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalan= ce*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "= no")) "##' Wind speed profile usingLog-Exp_Log shape using Mahat parametris= ation\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 M= ahat 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##' exponentia= l (\"lower canopy end\")\n##' @param h canopy height h\n##' @param za ?????= ??\n##' @param z0sol roughness length at soil level (???????)\n##' @param n= oU if \\code{TRUE}, do \\bold{not} calculate and return u\n##' @param LAI L= eaf Area Index to be used for the calculation of \\code{dep}\n##' @param y = integer indicating three basic forest profiles\n##' \\itemize{\n##' \\ite= m{y =3D 1} : {young pine}\n##' \\item{y =3D 2} : {leafed decideous tree}\= n##' \\item{y =3D 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##' @ex= port\n##' @references NEEDED!!!\nwpLELMahat <- function(\n z,\n ua,\n= na,\n zjoint,\n h,\n za,\n z0sol,\n LAI,\n y,\n no= U =3D FALSE,\n check =3D 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 =3D z,\n ua =3D ua,\n = dep =3D dep,\n z0 =3D z0,\n na = =3D na,\n zjoint =3D zjoint,\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol\n ),\n = TRUE\n )\n\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\= n result <- wpLELDefault(\n z =3D z,\n ua =3D ua,= \n dep =3D dep,\n z0 =3D z0,\n na =3D na,\n= zjoint =3D zjoint,\n h =3D h,\n za =3D za,\n= z0sol =3D z0sol,\n noU =3D noU,\n check =3D FALS= E\n )\n ##\n result$z0FUN <- z0FUN\n result$depFUN <- depF= UN\n result$LAI <- as.numeric(LAI)\n result$y <- as.numeric(y= )\n result$check <- check\n ##\n result$parametrization <- \"maha= t\"\n ##\n return(result)\n}" nil) (7084 nil "file:~/Documents/Projec= ts/EnergyBalance/EnergyBalance.org::*wpLELLE" wpLELLE ((:colname-names) (:r= owname-names) (:result-params "replace") (:result-type . value) (:comments = . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes"= ) (:tangle . "./package/EnergyBalance/R/wpLELLE.R") (:exports . "both") (:r= esults . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mk= dirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profil= e using Log-Exp shape\n##'\n##' Creates Log-Exp shaped wind profile oblect = \\code{wpLEL} based on\n##' input parameter. Uses \\code{wpLELDefault()} wi= th \\code{zjoint=3D0}\n##' and \\code{z0sol=3DNA}.\n##' @title Log-Exp wind= profile\n##' @param z height above ground\n##' @param ua wind speed at hig= hest point of z\n##' @param dep zero-plane displacement height. The argumen= t can be a\n##' numeric value or a function which is evaluated in the conte= xt of\n##' the function, i.e. can use all arguments to calculate\n##' \\cod= e{dep}. The last argument has to be \\code{...}. An example for\n##' the us= age of a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##= ' dep =3D 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##' \\c= ode{wpLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end = as all arguments in\n##' the function \\code{wpLELDefault} are passed on th= o thie function\n##' as \\code{...}.\n##'\n##' When using a function, it sh= ould be taken care to set the argument\n##' \\code{parametrization} accordi= ngly (in this example\n##' \"Mahat\") to adjust further analysis accordingl= y!\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##' t= he function, i.e. can use all arguments to calculate\n##' \\code{z0}. The l= ast argument has to be \\code{...}. An example for\n##' the usage of a func= tion would be the parametrisation by Mahat\n##' 2013:\n##'\n##' z0 =3D func= tion(LAI, ...) {h * (0.23 - (LAI^0.25)/10 + (y-1)/67) }\n##'\n##' where \\c= ode{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\code{y} ne= ed to be added as an additional argument when calling\n##' \\code{wpLELDefa= ult}.\n##'\n##' The argument \\code{...} is needed at the end as all argume= nts in\n##' the function \\code{wpLELDefault} are passed on tho thie functi= on\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##' @para= m na exponential decay coefficient\n##' @param h canopy height h\n##' @para= m za ???????\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and = return u\n##' @param ... further argumewnts which will be passed to the use= r\n##' defined function \\code{dep} and \\code{z0}.\n##' @param check defau= lt \\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 =3D FALSE,\n check =3D TRUE\n ){\n zjoint <- 0= \n z0sol <- 0.1\n ##\n ok <- ifelse(\n check,\n para= meterOK(\n z =3D z,\n ua =3D ua,\n = dep =3D dep,\n z0 =3D z0,\n na =3D na,\n= zjoint =3D zjoint,\n h =3D h,\n za = =3D za,\n z0sol =3D z0sol\n ),\n TRUE\n = )\n\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n resu= lt <- wpLELDefault(\n z =3D z,\n ua =3D ua,\n = dep =3D dep,\n z0 =3D z0,\n na =3D na,\n z= joint =3D zjoint,\n h =3D h,\n za =3D za,\n z= 0sol =3D z0sol,\n noU =3D noU,\n check =3D TRUE\n = )\n ##\n result$check <- check\n result$parametrization <- \"LE\= "\n return(result)\n}" nil) (7204 nil "file:~/Documents/Projects/EnergyB= alance/EnergyBalance.org::*wpLELMahatLE" wpLELMahatLE ((:colname-names) (:r= owname-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 p= rofile usingLog-Exp_Log shape using Mahat parametrisation\n##'\n##' Creates= Log-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input parame= ter.\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 heig= ht h\n##' @param za ???????\n##' @param z0sol roughness length at soil leve= l (???????)\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 =3D 1} : {young pine}\n##' \\item{y =3D = 2} : {leafed decideous tree}\n##' \\item{y =3D 3} : {old pine with long s= tems 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##' @autho= r Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELMahatLE <- f= unction(\n z,\n ua,\n na,\n h,\n za,\n z0sol,\n LAI,\n= y,\n noU =3D FALSE,\n check =3D 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 =3D z,\n ua =3D ua,\n dep =3D dep,\n = z0 =3D z0,\n na =3D na,\n zjoint =3D= zjoint,\n h =3D h,\n za =3D za,\n = z0sol =3D z0sol\n ),\n TRUE\n )\n if (!isTRU= E(ok)) {\n stop(ok)\n }\n ##\n result <- wpLELDefault(\n = z =3D z,\n ua =3D ua,\n dep =3D dep,\n = z0 =3D z0,\n na =3D na,\n zjoint =3D zjoint,\n = h =3D h,\n za =3D za,\n z0sol =3D z0sol,\n = noU =3D noU,\n check =3D FALSE\n )\n ##\n result$depF= UN <- depFUN\n result$z0FUN <- z0FUN\n result$LAI <- as.numeric(LAI)\= n result$y <- as.numeric(y)\n result$check <- check\n result$par= ametrization <- \"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 inp= ut parameter.\n##' @title Log-Exp-Log wind profile\n##' @param z height abo= ve ground\n##' @param ua wind speed at highest point of z\n##' @param zjoin= t height at which the logarithmic changes to\n##' exponential (\"lower cano= py end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @param = z0sol roughness length at soil level (???????)\n##' @param LAI Leaf Area In= dex\n##' @param WAI Wood Area Index, default=3D1.1\n##' @param noU if \\cod= e{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!!!\nwpL= ELCastanea <- function(\n z,\n ua,\n zjoint,\n h,\n za,\n = z0sol,\n LAI,\n WAI =3D 1.1,\n noU =3D FALSE,\n check =3D TR= UE\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(L= AI, WAI)\n ##\n ok <- ifelse(\n check,\n parameterOK(\n= z =3D z,\n ua =3D ua,\n dep = =3D dep,\n z0 =3D z0,\n na =3D na,\n = zjoint =3D zjoint,\n h =3D h,\n za =3D za= ,\n z0sol =3D z0sol\n ),\n TRUE\n )\n = if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <- wpLEL= Default(\n z =3D z,\n ua =3D ua, \n dep = =3D na,\n z0 =3D z0,\n na =3D na,\n zjoint =3D= zjoint,\n h =3D h, \n za =3D za,\n z0sol = =3D z0sol, \n noU =3D noU,\n check =3D 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/EnergyBalan= ce/EnergyBalance.org::*wpLELOwnFree" wpLELOwnFree ((:colname-names) (:rowna= me-names) (:result-params "replace") (:result-type . value) (:comments . "l= ink") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:= tangle . "./package/EnergyBalance/R/wpLELOwnFree.R") (:exports . "both") (:= results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:m= kdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profi= le usingLog-Exp_Log shape using ownFree parametrisation\n##'\n##' Creates L= og-Exp-Log shaped wind profile oblect \\code{wpLEL} based on input paramete= r.\n##' dep, z0, na and zoint are parametrized using:\n##'\n##' x =3D h * (= x.a + ( LAI ^ x.b ) / x.c )\n##'\n##' where x is dep, z0, na and zjoint re= spectively.\n##' \n##' @title Log-Exp-Log wind profile based on Mahat param= etrization\n##' @param z height above ground\n##' @param ua wind speed at h= ighest point of z\n##' @param h canopy height h\n##' @param za za\n##' @par= am 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##' @pa= ram na.a see Details\n##' @param na.b see Details\n##' @param na.c see Deta= ils\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{n= ot} calculate and return u\n##' @param check default \\code{TRUE}. If \\cod= e{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAinly for in= ternal usage.\n##' @param na exponential decay coefficient\n##' @param zjoi= nt height at which the logarithmic changes to\n##' exponential (\"lower can= opy 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 z= joint.a, zjoint.b, zjoint.c,\n\n LAI,\n noU =3D FALSE,\n check =3D= TRUE\n ){ \n depFUN <- function(LAI, h, dep.a, dep.b, de= p.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 zjoi= ntFUN <- function(LAI, h, zjoint.a, zjoint.b, zjoint.c) { h * (zjoint.a + (= LAI ^ zjoint.b ) / zjoint.c ) }\n ##\n dep <- depFUN(LAI, h, d= ep.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 =3D z,= \n ua =3D ua,\n dep =3D dep,\n z0 = =3D z0,\n na =3D na,\n zjoint =3D zjoint,\n = h =3D h,\n za =3D za,\n z0sol =3D = z0sol\n ),\n TRUE\n )\n if (!isTRUE(ok)) {\n = stop(ok)\n }\n ##\n result <- wpLELDefault(\n z =3D z,= \n ua =3D ua,\n dep =3D dep,\n z0 =3D z0,\n = na =3D na,\n zjoint =3D zjoint,\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n noU =3D noU,\n = check =3D FALSE\n )\n ##\n result$depFUN <- depFUN\n = result$dep.a <- dep.a\n result$dep.b <- dep.b\n result$dep.c <- de= p.c\n ##\n result$naFUN <- naFUN\n result$na.a <- na.a\n resul= t$na.b <- na.b\n result$na.c <- na.c\n ##\n result$z0FUN <- z0FU= N\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 <- zj= oint.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::*wpLE= L.wpLEL" wpLEL\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params = "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:ca= che . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/Energy= Balance/R/wpLEL.wpLEL.R") (:exports . "both") (:results . "replace") (:sess= ion . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mod= e . 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 argume= nts in \\code{...} given\n##' arguments and the from \\code{x} extracted ar= guments.\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 us= ed to create the\n##' new \\code{wpLEL} object using the \\code{wpLELDefaul= t} function.\n##' @return Object of class \\code{wpLEL}.\n##' @author Raine= r 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\" =3D wpLELDefa= ult( \n z =3D iff(exists(\"z\", dot), dot[[\"z\"]], = x[[\"z\"]]),\n ua =3D iff(exists(\"ua\", dot), dot[[\= "ua\"]], x[[\"ua\"]]),\n dep =3D iff(exists(\"dep\", d= ot), dot[[\"dep\"]], x[[\"depOrg\"]]),\n z0 =3D iff(exist= s(\"z0\", dot), dot[[\"z0\"]], x[[\"z0Org\"]]),\n na = =3D iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n = zjoint =3D iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint= \"]]),\n h =3D iff(exists(\"h\", dot), dot[[\"h\"]], = x[[\"h\"]]),\n za =3D iff(exists(\"za\", dot), dot[[= \"za\"]], x[[\"za\"]]),\n z0sol =3D iff(exists(\"z0sol\", = dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU =3D iff(exist= s(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]])\n ),\n \= "mahat\" =3D wpLELMahat(\n z =3D iff(exists(\"z\", d= ot), dot[[\"z\"]], x[[\"z\"]]),\n ua =3D iff(exists(\"u= a\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n na =3D iff= (exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n zjo= int =3D iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n= h =3D iff(exists(\"h\", dot), dot[[\"h\"]], x[[\= "h\"]]),\n za =3D iff(exists(\"za\", dot), dot[[\"za\"]]= , x[[\"za\"]]),\n z0sol =3D iff(exists(\"z0sol\", dot), do= t[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU =3D iff(exists(\"noU\= ", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI =3D iff(e= xists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n y = =3D iff(exists(\"y\", dot), dot[[\"y\"]], x[[\"y\"]])\n = ),\n \"LE\" =3D wpLELLE(\n z =3D iff(exists(\"= z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua =3D iff= (exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n dep= =3D iff(exists(\"dep\", dot), dot[[\"dep\"]], x[[\"depOrg\"]]),\n= z0 =3D iff(exists(\"z0\", dot), dot[[\"z0\"]], x[[\= "z0Org\"]]),\n na =3D iff(exists(\"na\", dot), dot[[\"na= \"]], x[[\"na\"]]),\n h =3D iff(exists(\"h\", dot),= dot[[\"h\"]], x[[\"h\"]]),\n za =3D iff(exists(\"za\"= , dot), dot[[\"za\"]], x[[\"za\"]]),\n noU =3D iff(ex= ists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]])\n ),\n = \"mahatLE\" =3D wpLELMahatLE(\n z =3D iff(exists(\"z\", = dot), dot[[\"z\"]], x[[\"z\"]]),\n ua =3D iff(exist= s(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n na = =3D iff(exists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n = h =3D iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),= \n za =3D iff(exists(\"za\", dot), dot[[\"za\"]], x[= [\"za\"]]),\n z0sol =3D iff(exists(\"z0sol\", dot), dot[[\"z0s= ol\"]], x[[\"z0sol\"]]),\n noU =3D iff(exists(\"noU\", do= t), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI =3D iff(exists(\"= LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n y =3D i= ff(exists(\"y\", dot), dot[[\"y\"]], x[[\"y\"]])\n ),\n = \"castanea\" =3D wpLELCastanea(\n z =3D iff(exists(\"z= \", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua =3D iff(= exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n zjoi= nt =3D iff(exists(\"zjoint\", dot), dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n = h =3D iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"= h\"]]),\n za =3D iff(exists(\"za\", dot), dot[[\"za\"]],= x[[\"za\"]]),\n z0sol =3D iff(exists(\"z0sol\", dot), dot= [[\"z0sol\"]], x[[\"z0sol\"]]),\n LAI =3D iff(exists(\"LAI\"= , dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\n WAI =3D iff(ex= ists(\"WAI\", dot), dot[[\"WAI\"]], x[[\"WAI\"]])\n ),\n = \"ownFree\" =3D wpLELOwnFree(\n z =3D iff(exists(\"z\",= dot), dot[[\"z\"]], x[[\"z\"]]),\n ua =3D iff(exi= sts(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n h = =3D iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n = za =3D iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),= \n z0sol =3D iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[= [\"z0sol\"]]),\n \n dep.a =3D iff(exists(\"dep.a\", = dot), dot[[\"dep.a\"]], x[[\"dep.a\"]]),\n dep.b =3D iff(exis= ts(\"dep.b\", dot), dot[[\"dep.b\"]], x[[\"dep.b\"]]),\n dep.c= =3D iff(exists(\"dep.c\", dot), dot[[\"dep.c\"]], x[[\"dep.c\"]]),\n\n = z0.a =3D iff(exists(\"z0.a\", dot), dot[[\"z0.a\"]], x[[\"= z0.a\"]]),\n z0.b =3D iff(exists(\"z0.b\", dot), dot[[\"z0.b= \"]], x[[\"z0.b\"]]),\n z0.c =3D iff(exists(\"z0.c\", dot)= , dot[[\"z0.c\"]], x[[\"z0.c\"]]),\n\n na.a =3D iff(exists(\"= na.a\", dot), dot[[\"na.a\"]], x[[\"na.a\"]]),\n na.b =3D = iff(exists(\"na.b\", dot), dot[[\"na.b\"]], x[[\"na.b\"]]),\n = na.c =3D iff(exists(\"na.c\", dot), dot[[\"na.c\"]], x[[\"na.c\"]]= ),\n\n zjoint.a =3D iff(exists(\"zjoint.a\", dot), dot[[\"zjoin= t.a\"]], x[[\"zjoint.a\"]]),\n zjoint.b =3D iff(exists(\"zjoint= .b\", dot), dot[[\"zjoint.b\"]], x[[\"zjoint.b\"]]),\n zjoint.c = =3D iff(exists(\"zjoint.c\", dot), dot[[\"zjoint.c\"]], x[[\"zjoint.c\"]])= ,\n\n noU =3D iff(exists(\"noU\", dot), dot[[\"noU\"]], = x[[\"noU\"]]),\n LAI =3D iff(exists(\"LAI\", dot), dot[[\= "LAI\"]], x[[\"LAI\"]])\n ),\n stop(\"No valid parametri= zation\")\n )\n return(u)\n}" nil) (7668 nil "file:~/Documents/Projec= ts/EnergyBalance/EnergyBalance.org::*wpLEL.wpLELFit" wpLEL\.wpLELFit:1 ((:c= olname-names) (:rowname-names) (:result-params "replace") (:result-type . v= alue) (: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 b= y\n##' calling \\code{wpLELDefault()} with the extracted\n##' parameter.\n#= #' @title Log-Exp-Log wind profile\n##' @param x object of class \\code{wpL= ELFit} to be used as source\n##' for the parameter to ctreate the \\code{wp= LEL} object\n##' @param ... additional arguments which are discarded\n##' @= return Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @exp= ort\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-pa= rams "replace") (:result-type . value) (:comments . "link") (:shebang . "")= (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/E= nergyBalance/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##' Gen= eric 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 sh= ould be calculated. If\n##' missing, \\code{x$z} will be used. the more poi= nts, 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 line= s 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 \\c= ode{plot} method\n##' @return incisible NULL\n##' @author Rainer M. Krug\n#= #' @export\nplot.wpLEL <- function(\n x,\n z,\n xlab =3D \"Wind Sp= eed (m/s)\",\n ylab =3D \"Height above ground (m)\",\n plotWPValues = =3D TRUE,\n plotWPPoints =3D TRUE,\n plotWPLines =3D TRUE,\n add = =3D FALSE,\n ...\n) {\n if (missing(z)) {z <- x$z}\n u <- wpLEL(x,= z=3Dz)\n ## setup plot if !add\n if (!add) {\n plot(\n = x =3D c(0, max(x$u, u$u)),\n y =3D c(0, max(x$z, u$z)),= \n type=3D \"n\",\n xlab =3D xlab,\n ylab = =3D ylab\n )\n }\n ## plot points\n points(\n x = =3D x$u,\n y =3D x$z,\n type=3D ifelse(plotWPPoints, \"p\",= \"n\"),\n ...\n )\n lines(\n x =3D u$u.onlyTop,\n = y =3D u$z,\n type =3D ifelse(plotWPLines, \"l\", \"n\"),\n = lty =3D \"dotted\",\n col =3D \"blue\"\n )\n lines(\n = x =3D u$u,\n y =3D u$z,\n type =3D ifelse(plotWPLines, \"l\",= \"n\"),\n lty =3D \"solid\",\n col =3D \"black\"\n )\n = if (plotWPValues) {\n mx <- par(\"usr\")[2]\n with(\n = x,\n {\n arrows(\n x0 =3D= c(0, 0, 0 ,0 ,0),\n y0 =3D c(z0+dep, za, h, dep, zjoint= ),\n x1 =3D c(4, 4, 4 ,4 ,4 ,4),\n y1= =3D c(z0+dep, za, h, dep, zjoint),\n length =3D 0,\n = col =3D \"grey\",\n lty =3D \"dotted\"\= n )\n text(mx, z0, paste('z0', round= (z0, 2), sep=3D\" =3D \" ), pos =3D 2)\n text(mx, za, = paste('za', round(za, 2), sep=3D\" =3D \" ), pos =3D 2)\n = text(mx, h, paste('hauteur', round(h, 2), sep=3D\" =3D \= " ), pos =3D 2)\n text(mx, dep, paste('dep', round(de= p, 2), sep=3D\" =3D \" ), pos =3D 2)\n text(mx, zjoint, p= aste('zjoint', round(zjoint, 2), sep=3D\" =3D \" ), pos =3D 2)\n = }\n )\n }\n invisible(NULL)\n}" nil) (7786 nil "file:~/Docum= ents/Projects/EnergyBalance/EnergyBalance.org::*print.wpLEL" print\.wpLEL:1= ((:colname-names) (:rowname-names) (:result-params "replace") (:result-typ= e . 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 pr= ints 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 <- func= tion(\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 ((:colnam= e-names) (:rowname-names) (:result-params "replace") (:result-type . value)= (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:n= oweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.default.= single.R") (:exports . "both") (:results . "replace") (:session . "*R.Energ= yBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlin= es . "no")) "##' Fitting of \\code{wpLEL} to a given wind profile using the= \n##' \\code{optim} function.\n##'\n##' The function used \\code{\\link{opt= im}} to fit the input values\n##' (\\code{u} and \\code{z}) to a \\code{lin= k{wpLEL}} wind profile.\n##' @title fitOptim.wpLEL.default.single\n##' @par= am z height at which wind speeds are measured\n##' @param u wind speed at h= eights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param initial Initia= l 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=3D10, z0=3D0.2, na=3D2, zjoint=3D0.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 \\cod= e{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 clas= s \\code{wpLELFit}. The class contains the followig elements:\n##' \\itemiz= e{\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{opt= im}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}= }\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.default.s= ingle <- function(\n z,\n u,\n LAI,\n initial =3D c(dep=3D25, z= 0=3D0.8*28, na=3D9, zjoint=3D0.2*2),\n h =3D 28,\n za =3D 3= 7,\n z0sol =3D 0.001,\n ...\n ) {\n ## Function to be minimise= d\n wpLELMin <- function(par, z, u, ua, h, za, z0sol) {\n if (\n = isTRUE(\n parameterOK(\n z = =3D z,\n ua =3D ua,\n dep = =3D par[1], # par$dep,\n z0 =3D par[2], # par$z0,\n = na =3D par[3], # par$na,\n zjoint= =3D par[4], # par$zjoint\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol\n = )\n )\n ) {\n p <- wpLELDefault(= \n z =3D z,\n ua =3D ua,\n = dep =3D par[1], # par$dep,\n z0 =3D par[2], # p= ar$z0,\n na =3D par[3], # par$na,\n zjoin= t =3D par[4], # par$zjoint\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n check = =3D 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$init= ial <- initial\n result$dot <- list(...)\n result$z <- z\n result= $u <- u\n result$fit <- optim(\n par =3D c(\n initial[= \"dep\"],\n initial[\"z0\"],\n initial[\"na\"],\n = initial[\"zjoint\"]\n ),\n fn =3D wpLELMin,\n = z =3D z,\n u =3D u,\n ua =3D ua,\n h= =3D h,\n za =3D za,\n z0sol =3D z0sol,\n ...\n= )\n result$wp <- wpLELDefault(\n z =3D z,\n u= a =3D ua,\n dep =3D result$fit$par[\"dep\"],\n z0 = =3D result$fit$par[\"z0\"],\n na =3D result$fit$par[\"na\"],\n = zjoint =3D result$fit$par[\"zjoint\"],\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol\n )\n\n class(result) = <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (7942 nil "f= ile:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.m= ahat.single" fitOptim\.wpLEL\.mahat\.single ((:colname-names) (:rowname-nam= es) (: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 . "ne= ver") (: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 in= put values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL.mahat}} wi= nd 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##' @p= aram za constant value for \\code{za} which will be passed to the\n##' func= tion \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0s= ol} 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{n= a}, \\code{zjoint}. The default value is\n##' \\code{c(dep=3D10, z0=3D0.2, = na=3D2, zjoint=3D0.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{wpLEL= Fit}. The class contains the followig elements:\n##' \\itemize{\n##' \\it= em{\\code{method}} {name of function used for fitting}\n##' \\item{\\code= {initial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments p= assed 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 <- functio= n(\n z,\n u,\n LAI,\n initial =3D c(na=3D9, zjoint=3D0.2*2, y= =3D3),\n h =3D 28,\n za =3D 37,\n z0sol =3D 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 =3D z,\n ua =3D ua,\n = na =3D par[1], # na\n zjoint =3D par[2], # = zjoint\n h =3D h,\n za =3D z= a,\n z0sol =3D z0sol,\n LAI =3D L= AI,\n y =3D par[3] # y\n )\n = result <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n= silent =3D TRUE\n )\n return( result )\n }= \n\n ua <- u[length(u)]\n result <- list()\n result$method <- \"fi= tOptim.wpLEL.mahat.single\"\n result$initial <- initial\n result$dot= <- list(...)\n result$z <- z\n result$u <- u\n result$fit <- opti= m(\n par =3D c(\n initial[\"na\"],\n initial[\= "zjoint\"],\n initial[\"y\"]\n ),\n fn =3D wpLE= LMin,\n z =3D z,\n u =3D u,\n ua =3D ua,\n = h =3D h,\n za =3D za,\n z0sol =3D z0sol,\n = LAI =3D LAI,\n ...\n )\n result$wp <- wpLELMahat(\n = z =3D z,\n ua =3D ua,\n na =3D result$fit$par[= \"na\"],\n zjoint =3D result$fit$par[\"zjoint\"],\n h = =3D h,\n za =3D za,\n z0sol =3D z0sol,\n LAI = =3D LAI,\n y =3D result$fit$par[\"y\"]\n )\n\n class(resu= lt) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8053 ni= l "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpL= EL.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##' @titl= e fitOptim.wpLEL.LE.single\n##' @param z height at which wind speeds are me= asured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Leaf A= rea Index\n##' @param initial Initial values for the parameters to be optim= ized\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##' \\co= de{z0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep= =3D10, z0=3D0.2, na=3D2, zjoint=3D0.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 \\co= de{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, uppe= r}, \\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##' \\i= tem{\\code{initial}} {initial values for fit}\n##' \\item{\\code{dot}} {a= rguments passed as \\code{...} passed on to optimisation function, here \\c= ode{\\link{optim}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\it= em{\\code{u}} {observefd wind speed at height \\code{z}}\n##' \\item{\\co= de{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 =3D c(dep=3D25, z0=3D0.8*2= 8, na=3D9),\n h =3D 28,\n za =3D 37,\n ...\n) {\n wpL= ELMin <- function(par, z, u, ua, h, za) {\n result <- NA\n tr= y({\n p <- wpLELLE(\n z =3D z,\n = ua =3D ua,\n dep =3D par[1], # pa= r$dep,\n z0 =3D par[2], # par$z0,\n = na =3D par[3], # par$na,\n h =3D h,\n = za =3D za\n )\n result <= - sum( ( (p$u - u)^2 ) / length(u) )\n },\n silent = =3D TRUE\n )\n return( result )\n }\n\n ua <- u[len= gth(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.LE.sin= gle\"\n result$initial <- initial\n result$dot <- list(...)\n res= ult$z <- z\n result$u <- u\n result$fit <- optim(\n par =3D c(= \n initial[\"dep\"],\n initial[\"z0\"],\n = initial[\"na\"]\n ),\n fn =3D wpLELMin,\n z = =3D z,\n u =3D u,\n ua =3D ua,\n h =3D h= ,\n za =3D za,\n## z0sol =3D z0sol,\n ...\n )\= n result$wp <- wpLELLE(\n z =3D z,\n ua =3D ua,\n= dep =3D result$fit$par[\"dep\"],\n z0 =3D result$fit$= par[\"z0\"],\n na =3D result$fit$par[\"na\"],\n h = =3D h,\n za =3D za\n )\n\n class(result) <- c(class(result= ), \"wpLELFit\")\n return(result)\n}" nil) (8157 nil "file:~/Documents/P= rojects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahatLE.single" fi= tOptim\.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") (:re= sults . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkd= irp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{= wpLEL.mahatLE} to a given wind profile using the\n##' \\code{optim} functio= n.\n##'\n##' The function used \\code{\\link{optim}} to fit the input value= s\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL.mahatLE}} wind prof= ile.\n##' @title fitOptim.wpLEL.mahatLE.single\n##' @param z height at whic= h 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} wh= ich 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} w= hich 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}). Th= e parameter are in the order of \\code{dep},\n##' \\code{z0}, \\code{na}, \= \code{zjoint}. The default value is\n##' \\code{c(dep=3D10, z0=3D0.2, na=3D= 2, zjoint=3D0.5)}\n##' @param ... further arguments for \\code{optim}. Thes= e can be\n##' \\code{gr}, \\code{method}, \\code{lower, upper}, \\code{cont= rol} 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{init= ial}} {initial values for fit}\n##' \\item{\\code{dot}} {arguments passed= as \\code{...} passed on to optimisation function, here \\code{\\link{opti= m}}}\n##' \\item{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {= observefd wind speed at height \\code{z}}\n##' \\item{\\code{fit}} {resul= t returned from fit, here the function \\code{\\link{optim}}}\n##' \\item= {\\code{wp}} {fitted wind profile of class \\code{wpLEL}}\n##' }\n##' @auth= or Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahatLE.single <- function(\= n z,\n u,\n LAI,\n initial =3D c(na=3D9, y=3D3),\n h = =3D 28,\n za =3D 37,\n z0sol =3D 0.001,\n ...\n) {\n wpLEL= Min <- function(par, z, u, ua, h, za, z0sol, LAI) {\n result <- NA\n= try({\n p <- wpLELMahatLE(\n z = =3D z,\n ua =3D ua,\n na = =3D par[1], # na\n h =3D h,\n za= =3D za,\n LAI =3D LAI,\n y = =3D par[2] # y\n )\n result <- sum( (= (p$u - u)^2 ) / length(u) )\n },\n silent =3D 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 =3D c(\n = initial[\"na\"],\n initial[\"y\"]\n ),\n = fn =3D wpLELMin,\n z =3D z,\n u =3D u,\n ua= =3D ua,\n h =3D h,\n za =3D za,\n z0sol = =3D z0sol,\n LAI =3D LAI,\n ...\n )\n result$wp <- wp= LELMahatLE(\n z =3D z,\n ua =3D ua,\n na = =3D result$fit$par[\"na\"],\n h =3D h,\n za =3D za,\= n z0sol =3D z0sol,\n LAI =3D LAI,\n y =3D res= ult$fit$par[\"y\"]\n )\n\n class(result) <- c(class(result), \"wpLELF= it\")\n return(result)\n}" nil) (8264 nil "file:~/Documents/Projects/Ene= rgyBalance/EnergyBalance.org::*fitOptim.castanea.single" fitOptim\.wpLEL\.c= astanea\.single ((:colname-names) (:rowname-names) (:result-params "replace= ") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "n= o") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/= R/fitOptim.wpLEL.castanea.single.R") (:exports . "both") (:results . "repla= ce") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (= :tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} to a gi= ven wind profile using the\n##' \\code{optim} function.\n##'\n##' The funct= ion 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.wpLE= L.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##' \\co= de{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=3D10, z0= =3D0.2, na=3D2, zjoint=3D0.5)}\n##' @param h constant value for \\code{h} w= hich 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##' @para= m ... 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 foll= owig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of funct= ion used for fitting}\n##' \\item{\\code{initial}} {initial values for fi= t}\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 heig= ht \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, here th= e function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind pr= ofile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @expo= rt\nfitOptim.wpLEL.castanea.single <- function(\n z,\n u,\n LAI,\n= initial =3D c(zjoint=3D0.2*2),\n h =3D 28,\n za =3D 37,\= n z0sol =3D 0.001,\n ...\n) {\n wpLELMin <- function(par, z, u, u= a, h, za, z0sol, LAI) {\n result <- NA\n try({\n = p <- wpLELCastanea(\n z =3D z,\n = ua =3D ua,\n zjoint =3D par[1], # par$zjoint\n = h =3D h,\n za =3D za,\n = z0sol =3D z0sol,\n LAI=3DLAI\n = )\n result <- sum( ( (p$u - u)^2 ) / length(u) )\n = },\n silent =3D 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 <- initi= al\n result$dot <- list(...)\n result$z <- z\n result$u <- u\n = result$fit <- optim(\n par =3D c(\n initial[\"zjoint\"]\n= ),\n fn =3D wpLELMin,\n z =3D z,\n u = =3D u,\n ua =3D ua,\n h =3D h,\n za =3D za= ,\n z0sol =3D z0sol,\n LAI =3D LAI,\n ...\n )\n = result$wp <- wpLELCastanea(\n z =3D z,\n ua =3D ua= ,\n zjoint =3D result$fit$par[\"zjoint\"],\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n LAI =3D LAI\n = )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(res= ult)\n}" nil) (8370 nil "file:~/Documents/Projects/EnergyBalance/EnergyBala= nce.org::*fitOptim.wpLEL.default.multiple" fitOptim\.wpLEL\.default\.multip= le ((:colname-names) (:rowname-names) (:result-params "replace") (:result-t= ype . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline= . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wp= LEL.default.multiple.R") (:exports . "both") (:results . "replace") (:sessi= on . "*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##' Loa= d all wind profiles using \\code{loadWS()} and fit each single\n##' one usi= ng the function provided in \\code{FUN}. Results are cached.\n##' @title fi= tOptim.wpLEL.ownFree.multiple\n##' @param wso Wind speed profiles in the fo= rmat as read from \\code{loadWS(wide=3DTRUE, ...)}\n##' @param initial init= ial\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 ver= bosity.\n##' @param ... additional arguments to be passed on to \\code{opti= m()}\n##' @return an oject of class \\code{wpFit} containing the result of\= n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.defa= ult.multiple <- function(\n wso,\n initial =3D c(dep=3D25, z0=3D0.8*2= 8, na=3D9, zjoint=3D0.2*2),\n h =3D 28,\n za =3D 37,\n z= 0sol =3D 0.001,\n silentError =3D TRUE,\n ...\n ) {\n\n ## Fun= ction 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 funct= ion(u) {\n p <- NULL\n try( {\n = p <- wpLELDefault(\n z =3D z,\n = ua =3D u[length(u)],\n ##\n= h =3D h,\n za =3D za= ,\n z0sol =3D z0sol,\n = ## \n dep =3D par[1],\n = z0 =3D par[2],\n na =3D par[3],= \n zjoint =3D par[4]\n = )\n },\n silent =3D 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 <- ms= e[!is.na(mse)]\n if (length(mse) > 0) {\n mse <- sum( ( m= se^2 ) / length(mse), na.rm=3DTRUE )\n } else {\n mse <= - NA\n }\n return(mse)\n }\n \n ## construct resul= t 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 =3D initial,\n fn =3D minFUN,\n ##\n = z =3D z,\n h =3D h,\n za =3D za,\n = z0sol =3D z0sol,\n ##\n wsFit =3D 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 =3D z,\n ua =3D mean(wso[2,][[1]]),\n dep =3D = result$fit$par[\"dep\"],\n z0 =3D result$fit$par[\"z0\"],\n = na =3D result$fit$par[\"na\"],\n zjoint =3D result$fit$par[\"= zjoint\"],\n h =3D h,\n za =3D za,\n z0sol = =3D z0sol\n )\n ##\n \n class(result) <- c(class(result), \"wpL= ELFit\")\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 . "") (:cac= he . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyB= alance/R/fitOptim.wpLEL.mahat.multiple.R") (:exports . "both") (:results . = "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "y= es") (:tangle-mode . 292) (:hlines . "no")) "##' The function loads individ= ual wind profiles using the function\n##' \\code{loadWS} and fits each one = using the function\n##' \\code{FUN}. The results are stored in \\code{./cac= he}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each s= ingle\n##' one using the function provided in \\code{FUN}. Results are cach= ed.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param wso Wind speed = profiles in the format as read from \\code{loadWS(wide=3DTRUE, ...)}\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 th= is is purely cosmetical and\n##' affects the verbosity.\n##' @param ... add= itional values to be passed on to \\code{optim}\n##' @return an object of c= lass \\code{wpFit} containing the result of\n##' the fit.\n##' @author Rain= er M. Krug\n##' @export\nfitOptim.wpLEL.mahat.multiple <- function(\n ws= o,\n initial =3D c(na=3D9, zjoint=3D0.2*2, y=3D3),\n h =3D 28,\n= za =3D 37,\n z0sol =3D 0.001,\n silentError =3D TRUE,\n .= ..\n ) {\n \n ## Function to be minimised\n minFUN <- function(= \n par,\n ## ## passed in par:\n ## na\n ## z= joint\n ## y\n ## ## passed in the other arguments:\n = z,\n h, za, z0sol,\n ## the data to be fitted to\n ws= Fit\n ) {\n mse <- sapply(\n wsFit,\n f= unction(u) {\n p <- NULL\n try( {\n = p <- wpLELMahat(\n z =3D z,\n = ua =3D u[length(u)],\n = na =3D par[1],\n zjoint =3D par[2],\n = h =3D h,\n za = =3D za,\n z0sol =3D z0sol,\n = LAI =3D u[[1]],\n y =3D par[3]\n= )\n },\n = silent =3D 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=3DTRUE )\n } e= lse {\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 res= ult$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 =3D initial,\n fn = =3D minFUN,\n ##\n z =3D z,\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n ##\n wsFit = =3D 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$w= p <- wpLELMahat(\n z =3D z,\n ua =3D mean(as.numeric= (wso[2,])),\n na =3D result$fit$par[\"na\"],\n zjoint =3D= result$fit$par[\"zjoint\"],\n h =3D h,\n za =3D za,= \n z0sol =3D z0sol,\n LAI =3D mean(as.numeric(wso[1,])),\= n y =3D result$fit$par[\"y\"]\n )\n ##\n \n class(r= esult) <- 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) (:comm= ents . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . = "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.ownFree.multipl= e.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBala= nce*") (: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 pro= vided in \\code{FUN}. Results are cached.\n##' @title fitOptim.wpLEL.ownFre= e.multiple\n##' @param wso Wind speed profiles in the format as read from \= \code{loadWS(wide=3DTRUE, ...)}\n##' @param initial initial parameter value= s for \\code{optim()}\n##' @param z0 z0\n##' @param na na\n##' @param zjoin= t zjoint \n##' @param h h\n##' @param za za\n##' @param z0sol z0sol\n##' @p= aram silentError sielence error message during fitting. Fitting\n##' is don= e in a \\code{try()} block so this is purely cosmetical and\n##' affects th= e verbosity.\n##' @param ... additional argumaents to be passed to \\code{o= ptim}\n##' @return an oject of class \\code{wpFit} containing the result of= \n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.own= Free.multiple <- function(\n wso,\n initial =3D unlist(\n list= (\n dep =3D c(a=3D0.5, b=3D0.02, c=3D-2),\n z0 = =3D c(a=3D0.23, b=3D0.25, c=3D10),\n na =3D c(a=3D0.23, b= =3D0.25, c=3D10),\n zjoint =3D c(a=3D0.23, b=3D0.25, c=3D10)\n = )\n ),\n h =3D 28,\n za =3D 37,\n z0sol = =3D 0.001,\n silentError =3D TRUE,\n ...\n ) {\n\n ## Function= to be minimised\n minFUN <- function(\n par,\n ## ## pass= ed in par:\n ## dep.a, dep.b, dep.c,\n ## z0.a, = z0.b, z0.c,\n ## na.a, na.b, na.c,\n ## z= joint.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 =3D= z,\n ua =3D u[length(u)],\n = ##\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n = ## .a .b .c\n dep.a = =3D par[ 1], dep.b =3D par[ 2], dep.c =3D par[ 3],\n = z0.a =3D par[ 4], z0.b =3D par[ 5], z0.c =3D par[= 6],\n na.a =3D par[ 7], na.b =3D par[ 8= ], na.c =3D par[ 9],\n zjoint.a =3D par[10],= zjoint.b =3D par[11], zjoint.c =3D par[12],\n L= AI =3D u[[1]]\n )\n },\n = silent =3D silentError\n )\n = if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)= ])^2 ) / length(p$u) ) \n } else {\n r= esult <- NA\n }\n return( result )\n = }\n )\n ## maxMse <- quantile(mse, probs=3Dc(0, (1 = - exclHighMseProp), 0.5, 1))\n ## mse <- mse[mse <=3D maxMse[2]]\n = mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n = mse <- sum( ( mse^2 ) / length(mse), na.rm=3DTRUE )\n } else {\n = mse <- NA\n }\n ## print(mse)\n return(mse= )\n }\n \n ## construct result list\n result <- list()\n res= ult$method <- \"fitOptim.wpLEL.ownFree.multiple\"\n result$initial <- in= itial\n result$dot <- list(...)\n result$wpLELParameter <- list(\n = h =3D h,\n za =3D za,\n z0sol =3D z0sol\n = )\n ## result$z <- z\n ## result$u <- u\n ## Do the optimisatio= n\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n res= ult$fit <- optim(\n par =3D initial,\n fn =3D minFUN,\n = ##\n z =3D z,\n h =3D h,\n za =3D za,= \n z0sol =3D z0sol,\n ##\n wsFit =3D 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(cl= ass(result), \"wpLELFit\")\n return(result)\n}" nil) (8772 nil "file:~/D= ocuments/Projects/EnergyBalance/EnergyBalance.org::*Goodness%20of%20fit%20f= or%20wpLELFit" Goodness\ of\ fit\ for\ wpLELFit:1 ((:colname-names) (:rowna= me-names) (:result-params "replace") (:result-type . value) (:comments . "l= ink") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:= tangle . "./package/EnergyBalance/R/gof.wpLELfit.R") (:exports . "both") (:= results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:m= kdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Calculate goodne= s 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 ob= served wind profile \\code{wp}\n##' \n##' @title gof.wpLELfit\n##' @param f= it 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 gofFu= n function returning the goodnes of fit.\n##' @param silentError sielence e= rror message during fitting. Fitting\n##' is done in a \\code{try()} block = so this is purely cosmetical and\n##' affects the verbosity.\n##' This func= tion accepts the two argumentsa \\code{obs, exp}.\n##' These can be assumed= of being of the same length. An example is the =3Ddefault 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 =3D function(obs, exp){ sum( ( (exp - obs)= ^2 ) / length(obs), na.rm=3DTRUE ) },\n silentError =3D 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 =3D o$z,\n = ua =3D wp[i, \"ua\"],\n LAI =3D wp[i,\= "lai\"]\n )\n gof <- gofFun(\n = obs =3D o$ws,\n exp =3D e$u\n = )\n gof\n },\n = silent =3D silentError\n )\n return(go= f)\n\n }\n )\n}" nil) (8832 nil "file:~/Documents/Projects/En= ergyBalance/EnergyBalance.org::*plot.wpLELFit" plot\.wpLELFit:1 ((:colname-= names) (:rowname-names) (:result-params "replace") (:result-type . value) (= :comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:now= eb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFit.R") (:expor= ts . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval= . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' G= eneric function to plot \\code{wpLELFit}\n##'\n##' This function a \\code{w= pLELFit} object by plotting the fitted line\n##' smoothly and adding the or= iginal 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 cal= culated. If\n##' missing, \\code{x$z} will be used. the more points, the sm= oother\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 plot= ting the \\bold{original} points of the fit using the \\code{poiunts} funct= ion\n##' are plotted\n##' @return NULL\n##' @author Rainer M. Krug\n##' @ex= port\nplot.wpLELFit <- function(\n x,\n z,\n plotWPValues =3D TRUE= ,\n plotWPLines =3D TRUE,\n plotOrgPoints =3D TRUE,\n add =3D FAL= SE,\n ...\n ) {\n xu <- x$wp\n ## plot values (dep, ...)\n p= lot.wpLEL(\n xu,\n z,\n plotWPValues =3D plotWPValues,= \n plotWPPoints =3D FALSE,\n plotWPLines =3D FALSE,\n = add =3D add\n )\n ## plot fitted lines \n plot.wpLEL(\n = xu,\n z,\n plotWPValues =3D FALSE,\n plotWPPoints = =3D FALSE,\n plotWPLines =3D plotWPLines,\n add =3D TRUE\n = )\n ## plot original points \n points(\n x$u,\n = x$z,\n type =3D ifelse(plotOrgPoints, \"p\", \"n\"),\n ...\= n )\n}" nil) (8890 nil "file:~/Documents/Projects/EnergyBalance/Ener= gyBalance.org::*print.wpLELFit" print\.wpLELFit:1 ((:colname-names) (:rowna= me-names) (:result-params "replace") (:result-type . value) (:comments . "l= ink") (: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 functi= on to print \\code{wpLELFit}\n##'\n##' This function prints a \\code{wpLELF= it} 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/wp= FitEach.R") (:exports . "both") (:results . "replace") (:session . "*R.Ener= gyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hli= nes . "no")) "##' The function loads individual wind profiles using the fun= ction\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 pr= ofiles using \\code{loadWS()} and fit each single\n##' one using the functi= on provided in \\code{FUN}. Results are cached.\n##' @title wpLELFitEach\n#= #' @param new if \\code{TRUE} the cache is re-created - if\n##' \\code{FALS= E} 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##' additi= onal 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 m= inSpeedIncreaseWide 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 w= ind speed to one - see \\link{loadWS} for details\n##' @param WAI Wood Area= Index, argument \\code{WAI} of function\n##' \\code{loadWS()}. Will be add= ed to lai from raw data.\n##' @param selectWPFit a function returning \\bol= d{a vector} where each\n##' element represents the indices of loaded wind p= rofiles which will\n##' be used for fitting the parameter. The function tak= es 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 =3D TRUE,\n##' = onlyComplete =3D TRUE,\n##' minSpeedIncreaseWide,\n#= #' maxWindSpeedWide,\n##' maxWindSpeedOneWide,\n#= #' WAI =3D WAI\n##' )\n##' }\n##'\n##' Examples a= re:\n##'\n##' \\code{selectWPFit =3D function(wso){TRUE}}\n##'\n##' which w= ould select all elements in \\code{wso}.This is the default.\n##' \n##' \\c= ode{selectWPFit =3D function(wso){sample(1:nrow(wso), 100)}}\n##' \n##' whi= ch would create vector of 100 randomly selected wind profiles\n##' \\bold{s= elected} for fitting or\n##'\n##' \\code{selectWPFit =3D function(wso){-sam= ple(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 \\co= de{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= =3D FALSE,\n suffix =3D \"\",\n FUN =3D \"wpLEFitSingle\",\n core= s =3D detectCores() - 1,\n minSpeedIncreaseWide =3D 0,\n maxWindSpeed= Wide =3D 10,\n maxWindSpeedOneWide =3D FALSE,\n WAI =3D 0,\n selec= tWPFit =3D function(wso) { TRUE },\n ...\n ) {\n if (cores=3D=3D0)= {\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 } els= e {\n ## Load wind priofile data\n wso <- loadWS(\n = wide =3D TRUE,\n onlyComplete =3D TRUE,\n = minSpeedIncreaseWide,\n maxWindSpeedWide,\n = maxWindSpeedOneWide,\n WAI =3D WAI\n )\n = \n ## #################################\n ## From no= w on, LAI (later u[[1]]) is LAI =3D LAI + WAI)\n ## ##############= ###################\n\n ## Get indices for fitting. Must only be d= one once as the\n ## functions might contain random number generat= ion!\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 =3D minSpeedIncreaseWide,\n = maxWindSpeedWide =3D maxWindSpeedWide,\n maxWindSpe= edOneWide =3D maxWindSpeedOneWide,\n WAI =3D WAI\n = )\n md$selectWPFit <- list(\n fun =3D selectWPFit,\= n indices =3D indFit\n )\n md$dot <- lis= t(...)\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=3Dwso$ua, ws)\n = ws <- cbind(lai=3Dwso$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 = =3D z,\n u =3D u[-(1:2)],\n LAI = =3D 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)=3D=3Di){\n cat(i, = \"\\tof about\\t\", no, \"\\r\")\n }\n re= turn(f)\n },\n mc.cores =3D cores\n = )\n class(dat) <- c(\"wpLELFitList\", class(dat))\n saveR= DS(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 . "./packag= e/EnergyBalance/R/wpFitMultiple.R") (:exports . "both") (:results . "replac= e") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:= tangle-mode . 292) (:hlines . "no")) "##' The function loads individual win= d profiles using the function\n##' \\code{loadWS} and fits each one using t= he 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-creat= ed - 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 fi= tting TODO\n##' @param cores number of cores to be used for analysis - defa= ults to the number of cores mius one, but is at least 1.\n##' @param minSpe= edIncreaseWide minimum wind speed difference - see \\link{loadWS} for detai= ls\n##' @param maxWindSpeedWide maximum wind speed - see \\link{loadWS} for= details\n##' @param maxWindSpeedOneWide standardise highest sampled wind s= peed to one - see \\link{loadWS} for details\n##' @param WAI Wood Area Inde= x, 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 pr= ofiles to be\n##' included. Values smaller than 0 will include all wind pro= files.\n##' @param selectWPFit a function returning \\bold{a list} where ea= ch\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##' loa= ded wind profiles, as returned by the function\n##'\n##' code{\n##' = wso <- loadWS(\n##' wide =3D TRUE,\n##' = onlyComplete =3D TRUE,\n##' minSpeedIncreaseWide,\n##' = maxWindSpeedWide,\n##' maxWindSpeedOneWide,\n##' = WAI =3D WAI\n##' )\n##' }\n##'\n##' An exapmle is\n##'= \n##' \\code{selectWPFit =3D function(wso){lapply(1:5, function(x){sample(1= :nrow(wso), 100)})}}\n##' \n##' which would create a list of 5 elements whe= re each consists of 100\n##' randomly selected wind profiles \\bold{selecte= d} for fitting or\n##'\n##' \\code{selectWPFit =3D function(wso){lapply(1:1= 0, 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 par= ameter passed to FUN ( mainly for the function \\code{optim()} )\n##' @retu= rn an oject of class \\code{wpLELFitList} (i.e. \\code{list}) of\n##' the l= ength of the number wind profiles to fit. Each element\n##' contains the re= sult of an individual fit.\n##' @author Rainer M. Krug\n##' @export\nwpFitM= ultiple <- function(\n new =3D FALSE,\n suffix =3D \"\",\n FUN =3D= \"fitOptim.wpLEL.ownFree.multiple\",\n cores =3D detectCores() - 1,\n = minSpeedIncreaseWide =3D 0,\n maxWindSpeedWide =3D 10,\n maxWindSpe= edOneWide =3D FALSE,\n minUstar =3D 0.25,\n WAI =3D 0,\n selectWPF= it =3D function(wso) { lapply(1:5, function(x){sample(1:nrow(wso), 100)}) }= ,\n ...\n ) {\n if (cores=3D=3D0) {\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 =3D TRUE,\n= onlyComplete =3D TRUE,\n minSpeedIncreaseWide = =3D minSpeedIncreaseWide,\n maxWindSpeedWide =3D maxWindSpeedW= ide,\n maxWindSpeedOneWide =3D maxWindSpeedOneWide,\n = minUstar =3D minUstar,\n WAI =3D WAI\n )\n = \n ## #################################\n ## From= now on, LAI (later u[[1]]) is LAI =3D LAI + WAI)\n ## ###########= ######################\n\n ## Get indices for fitting. Must only b= e done once as the\n ## functions might contain random number gene= ration!\n indFit <- selectWPFit(wso)\n\n ## Save \"metada= ta\"\n ## construct result list\n md <- list()\n = md$method <- \"wpFitMultiple\"\n md$FUN <- FUN\n md$load= WSParm <- list(\n minSpeedIncreaseWide =3D minSpeedIncreaseWid= e,\n maxWindSpeedWide =3D maxWindSpeedWide,\n max= WindSpeedOneWide =3D maxWindSpeedOneWide,\n minUstar =3D minUs= tar,\n WAI =3D WAI\n )\n md$selectWPFit = <- list(\n fun =3D selectWPFit,\n indices =3D ind= Fit\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=3Dwso$ua, ws)\n = ws <- cbind(lai=3Dwso$lai, ws)\n ws <- as.data.frame(t(ws))\n\= n ## Do the fitting\n i <- 0\n no <- ceiling(nco= l(ws) / cores)\n dat <- mclapply(\n indFit,\n = function(s) {\n f <- FUN(\n wso= =3D ws[,s],\n ...\n )\n = i <<- i + 1\n if (round(i, -2)=3D=3Di){\n = cat(i, \"\\tof about\\t\", no, \"\\r\")\n }\= n return(f)\n },\n mc.cores =3D = cores\n )\n class(dat) <- c(\"wpLELFitList\", class(d= at))\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/EnergyBala= nce/EnergyBalance.org::*plot.wpLELFitList" plot\.wpLELFitList:1 ((:colname-= names) (:rowname-names) (:result-params "replace") (:result-type . value) (= :comments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:now= eb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFitList.R") (:e= xports . "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 pl= ots an \\code{wpLELFitList} object by plotting the\n##' lines of each fit o= n each other. The indices can be specified by\n##' using y.\n##' @param x o= bject 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 ... option= al arguments for \\code{plot} method\n##' @return NULL\n##' @author Rainer = M. Krug\n##' @export\nplot.wpLELFitList <- function(\n x,\n y =3D NUL= L,\n ...\n ) {\n if (is.null(y)) {\n y <- 1:length(x)\n = }\n plot(\n x[[1]],\n add =3D FALSE,\n ...\n = )\n ##\n for (i in y[-1]) {\n plot(\n x[[i]],\n = add =3D TRUE,\n ...\n )\n }\n invisib= le()\n}" nil) (9283 nil "file:~/Documents/Projects/EnergyBalance/EnergyBala= nce.org::*print.wpLELFitList" print\.wpLELFitList:1 ((:colname-names) (:row= name-names) (:result-params "replace") (:result-type . value) (:comments . = "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") = (:tangle . "./package/EnergyBalance/R/print.wpLELFitList.R") (:exports . "b= oth") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "nev= er") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Generic = function to print \\code{wpLELFitList}\n##'\n##' This function prints a \\c= ode{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.wpLELFitL= ist <- function(\n x,\n ...\n) {\n cat( \"Number of fits: \" )\n = cat(length(x), \"\\n\")\n invisible(x)\n}" nil) (9311 nil "file:~/Docu= ments/Projects/EnergyBalance/EnergyBalance.org::*airRest%20Generic%20functi= on%20definition" airRest\ Generic\ function\ definition:1 ((:colname-names)= (:rowname-names) (:result-params "replace") (:result-type . value) (:comme= nts . "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 <- functi= on(x, zsource) UseMethod(\"airRest\")" nil) (9318 nil "file:~/Documents/Pro= jects/EnergyBalance/EnergyBalance.org::*airRest.wpLEL" airRest\.wpLEL ((:co= lname-names) (:rowname-names) (:result-params "replace") (:result-type . va= lue) (: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##' @par= am x object of class \\code{wpLEL}\n##' @param zsource if \\code{NULL} (def= ault), \\code{zsource =3D z0 + dep}, unless the numerical value\n##' @retur= n object of class \\code{airRest}.\n##' This object contains the following = elements:\n##' \\itemize{\n##' \\item{method} : {the method used to gener= ate the aerial profile (the name of this function)}\n##' \\item{wp} : {t= he wind profile on which the aerial resistance is based}\n##' \\item{I1} = : {aerial resistance top log profile}\n##' \\item{I2} : {aerial resista= nce from h to zsource}\n##' \\item{I3} : {aerial resistance for exp prof= ile}\n##' \\item{I4} : {aerial resistance lower exp profile}\n##' \\it= em{ras} : {aerial resistance from z0sol to top}\n##' \\item{rac} : {aeria= l resistance from zsource to za}\n##' }\n##' @author Rainer M. Krug\n##' @e= xport\nairRest.wpLEL <- function(\n x,\n zsource =3D 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 =3D=3D 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 prof= ile\n ## LEL - from zjoint to z0sol\n ## LE - 0\n if (x$zjoint = =3D=3D 0) {\n ## log-exp profile\n I4 <- 0\n } else {\n = ## log-exp-log profile\n I4 <- 1 / (x$vk*x$ustarsol) * log( x$z= joint/x$z0sol )\n }\n ##\n\n ## resistance from z0sol to za\n r= as =3D 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=3D=3D0) {\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 } els= e {\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 ## re= sistance 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:~/D= ocuments/Projects/EnergyBalance/EnergyBalance.org::*plot.arLEL" plot\.arLEL= :1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-t= ype . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline= . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.arLEL.= R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalanc= e*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "n= o")) "plot.arLEL <- function(\n x,\n plotWPPoints =3D TRUE,\n plot= WPValues =3D TRUE,\n plotARValues =3D TRUE,\n ...\n) {\n plot.wpLE= L(\n x,\n plotWPPoints =3D plotWPPoints,\n plotWPValue= s =3D plotWPValues,\n ...\n )\n if (plotARValues) {\n m= x <- par(\"usr\")[2]\n with(\n x,\n {\n = ## arrows(\n ## x0 =3D c(0, 0, 0 ,0 ,0 ,0),\n = ## y0 =3D c(z0+dep, za, h, hsource, dep, zjoint),\n = ## x1 =3D c(4, 4, 4 ,4 ,4 ,4),\n ## y1 =3D= c(z0+dep, za, h, hsource, dep, zjoint),\n ## length =3D= 0,\n ## col =3D \"grey\",\n ## lty = =3D \"dotted\"\n ## )\n \n \n = text(mx*0.4, (za+h)/2., paste(\"R1=3D\", round(R1, 2) = ) )\n text(mx*0.65, (z0= h+dep+h)/2., paste(\"R2z0h=3D\", round(R2z0h, 2), \"R2z0=3D\", round(R2z0, = 2) ) )\n text(mx*0.6, (z0+h)/2., paste(\"R3=3D\"= , round(R3, 2) ) )\n te= xt(mx*0.6, (2*z0+h)/3., paste(\"R4log=3D\", round(R4log, 2), \"R4exp=3D= \", round(R4exp, 2) ) )\n text(mx*0.5, 2, = paste(\"racz0h=3D\", round(racz0h, 2), \"racz0=3D\", round(racz0, 2) ) )\= n text(mx*0.5, 1, paste(\"raslog=3D\", round(r= aslog, 2), \"rasexp=3D\", round(rasexp, 2) ) )\n }\n )\n = }\n invisible(NULL)\n}" nil) (9464 nil "file:~/Documents/Projects/Ene= rgyBalance/EnergyBalance.org::*evapoTrans%20Generic%20function%20definition= " evapoTrans\ Generic\ function\ definition:1 ((:colname-names) (:rowname-n= ames) (:result-params "replace") (:result-type . value) (:comments . "link"= ) (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tang= le . "./package/EnergyBalance/R/evapoTrans.R") (:exports . "both") (:result= s . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp = . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans <- function(x) = UseMethod(\"evapoTrans\")" nil) (9471 nil "file:~/Documents/Projects/Energy= Balance/EnergyBalance.org::*evapoTrans.default" evapoTrans\.default:1 ((:co= lname-names) (:rowname-names) (:result-params "replace") (:result-type . va= lue) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no")= (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.default.= R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalanc= e*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "n= o")) "evapoTrans.default <- function(\n ras,\n rac,\n Ta =3D 2= 0,\n frach =3D 1,\n Rnhsol =3D 600,\n RH =3D 50, # deltae =3D= 5,\n gsol =3D 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.degre= eC-1\n Rauh <- -4.111 * Ta + 1289.764 # g/m3\n Psy= h <- 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 * Cp= h * deltae/ras) /\n (Landah * (deltah + Psyh * (1 + 1/(gsol * ra= s) )))\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 =3D ETRhrsol= ,\n etrHcsol =3D ETRhcsol,\n etrHsol =3D ETRhsol,\n e= tpCh =3D ETPch\n )\n etp$input <- list(\n ras =3D ras,\n= rac =3D rac,\n Ta =3D Ta,\n frach =3D frach,\= n Rnhsol =3D Rnhsol,\n RH =3D RH,\n gsol =3D gso= l\n )\n class(etp) <- c(\"evapoTrans\", \"list\")\n attr(etp, \"me= thod\") <- \"default\"\n return( etp )\n}" nil) (9530 nil "file:~/Docume= nts/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.airRest" evapoTra= ns\.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 = =3D 20,\n frach =3D 1,\n Rnhsol =3D 600,\n RH =3D 50, # del= tae =3D 5,\n gsol =3D 0.001\n) {\n etp <- evapoTrans.default(\n = ras =3D x$ras,\n rac =3D x$rac,\n Ta =3D Ta,\n = frach =3D frach,\n Rnhsol =3D Rnhsol,\n RH =3D RH= ,\n gsol =3D 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" evap= oTrans\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace= ") (:result-type . value) (:comments . "link") (:shebang . "") (:cache . "n= o") (: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 = =3D 20,\n frach =3D 1,\n Rnhsol =3D 600,\n RH =3D 50, # delta= e =3D 5,\n gsol =3D 0.001\n) {\n etp <- evapoTrans.airRest(\n = x =3D airRest(x),\n Ta =3D Ta,\n frach =3D frach,= \n Rnhsol =3D Rnhsol,\n RH =3D RH,\n gsol =3D gs= ol\n )\n attr(etp, \"method\") <- \"wpLEL\"\n return( etp )\n}" ni= l) (9588 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*l= hc.etp.R" lhc\.etp ((:colname-names) (:rowname-names) (:result-params "repl= ace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache .= "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalan= ce/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 l= atin hypercube based on the object \\code{x} of class\n##' \\code{wpLEL} an= d calculates the aeril resistance.\n##'\n##' Create latin hypercube based o= n 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.wpL= EL\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 Hyp= ercube sample\n##' @param Min list of named named elements for minimum valu= e 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 element= s for maximum values for each column in the\n##' Latin Hypercube. \\code{na= mes(Min)} has to be the same as \\code{names(Max)}!\n##' @param suffix suff= ix 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 retu= rns Latin Hypercube \\code{data.frame}\n##' @author Rainer M. Krug\n##' @ex= port\nlhc.etp <- function(\n x,\n n,\n Min,\n Max,\n suffix,= \n new =3D FALSE,\n cores =3D parallel::detectCores() - 1\n) {\n = if (missing(suffix)) {\n suffix <- paste0(\".\", paste(names(Min), s= ep =3D \"\", collapse=3D\"-\"))\n } else {\n suffix <- paste0(\".= \", paste(names(Min), sep =3D \"\", collapse=3D\"-\"), 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) !=3D length(= Max)) {stop(\"Min and Max have to have the same length!\")}\n if (!a= ll.equal(names(Min), names(Max) )) {stop(\"Min and Max have to have the sam= e names!\")}\n ## Build random Latin Hypercube\n dat <- lhs::= randomLHS(n=3Dn, k=3Dlength(Min))\n colnames(dat) <- names(Min)\n = ## Transform the 0..1 values to the selected range\n dat <- swe= ep(\n x =3D dat,\n MARGIN =3D 2,\n Max-Min= ,\n '*'\n )\n dat <- sweep(\n x =3D dat= ,\n MARGIN =3D 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 func= tion(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 i= f (depz0 < s$wp[[\"h\"]] & depz0 > s$wp[[\"zjoint\"]]) {\n = ar <- airRest(s$wp)\n etp <- evapoTrans.airRest(\n = x =3D ar,\n Ta =3D s[[= \"Ta\"]],\n frach =3D 1,\n R= nhsol =3D s[[\"Rnhsol\"]],\n RH =3D s[[\"RH\"]],= \n gsol =3D 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$etp= Ch\n class(s) =3D c(\"lhcAirRest\", class(s))\n = } else {\n s <- NULL\n }\n = i <<- i + 1\n if (round(i, -2) =3D=3D i) {\n = cat(i, \"\\t of about \\t\", no, \"\\t\\t\\r\")\n = }\n return(s)\n },\n mc.cores =3D co= res\n )\n cat(\"\\n\")\n result <- result[!sapply(resu= lt, is.null)]\n saveRDS(result, fn)\n }\n return(result)\n}" n= il) (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") (:e= xports . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:= eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#= # stopifnot(require(energyBalance))\n\n## Tolerance for numerical compariso= ns\nepsilon <- 1.0e-9\n\nua <- 3.136\nza <- 37\nz <- seq(\n from =3D 0,\= n to =3D za,\n by =3D 0.1\n)\n\n## Test 1\nu <- wpLEL(\n z,\n = ua =3D ua,\n dep =3D 14,\n z0 =3D 2.8,\n na =3D 7,\n zj= oint =3D 14.31625,\n h =3D 28,\n za =3D 37,\n z0sol =3D 0.01\n)\nu= .s <- readRDS(\"./tests/u.rds\")\nstopifnot( max(abs(unlist(u) - unlist(u.s= )), na.rm=3DTRUE ) < epsilon)\n\nu <- airRest(u)\nu.s <- readRDS(\"./tests/= u.ar.rds\")\nstopifnot( max(abs(unlist(u) - unlist(u.s)), na.rm=3DTRUE ) < = epsilon)\n\n## Test 2\nWAI <- 0.5\nLAI <- 0\nu1 <- wpLEL(\n z,\n ua = =3D ua,\n dep =3D function(PAI) {1.1*h*log(1+(Cd*PAI)^0.25)},\n PAI = =3D WAI + LAI\n)\nu1.s <- readRDS(\"./tests/u1.rds\")\nstopifnot( max(abs(u= nlist(u1) - unlist(u1.s)), na.rm=3DTRUE ) < epsilon)\n\nu1 <- airRest(u1)\n= u1.s <- readRDS(\"./tests/u1.ar.rds\")\nstopifnot( max(abs(unlist(u1) - unl= ist(u1.s)), na.rm=3DTRUE ) < epsilon)\n\n## Test 3\nWAI <- 0.5\nLAI <- 6\nu= 2 <- wpLEL(\n z,\n ua =3D ua,\n dep =3D function(PAI) {1.1*h*log(= 1+(Cd*PAI)^0.25)},\n PAI =3D WAI + LAI\n)\nu2.s <- readRDS(\"./tests/u2.= rds\")\nstopifnot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=3DTRUE ) < eps= ilon)\n\nu2 <- airRest(u2)\nu2.s <- readRDS(\"./tests/u2.ar.rds\")\nstopifn= ot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=3DTRUE ) < epsilon)" nil) (98= 28 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Package= %20Documentation" Package\ Documentation:1 ((:colname-names) (:rowname-name= s) (: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")) "#' EnergyBalance= Paper: 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 addi= tion it also contains\n#' further scripts for analysis and plots not includ= ed 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-ty= pe . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline = . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalancePaper/R/plotByL= AI.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBal= ance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines .= "no")) "plotByLAI <- function(x, lai, pars, lower, upper, ...){\n i <- = (x >=3D lower & x <=3D upper)\n plot(\n x =3D c(lower, upper),\n = y =3D c(-0.5, 8),\n type =3D \"n\",\n xlab =3D x,\n = ylab =3D \"round(LAI)\",\n axes =3D FALSE,\n ...\n )\= n ## abline(v =3D initial[x], col=3D\"blue\")\n box()\n axis(1)\n = axis(\n 2,\n at=3D0:7,\n labels=3Dc(\"0.5\", \"1.5\= ", \"2.5\", \"3.5\", \"4.5\", \"5.5\", \"6.5\", \"7\"),\n las =3D 1\= n )\n bp <- boxplot(\n x[i] ~ round(lai[i]),\n plot =3D= FALSE\n )\n bxp(\n bp,\n horizontal =3D TRUE,\n = notch =3D TRUE,\n at =3D as.numeric(bp$names),\n axes =3D FA= LSE,\n add =3D TRUE\n )\n}" nil) ...)) #[(by-lang) "@.A.\306 =0B\"A\206.=00 .\307\306 .\"A\203#.\310\306 .\"A!= \206$. \311P!.=0D\312.=0E\313\314\n\"-\207" [by-lang lang specs org-babel-t= angle-lang-exts ext org-src-lang-modes assoc intern symbol-name "-mode" nil= mapc #[(spec) "\306\211.\307!.\310!\211.G\311V\205.=00\n).\312!. \313\23= 0\203%.\314\315 !\2027. \316\230\203/.\317\2027. G\311V\2057. \211.\205P.= =0E,\203O. \313\230\203O.=0D\320.,Q\202P.=0D\211.-\2054.\321!\322.-!..\211= ./\203w.=0E.\203w.=0E/\316\230\204w.\323..\324\"\210*\325.-!\203\217.=0E-\3= 26\327.0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203\24= 7.\317\335\336\217\210=0B\203\277.=0E-.3\235\204\277.=0B\337Pc\210.-.3B.3\3= 40.4!\210\341 .5\331\332!.6r.6q\210\342\216\325.-!\203\340.\343.-!\210db\21= 0\344\345\346.48\"A\316\230\204\371.`eU\204\371.\337c\210.5c\210\347\317\21= 1.-#\210.=07=0B\203.=01\f\204.=01\350.=0E7T.7.-\fB.8\351.8.0\352\353$\203+.= =0E0\2023.=0E8.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 :she= bang 0 :tangle-mode "yes" file-name-sans-extension buffer-file-name "no" ni= l "." :mkdirp file-name-directory make-directory parents file-exists-p mapc= ar car delete-file generate-new-buffer " *temp*" ((byte-code "\301!\203\n.= \302!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) fboundp (func= all lang-f) ((error)) "\n" org-babel-spec-to-string buffer-string ((byte-co= de "\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-buf= fer ...] 6] lang-f she-banged] 5](("R" (5939 nil "file:~/Documents/Projects= /EnergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:rowna= me-names) (:result-params "replace") (:result-type . value) (:comments . "l= ink") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:= tangle . "./package/EnergyBalance/data/fileNames.R") (:exports . "both") (:= results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:m= kdirp . "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) (:row= name-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 profil= es, calculate the aerial resistance and plot the profiles.\n#' \n#' @sectio= n 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 SQL= ite\n#' @import DBI\n#' @import magrittr\nNULL\n#> NULL" nil) (5973 nil "fi= le:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((= :colname-names) (:rowname-names) (:result-params "replace") (:result-type .= value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "n= o") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/CACHE.R") (:expo= rts . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eva= l . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' C= ache for computations in package\n#'\n#' CACHE to be used for the computati= ons. The cac=3Dhe holde =3Dtemporary\n#' as well as final results of the co= mputations which are saved\n#' automatically to avoid re-computqtion. \n#' = \n#' @format Character vector of length one.\n#' @name CACHE\n#' @docType d= ata\nNULL" nil) (5986 nil "file:~/Documents/Projects/EnergyBalance/EnergyBa= lance.org::*SQLITEDB" SQLITEDB:1 ((:colname-names) (:rowname-names) (:resul= t-params "replace") (:result-type . value) (:comments . "link") (:shebang .= "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./packa= ge/EnergyBalance/R/SQLITEDB.R") (:exports . "both") (:results . "replace") = (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tang= le-mode . 292) (:hlines . "no")) "#' SQLite Database with processed input d= ata\n#'\n#' File name and path to the sqlite database which holds the proce= ssed\n#' wind speeds and LAI and the indices to increase access speed.\n#' = \n#' @format Character vector of length one.\n#' @name SQLITEDB\n#' @docTyp= e data\nNULL" nil) (6000 nil "file:~/Documents/Projects/EnergyBalance/Energ= yBalance.org::*getplotlim" getplotlim:1 ((:colname-names) (:rowname-names) = (:result-params "replace") (:result-type . value) (:comments . "link") (:sh= ebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "= ./package/EnergyBalance/R/getplotlim.R") (:exports . "both") (:results . "r= eplace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes= ") (:tangle-mode . 292) (:hlines . "no")) "##' Return the limits of the plo= t\n##'\n##' Return the limits, as set by \\code{xlim =3D } and \\code{ylim = =3D }. \n##' @param lim if \\code{xlim} or \\code{ylim} return the xorrespo= nding\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 =3D c(\"xlim\", \"ylim\")) {= \n usr <- par('usr')\n xr <- (usr[2] - usr[1]) / 27 # 27 =3D (100 + 2= *4) / 4\n yr <- (usr[4] - usr[3]) / 27\n return(\n switch(\n = EXPR =3D paste(sort(lim), collapse=3D\"\"),\n xlim =3D= c(usr[1] + xr, usr[2] - xr),\n ylim =3D c(usr[3] + yr, usr[4] -= yr),\n xlimylim =3D list(\n xlim =3D c(usr[1] + = xr, usr[2] - xr),\n ylim =3D c(usr[3] + yr, usr[4] - yr)\n = ),\n stop(\"Invalid value for lim!\")\n = ) \n )\n}" nil) (6032 nil "file:~/Documents/Projects/EnergyB= alance/EnergyBalance.org::*Input%20data%20directory%20discovery%20functions= " Input\ data\ directory\ discovery\ functions:1 ((:colname-names) (:rownam= e-names) (:result-params "replace") (:result-type . value) (:comments . "li= nk") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:t= angle . "./package/EnergyBalance/R/inputDataDir.R") (:exports . "both") (:r= esults . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mk= dirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Returns input dat= a dir\n##'\n##' Returns input data dir (the directory with the wind and LAI= \n##' input files are located in). If the package \\code{EnergyBalancePape= r} is\n##' installed, the data included in this package is returned,\n##' o= therwist the directory \\code{paste0{getwd(), \"/inputdata\"}} is\n##' retu= rned.\n##' \n##' @title inputDataDir\n##' @return input data directory for = win=3Dd and LAI data\n##' @author Rainer M. Krug\n##' @export\ninputDataDir= <- function() {\n file.path(\n ifelse(\n \"package:En= ergyBalancePaper\" %in% search(),\n system.file(package =3D \"En= ergyBalancePaper\"),\n getwd()\n ),\n \"inputd= ata\"\n )\n}" nil) (6120 nil "file:~/Documents/Projects/EnergyBalanc= e/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 . "bo= th") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "neve= r") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Import wi= nd data\n##'\n##' Import data into sqlite db and fit =3Ddefault=3D 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##' @pa= ram fn file name of wind date\n##' @return invisible \\code{NULL}\n##' @aut= hor Rainer M. Krug\n##' @export\nimportVentToDB <- function(fn, h) {\n w= sw <- read.csv(\n file =3D fn,\n stringsAsFactors =3D FALSE,\= n header =3D 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$zjoi= nt <- NA\n wsw$h <- NA\n wsw$za <- NA\n wsw$ustar <- NA\n ## Fi= t wpLELDefault and save parameter\n\n for (i in 1:nrow(wsw)) {\n = if(floor(i/20)*20 =3D=3D 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 =3D wp$z,\n = u =3D wp[,3],\n ## lower =3D c(dep=3D0, = z0=3D0.001, na=3D0.01, zjoint=3D0),\n initial =3D c(dep=3D2= , z0=3D2, na=3D2, zjoint=3D3)\n ## up= per =3D c(dep=3D27, z0=3Dh, na=3D20, zjoint=3Dh),\n = ## method =3D \"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$w= p[[\"ustar\"]]\n }\n }\n \n wsl <- data.frame(\n dat= e =3D wsw$date,\n time =3D wsw$time,\n julien =3D wsw$jul= ien,\n z =3D rep(\n c(3,11,17,23,29,37),\n = times =3D rep( nrow(wsw), 6 )\n ),\n ws =3D c(\n = wsw$h03,\n wsw$h11,\n wsw$h17,\n = wsw$h23,\n wsw$h29,\n wsw$h37\n ),\n = ua =3D wsw$ua,\n dep =3D wsw$dep,\n z0 =3D wsw$z= 0,\n na =3D wsw$na,\n zjoint =3D wsw$zjoint,\n h = =3D wsw$h,\n za =3D wsw$za,\n ustar =3D wsw$ustar\n = )\n ##\n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n = try({\n ## WindSpeed_w\n DBI::dbWriteTable(db, \"Wi= ndSpeed_w\", wsw, overwrite=3DTRUE)\n DBI::dbGetQuery(db, \"CREA= TE UNIQUE INDEX wsw_dt ON WindSpeed_w (date, time)\")\n DBI::d= bGetQuery(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 W= indSpeed_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=3DTRUE)\n = DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsl_dth ON WindSpeed_l (date, t= ime, z)\")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsl_jth O= N WindSpeed_l (julien, time, z)\")\n DBI::dbGetQuery(db, \"CREAT= E 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}" n= il) (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") (:t= angle-mode . 292) (:hlines . "no")) "##' Import LAI data\n##'\n##' Import L= AI data into sqlite db\n##' @param fn file name of LAI data\n##' @return in= visible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\nimportLAIToD= B <- function(fn) {\n lai <- read.csv(\n file =3D fn,\n s= tringsAsFactors =3D FALSE,\n header =3D TRUE\n )\n names(lai) = <- c(\n \"doy\",\n \"lai\"\n )\n ##\n db <- DBI::dbC= onnect(RSQLite::SQLite(), SQLITEDB)\n try(\n {\n DBI::= dbWriteTable(db, \"LeafAreaIndex\", lai, overwrite=3DTRUE)\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" createWsL= AI:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result= -type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padli= ne . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/createWsL= AI.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBal= ance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines .= "no")) "##' Finalize sqlight databaes of input data\n##'\n##' Create combi= ned wind speed and LAI table and associated indices in sqlite database.\n##= ' @return invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\n= createWsLAI <- function(\n ){\n sql_l <- paste(\n \"CREATE TAB= LE\",\n \" WindSpeedLAI_l\",\n \"AS SELECT\",\n \" W= indSpeed_l.*, LeafAreaIndex.lai AS lai\",\n \"FROM\", \n \" = WindSpeed_l\",\n \"LEFT OUTER JOIN\",\n \" LeafAreaIndex\",\= n \"ON\",\n \" julien=3DDOY\"\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=3DDOY\"\n )\n d= b <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try({\n ##= \n DBI::dbGetQuery( conn =3D db, statement =3D \"DROP TABLE IF E= XISTS WindSpeedLAI_l\")\n DBI::dbGetQuery( conn =3D db, statemen= t =3D 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 IND= EX 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 WindSpe= edLAI_l (ustar)\")\n ##\n DBI::dbGetQuery( conn =3D d= b, statement =3D \"DROP TABLE IF EXISTS WindSpeedLAI_w\")\n DBI:= :dbGetQuery( conn =3D db, statement =3D 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 WindSpeed= LAI_w (julien, time)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsl= aiw_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 WindSpeedL= AI_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/EnergyBa= lance/EnergyBalance.org::*createCache" createCache:1 ((:colname-names) (:ro= wname-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 \\co= de{CACHE}\n##'\n##' Deletes all files in the cache (directory \\code{CACHE}= ) and re-creates them\n##' @title Recreate files in cache\n##' @name create= Cache\n##' @return invisible NULL\n##' @author Rainer M. Krug\n##' @export\= n##' @param fnVent file name of Wind Profile csv file\n##' @param fnLAI fil= e 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(CA= CHE, showWarnings =3D FALSE)\n unlink(SQLITEDB)\n importVentToDB(fnVe= nt, 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 "rep= lace") (:result-type . value) (:comments . "link") (:shebang . "") (:cache = . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBala= nce/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 a= nd lai\n##' data. The sql argument can be used to specify different\n##' c= onditions for the data returned.\n##'\n##' Loads wind speed data from sql d= atabase 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*} an= d \\code{LAI}.\n##' @param minSpeedIncreaseWide numeric value or \\code{NUL= L}. If not \\code{NULL}, the following rules will be\n##' used to filter th= e 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=3D=3DTRUE}}\n##' \n##' = @param maxWindSpeedWide numeric value or \\code{null}. If not\n##' \\code{N= ULL}, wind profiles with wind speeds higher then\n##' \\code{maxWindSpeedWi= de} will be filtered out.\n##'\n##' \\bold{Only Applies To \\code{wide=3D= =3DTRUE}}\n##' \n##' @param maxWindSpeedOneWide Logical - if \\code{TRUE} t= he wind profiles will\n##' be standardised to wind speed at highest samplin= g point to 1 and\n##' the original wind speed will be stored in a field \\c= ode{ua}\n##'\n##' \\bold{Only Applies To \\code{wide=3D=3DTRUE}}\n##' \n##'= @param minUstar minimum ustar value to be included in analysis. The defaul= t 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##' \\cod= e{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=3D=3DTRUE}}= \n##' \n##' @return data.frame containing the data. If the \\code{wide=3D= =3DTRUE},\n##' the class is also set to \\code{wsw}, if \\code{wide=3D=3DFA= LSE} to\n##' \\code{wsl}\n##' @author Rainer M. Krug\n##' @export\nloadWS <= - function(\n wide =3D TRUE,\n onlyComplete =3D TRUE,\n minSpeedIn= creaseWide =3D 0,\n maxWindSpeedWide =3D 10,\n maxWindSpeedOneWide = =3D FALSE,\n minUstar =3D 0.25,\n WAI =3D 0,\n sql\n ) {\n i= f (wide) {\n tbln <- \"WindSpeedLAI_w\"\n } else {\n tbl= n <- \"WindSpeedLAI_l\"\n }\n try({ \n db <- dbConnec= t(RSQLite::SQLite(), SQLITEDB)\n if (missing(sql)) {\n = if (!onlyComplete) {\n sql <- paste( \"SELECT * FR= OM\", tbln ) \n } else {\n f= <- c( \"LAI\", grep(\"^h.\", dbListFields(db, tbln), value=3DTRUE))\n = f <- paste(f, \"IS NOT NULL\", collapse =3D \" AND \")\n = sql <- paste( \"SELECT * FROM \", tbln, \"WHERE\", f, \= "AND ustar >=3D\", minUstar)\n }\n }\n = ws <- DBI::dbGetQuery(db, sql)\n } \n )\n dbDisconne= ct(db)\n ##\n if (length(grep(\"date|time\", names(ws))) >=3D 2) {\n = ws$date <- as.Date(ws$date, format =3D \"%d/%m/%y\")\n ws$dat= eTime <- as.POSIXct(paste(ws$date, ws$time), format=3D\"%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=3DTRU= E, value=3DTRUE)\n )\n ]\n ##\n = }\n if (wide) {\n class(ws) <- c(class(ws), \"wsw\")\n = h <- rownames(dfFromLong(ws[2,]))\n if (!is.null(minSpeedIncreaseWid= e)) {\n ws <- ws[\n ws[,h] %>%\n = as.matrix %>%\n t %>%\n = diff %>%\n data.f= rame %>%\n sapply(\n = X =3D .,\n = FUN =3D . %>%\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 a= pply(\n X =3D .,\n MA= RGIN =3D 1,\n FUN =3D 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 cla= ss(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:~/D= ocuments/Projects/EnergyBalance/EnergyBalance.org::*dfFromLong" dfFromLong:= 1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-ty= pe . 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 colu= mn 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 patt= ern =3D \"^h[[:digit:]]\",\n x =3D names(x),\n value = =3D 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 =3D hCols,\n z = =3D h,\n u =3D u\n )\n } else { # is.matrix(u= ) =3D=3D TRUE\n result <- data.frame(\n index =3D hCo= ls,\n z =3D h,\n u =3D t(u)\n = )\n }\n rownames(result) <- names(x)[hCols]\n return(result)\n= }" nil) (6646 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.or= g::*wpLEL%20Generic%20function%20definition" wpLEL\ Generic\ function\ defi= nition:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:re= sult-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:p= adline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLEL= .R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalan= ce*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "= no")) "##' Generic function to create \\code{wpLEL} object.\n##'\n##' The r= eturned object of class \\code{wpLEL} contains the following fields:\n##' \= \itemize{\n##' \\item{\\code{parametrization}} {parametrization used to c= reate this object. Possible values are \"default\" and \"Mahat2013\"}\n##' = \n##' \\item{\\code{dep}} {some info}\n##' \\item{\\code{z0}} {some inf= o}\n##' \\item{\\code{na}} {some info}\n##' \\item{\\code{zjoint}} {som= e info}\n##' \\item{\\code{h}} {some info}\n##' \\item{\\code{za}} {som= e info}\n##' \\item{\\code{z0sol}} {some info}\n##' \n##' \\item{\\code= {vk}} {some info}\n##' \\item{\\code{ua}} {some info}\n##' \\item{\\cod= e{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##' @pa= ram x object from which to calculat the \\code{wpLEL} object\n##' @param ..= . optional arguments for the generic functions\n##' @return objerct of clas= s \\code{wpLEL}\n##' @author Rainer M. Krug\n##' @export\nwpLEL <- function= (x, ...) UseMethod(\"wpLEL\")" nil) (6681 nil "file:~/Documents/Projects/En= ergyBalance/EnergyBalance.org::*parameterOK" parameterOK:1 ((:colname-names= ) (:rowname-names) (:result-params "replace") (:result-type . value) (:comm= ents . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . = "yes") (:tangle . "./package/EnergyBalance/R/parmeterOK.R") (:exports . "bo= th") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "neve= r") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Check par= ameter for validity\n##'\n##' Check parameter for validity. If they are val= id, the function\n##' returns \\code{TRUE}, if not, it returns the error me= ssages.\n##' @title parameterOK\n##' @param z z\n##' @param ua ua\n##' @par= am 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\nparame= terOK <- 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= <=3D z\n if (any( z < 0 )) {\n result <- c(result, z =3D \"All z= have to be larger or equal than zero!\\n\")\n }\n ## ua 0 <=3D u= a\n if (ua < 0 ) {\n result <- c(result, ua =3D \"ua has to be la= rger or equal than zero!\\n\")\n }\n ## dep 0 <=3D dep < h\n if= ((dep < 0) | (dep >=3D h) ) {\n result <- c(result, dep =3D \"dep h= as to be larger or equal than zero and smaller than h!\\n\")\n }\n ##= z0 0 < z0 <=3D h\n if ((z0 <=3D 0) | (z0 > h)) {\n resul= t <- c(result, z0 =3D \"z0 has to be larger than zero and smaller or equal = than h!\\n\")\n } \n ## na 0 < na\n if (na < 0 ) {\n res= ult <- c(result, na =3D \"na has to be larger or equal than zero!\\n\")\n = } \n ## zjoint\n if ((zjoint < 0) | (zjoint > h)) {\n result= <- c(result, zjoint =3D \"zjoint has to larger or equal than 0 and smaller= or equal than h!\\n\")\n }\n ## h h >=3D 0\n if (h < 0 ) {\n = result <- c(result, h =3D \"h has to be larger or equal than zero!\\= n\")\n }\n ## za za > h\n if (za <=3D h ) {\n result <- = c(result, za =3D \"za has to be larger than h!\\n\")\n }\n ## z0sol = 0 < z0sol POSSIBLY < h/10 ???\n if (z0sol <=3D 0 ) {\n result <- = c(result, z0sol =3D \"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 retur= n(result)\n}" nil) (6775 nil "file:~/Documents/Projects/EnergyBalance/Energ= yBalance.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 using= Log-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 profil= e\n##' @param z height above ground\n##' @param ua wind speed at highest po= int of z\n##' @param dep zero-plane displacement height. The argument can b= e 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 = =3D function(LAI, ...) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n##'\n##' wh= ere \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\cod= e{y} need to be added as an additional argument when calling\n##' \\code{wp= LELDefault}.\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 b= e 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##' nu= meric value or a function which is evaluated in the context of\n##' the fun= ction, i.e. can use all arguments to calculate\n##' \\code{z0}. The last ar= gument has to be \\code{...}. An example for\n##' the usage of a function w= ould be the parametrisation by Mahat\n##' 2013:\n##'\n##' z0 =3D function(L= AI, ...) {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 e= xponential decay coefficient\n##' @param check default \\code{TRUE}. If \\c= ode{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 zjoi= nt height at which the logarithmic changes to\n##' exponential (\"lower can= opy end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @param= z0sol roughness length at soil level (???????)\n##' @param noU if \\code{T= RUE}, do \\bold{not} calculate and return u\n##' @return Object of class \\= code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEED= ED!!!\nwpLELDefault <- function(\n z,\n ua,\n dep,\n z0,\n n= a, # =3D 7,\n zjoint,\n h, # =3D 28,\n za, # =3D 37,\n = z0sol,# =3D 0.001,\n noU =3D FALSE,\n check =3D TRUE\n ){ \n = vk <- 0.41\n \n ok <- ifelse(\n check,\n parameterOK(= \n z =3D z,\n ua =3D ua,\n dep = =3D dep,\n z0 =3D z0,\n na =3D na,\n = zjoint =3D zjoint,\n h =3D h,\n za =3D z= a,\n z0sol =3D z0sol\n ),\n TRUE\n )\n= \n if (!isTRUE(ok)) {\n stop(ok)\n }\n \n ## profil5.m l= 29 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::29]]\n = ## ustar =3D ua * vk / log( (za - dep) / z0) \n ustar <- ua * vk /= log( (za - dep) / z0)\n\n ## profil5.m l30 [[file:./package/EnergyBalan= cePaper/inst/matlab/org/profil5.m::30]]\n ## z0h =3D z0 * exp( -6.27 * v= k * ( ustar^(1/3) ) ); % Calcul de Z0h (Thom)\n z0h <- z0 * exp( -6.27= * vk * ( ustar^(1/3) ) )\n\n ## profil5.m l32 [[file:./package/EnergyBa= lancePaper/inst/matlab/org/profil5.m::32]]\n ## zjoin= t =3D z0h + dep;\n ## if (missing(zjoint)) {zjoint <- z0h + dep}\n\n = ## profil5.m l33 [[file:./package/EnergyBalancePaper/inst/matlab/org/profi= l5.m::33]]\n ## uzjoint =3D ustar / vk * log( (hauteur - dep)/z0 ) * ex= p( - 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 =3D uzjoint * vk / log( (zjoint/z0sol))\n ustarsol <- ifel= se(\n (zjoint =3D=3D 0),\n as.numeric(NA),\n uzjoint *= vk / log( zjoint / z0sol )\n )\n \n ##\n result <- list(\n= z =3D NA,\n u =3D NA,\n u.onlyTop =3D NA\n )\n= \n if (!noU) {\n result$z <- as.numeric(z)\n ##\n r= esult$u <- as.numeric(\n sapply(\n z,\n = function(z) {\n if (z >=3D 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 >=3D zjoint) {\n = ## profil5.m l40 [[file:./package/EnergyBalancePaper/inst/matlab/o= rg/profil5.m::41]]\n uh <- ( ustar/vk ) * log( (h-= dep) / z0 )\n u <- uh * exp( -na*(1-(z/h)) )\n = } else if (z >=3D 0) {\n ## pr= ofil5.m l42 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m::= 42]]\n u <- ( ustarsol/vk ) * log( (z ) / z0= sol )\n } else {\n u <-= NA\n }\n return(u)\n = }\n )\n )\n names(result$u) <- paste= 0(\"h\", z)\n ##\n result$u.onlyTop =3D 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.nu= meric(zjoint)\n result$h <- as.numeric(h)\n result$za = <- as.numeric(za)\n result$z0sol <- as.numeric(z0sol)\n \n res= ult$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$chec= k <- check\n ##\n class(result) <- c(\"wpLEL\")\n return(resul= t)\n}" nil) (6981 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalanc= e.org::*wpLELMahat" wpLEL\.mahat ((:colname-names) (:rowname-names) (:resul= t-params "replace") (:result-type . value) (:comments . "link") (:shebang .= "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./packa= ge/EnergyBalance/R/wpLELMahat.R") (:exports . "both") (:results . "replace"= ) (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:ta= ngle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Log= shape using Mahat parametrisation\n##'\n##' Creates Log-Exp-Log shaped win= d profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-Ex= p-Log wind profile based on Mahat parametrization\n##' @param z height abov= e ground\n##' @param ua wind speed at highest point of z\n##' @param na exp= onential decay coefficient\n##' @param zjoint height at which the logarithm= ic 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 a= nd 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 =3D 1} : {young pine}\n##' \\item{y =3D = 2} : {leafed decideous tree}\n##' \\item{y =3D 3} : {old pine with long s= tems and clumping at the top}\n##' }\n##' @param check default \\code{TRUE}= . If \\code{TRUE}, parameter will\n##' be cecked, if \\code{FALSE} not. MAi= nly for internal usage.\n##' @return Object of class \\code{wpLEL}.\n##' @a= uthor Rainer M. Krug\n##' @export\n##' @references NEEDED!!!\nwpLELMahat <-= function(\n z,\n ua,\n na,\n zjoint,\n h,\n za,\n z0s= ol,\n LAI,\n y,\n noU =3D FALSE,\n check =3D TRUE\n){ \n dep= FUN <- 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 =3D z,\n = ua =3D ua,\n dep =3D dep,\n z0 = =3D z0,\n na =3D na,\n zjoint =3D zjoint,\n = h =3D h,\n za =3D za,\n z0sol =3D z0s= ol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n = stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = =3D z,\n ua =3D ua,\n dep =3D dep,\n z0 =3D= z0,\n na =3D na,\n zjoint =3D zjoint,\n h = =3D h,\n za =3D za,\n z0sol =3D z0sol,\n noU = =3D noU,\n check =3D 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::*wpLEL= LE" wpLELLE ((:colname-names) (:rowname-names) (:result-params "replace") (= :result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") = (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wp= LELLE.R") (:exports . "both") (:results . "replace") (:session . "*R.Energy= Balance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hline= s . "no")) "##' Wind speed profile using Log-Exp shape\n##'\n##' Creates Lo= g-Exp shaped wind profile oblect \\code{wpLEL} based on\n##' input paramete= r. Uses \\code{wpLELDefault()} with \\code{zjoint=3D0}\n##' and \\code{z0so= l=3DNA}.\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 functio= n 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 parametrisa= tion by Mahat\n##' 2013:\n##'\n##' dep =3D 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 addition= al argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument = \\code{...} is needed at the end as all arguments in\n##' the function \\co= de{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 a= djust further analysis accordingly!\n##' @param z0 roughness length at cano= py level. The argument can be a\n##' numeric value or a function which is e= valuated 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 exa= mple for\n##' the usage of a function would be the parametrisation by Mahat= \n##' 2013:\n##'\n##' z0 =3D 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 w= hen calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} i= s needed at the end as all arguments in\n##' the function \\code{wpLELDefau= lt} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When usi= ng a function, it should be taken care to set the\n##' argument \\code{para= metrization} accordingly (in this\n##' example \"Mahat\") to adjust further= analysis accordingly!\n##' @param na exponential decay coefficient\n##' @p= aram h canopy height h\n##' @param za ???????\n##' @param noU if \\code{TRU= E}, do \\bold{not} calculate and return u\n##' @param ... further argumewnt= s which will be passed to the user\n##' defined function \\code{dep} and \\= code{z0}.\n##' @param check default \\code{TRUE}. If \\code{TRUE}, paramete= r 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 =3D FALSE,\n check = =3D TRUE\n ){\n zjoint <- 0\n z0sol <- 0.1\n ##\n ok <- ife= lse(\n check,\n parameterOK(\n z =3D z,\n = ua =3D ua,\n dep =3D dep,\n z0 =3D= z0,\n na =3D na,\n zjoint =3D zjoint,\n = h =3D h,\n za =3D za,\n z0sol =3D z0sol\= n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n = stop(ok)\n }\n ##\n result <- wpLELDefault(\n z =3D z= ,\n ua =3D ua,\n dep =3D dep,\n z0 =3D z0,\= n na =3D na,\n zjoint =3D zjoint,\n h =3D h,\= n za =3D za,\n z0sol =3D z0sol,\n noU =3D noU,= \n check =3D 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/w= pLELMahatLE.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##' @par= am ua wind speed at highest point of z\n##' @param na exponential decay coe= fficient\n##' @param h canopy height h\n##' @param za ???????\n##' @param z= 0sol roughness length at soil level (???????)\n##' @param LAI Leaf Area Ind= ex to be used for the calculation of \\code{dep}\n##' @param y integer indi= cating three basic forest profiles\n##' \\itemize{\n##' \\item{y =3D 1} := {young pine}\n##' \\item{y =3D 2} : {leafed decideous tree}\n##' \\ite= m{y =3D 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##' @pa= ram check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cec= ked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object o= f class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @refer= ences NEEDED!!!\nwpLELMahatLE <- function(\n z,\n ua,\n na,\n h= ,\n za,\n z0sol,\n LAI,\n y,\n noU =3D FALSE,\n check =3D= 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 =3D z,\n ua =3D ua,= \n dep =3D dep,\n z0 =3D z0,\n na = =3D na,\n zjoint =3D zjoint,\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol\n ),\n = TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##= \n result <- wpLELDefault(\n z =3D z,\n ua =3D ua= ,\n dep =3D dep,\n z0 =3D z0,\n na =3D na,\= n zjoint =3D zjoint,\n h =3D h,\n za =3D za,\= n z0sol =3D z0sol,\n noU =3D noU,\n check =3D FAL= SE\n )\n ##\n result$depFUN <- depFUN\n result$z0FUN <- z0FUN\n= result$LAI <- as.numeric(LAI)\n result$y <- as.numeric(y)\n res= ult$check <- check\n result$parametrization <- \"mahatLE\"\n ##\n = return(result)\n}" nil) (7307 nil "file:~/Documents/Projects/EnergyBalance/= EnergyBalance.org::*wpLELCastanea" wpLELCastanea ((:colname-names) (:rownam= e-names) (:result-params "replace") (:result-type . value) (:comments . "li= nk") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:t= angle . "./package/EnergyBalance/R/wpLELCastanea.R") (:exports . "both") (:= results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:m= kdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profi= le 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 win= d profile\n##' @param z height above ground\n##' @param ua wind speed at hi= ghest 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, defa= ult=3D1.1\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and ret= urn u\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter wi= ll\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @r= eturn Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @expo= rt\n##' @references NEEDED!!!\nwpLELCastanea <- function(\n z,\n ua,\= n zjoint,\n h,\n za,\n z0sol,\n LAI,\n WAI =3D 1.1,\n = noU =3D FALSE,\n check =3D 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) # Grani= er\n ##\n naFUN <- function(LAI, WAI) {\n na <- 2.6 * (LAI + W= AI)^0.36\n if (na > 4) {\n na <- 4\n }\n re= turn(na)\n }\n na <- naFUN(LAI, WAI)\n ##\n ok <- ifelse(\n = check,\n parameterOK(\n z =3D z,\n ua= =3D ua,\n dep =3D dep,\n z0 =3D z0,\n = na =3D na,\n zjoint =3D zjoint,\n h = =3D h,\n za =3D za,\n z0sol =3D z0sol\n = ),\n TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n = }\n ##\n result <- wpLELDefault(\n z =3D z,\n u= a =3D ua, \n dep =3D na,\n z0 =3D z0,\n n= a =3D na,\n zjoint =3D zjoint,\n h =3D h, \n = za =3D za,\n z0sol =3D z0sol, \n noU =3D noU,\n = check =3D FALSE\n )\n result$depFUN <- depFUN\n result$z0FU= N <- z0FUN\n result$naFUN <- naFUN\n result$LAI <- as.numeric(LAI)\n = result$WAI <- as.numeric(WAI)\n result$check <- check\n result$par= ametrization <- \"castanea\"\n return(result)\n}" nil) (7415 nil "file:~= /Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELOwnFree" wpLELOw= nFree ((:colname-names) (:rowname-names) (:result-params "replace") (:resul= t-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padl= ine . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELOwn= Free.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyB= alance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines= . "no")) "##' Wind speed profile usingLog-Exp_Log shape using ownFree para= metrisation\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code= {wpLEL} based on input parameter.\n##' dep, z0, na and zoint are parametriz= ed using:\n##'\n##' x =3D 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 wi= nd 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 heigh= t 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 s= ee 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 De= tails\n##' @param na.c see Details\n##' @param zjoint.a see Details\n##' @p= aram 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 n= oU 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 dec= ay coefficient\n##' @param zjoint height at which the logarithmic changes t= o\n##' exponential (\"lower canopy end\")\n##' @return Object of class \\co= de{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED= !!!\nwpLELOwnFree <- function(\n z,\n ua,\n\n h,\n za,\n z0s= ol,\n\n dep.a, dep.b, dep.c,\n z0.a, z0.b, z0.c,\n n= a.a, na.b, na.c,\n zjoint.a, zjoint.b, zjoint.c,\n\n LAI,\n = noU =3D FALSE,\n check =3D TRUE\n ){ \n depFUN <- function(LA= I, 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 <- fu= nction(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 <- dep= FUN(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, zjoin= t.b, zjoint.c)\n ##\n ok <- ifelse(\n check,\n paramete= rOK(\n z =3D z,\n ua =3D ua,\n de= p =3D dep,\n z0 =3D z0,\n na =3D na,\n = zjoint =3D zjoint,\n h =3D h,\n za = =3D za,\n z0sol =3D z0sol\n ),\n TRUE\n = )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <-= wpLELDefault(\n z =3D z,\n ua =3D ua,\n dep =3D de= p,\n z0 =3D z0,\n na =3D na,\n zjoint =3D zjoi= nt,\n h =3D h,\n za =3D za,\n z0sol =3D z0so= l,\n noU =3D noU,\n check =3D 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 <- zjoin= tFUN\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/Energy= Balance/EnergyBalance.org::*wpLEL.wpLEL" wpLEL\.wpLEL:1 ((:colname-names) (= :rowname-names) (:result-params "replace") (:result-type . value) (:comment= s . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "ye= s") (: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 n= ew \\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 profi= le\n##' @param x object of class \\code{wpLEL} to be used as source\n##' fo= r the parameter to create the \\code{wpLEL} object\n##' @param ... \\bold{n= amed} arguments which will be used to create the\n##' new \\code{wpLEL} obj= ect using the \\code{wpLELDefault} function.\n##' @return Object of class \= \code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\nwpLEL.wpLEL <- func= tion(\n x,\n ...\n){\n iff <- function(test, yes, no) {\n i= f (test) {\n yes\n } else {\n no\n }\n = }\n dot <- list(...)\n u <- switch(\n x$parametrization,\n = \"default\" =3D wpLELDefault( \n z =3D iff(exists(\"= z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua =3D iff= (exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n dep= =3D iff(exists(\"dep\", dot), dot[[\"dep\"]], x[[\"depOrg\"]]),\n= z0 =3D iff(exists(\"z0\", dot), dot[[\"z0\"]], x[[\= "z0Org\"]]),\n na =3D iff(exists(\"na\", dot), dot[[\"na= \"]], x[[\"na\"]]),\n zjoint =3D iff(exists(\"zjoint\", dot)= , dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n h =3D iff(exists(\= "h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za =3D if= f(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0= sol =3D iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n= noU =3D iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\= "noU\"]])\n ),\n \"mahat\" =3D wpLELMahat(\n z = =3D iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n = ua =3D iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"= ]]),\n na =3D iff(exists(\"na\", dot), dot[[\"na\"]], = x[[\"na\"]]),\n zjoint =3D iff(exists(\"zjoint\", dot), dot[[\= "zjoint\"]], x[[\"zjoint\"]]),\n h =3D iff(exists(\"h\", = dot), dot[[\"h\"]], x[[\"h\"]]),\n za =3D iff(exists= (\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol =3D= iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n = noU =3D iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]= ),\n LAI =3D iff(exists(\"LAI\", dot), dot[[\"LAI\"]], = x[[\"LAI\"]]),\n y =3D iff(exists(\"y\", dot), dot[[\"= y\"]], x[[\"y\"]])\n ),\n \"LE\" =3D wpLELLE(\n = z =3D iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"= ]]),\n ua =3D iff(exists(\"ua\", dot), dot[[\"ua\"]], = x[[\"ua\"]]),\n dep =3D iff(exists(\"dep\", dot), dot[[\= "dep\"]], x[[\"depOrg\"]]),\n z0 =3D iff(exists(\"z0\", = dot), dot[[\"z0\"]], x[[\"z0Org\"]]),\n na =3D iff(ex= ists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n h = =3D iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n = za =3D iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]])= ,\n noU =3D iff(exists(\"noU\", dot), dot[[\"noU\"]], x= [[\"noU\"]])\n ),\n \"mahatLE\" =3D wpLELMahatLE(\n = z =3D iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n= ua =3D iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\= "ua\"]]),\n na =3D iff(exists(\"na\", dot), dot[[\"na\"]= ], x[[\"na\"]]),\n h =3D iff(exists(\"h\", dot), d= ot[[\"h\"]], x[[\"h\"]]),\n za =3D iff(exists(\"za\", = dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol =3D iff(exist= s(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU = =3D iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n = LAI =3D iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"= ]]),\n y =3D iff(exists(\"y\", dot), dot[[\"y\"]], = x[[\"y\"]])\n ),\n \"castanea\" =3D wpLELCastanea(\n = z =3D iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]])= ,\n ua =3D iff(exists(\"ua\", dot), dot[[\"ua\"]], x= [[\"ua\"]]),\n zjoint =3D iff(exists(\"zjoint\", dot), dot[[\"zj= oint\"]], x[[\"zjoint\"]]),\n h =3D iff(exists(\"h\", = dot), dot[[\"h\"]], x[[\"h\"]]),\n za =3D iff(exists(\"= za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol =3D if= f(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n = LAI =3D iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\= n WAI =3D iff(exists(\"WAI\", dot), dot[[\"WAI\"]], x[[= \"WAI\"]])\n ),\n \"ownFree\" =3D wpLELOwnFree(\n = z =3D iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n= ua =3D iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\= "ua\"]]),\n h =3D iff(exists(\"h\", dot), dot[[\"h\"]]= , x[[\"h\"]]),\n za =3D iff(exists(\"za\", dot), do= t[[\"za\"]], x[[\"za\"]]),\n z0sol =3D iff(exists(\"z0sol\"= , dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n \n dep= .a =3D iff(exists(\"dep.a\", dot), dot[[\"dep.a\"]], x[[\"dep.a\"]]),\n = dep.b =3D iff(exists(\"dep.b\", dot), dot[[\"dep.b\"]], x[[\"= dep.b\"]]),\n dep.c =3D iff(exists(\"dep.c\", dot), dot[[\"dep= .c\"]], x[[\"dep.c\"]]),\n\n z0.a =3D iff(exists(\"z0.a\", = dot), dot[[\"z0.a\"]], x[[\"z0.a\"]]),\n z0.b =3D iff(exists(= \"z0.b\", dot), dot[[\"z0.b\"]], x[[\"z0.b\"]]),\n z0.c = =3D iff(exists(\"z0.c\", dot), dot[[\"z0.c\"]], x[[\"z0.c\"]]),\n\n = na.a =3D iff(exists(\"na.a\", dot), dot[[\"na.a\"]], x[[\"na= .a\"]]),\n na.b =3D iff(exists(\"na.b\", dot), dot[[\"na.b\"= ]], x[[\"na.b\"]]),\n na.c =3D iff(exists(\"na.c\", dot), = dot[[\"na.c\"]], x[[\"na.c\"]]),\n\n zjoint.a =3D iff(exists(= \"zjoint.a\", dot), dot[[\"zjoint.a\"]], x[[\"zjoint.a\"]]),\n z= joint.b =3D iff(exists(\"zjoint.b\", dot), dot[[\"zjoint.b\"]], x[[\"zjoin= t.b\"]]),\n zjoint.c =3D iff(exists(\"zjoint.c\", dot), dot[[\"= zjoint.c\"]], x[[\"zjoint.c\"]]),\n\n noU =3D iff(exists(\"no= U\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI =3D iff= (exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]])\n ),\n = stop(\"No valid parametrization\")\n )\n return(u)\n}" nil) (7= 668 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL.= wpLELFit" wpLEL\.wpLELFit:1 ((:colname-names) (:rowname-names) (:result-par= ams "replace") (:result-type . value) (:comments . "link") (:shebang . "") = (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/En= ergyBalance/R/wpLEL.wpLELFit.R") (:exports . "both") (:results . "replace")= (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tan= gle-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##' @pa= ram x object of class \\code{wpLELFit} to be used as source\n##' for the pa= rameter to ctreate the \\code{wpLEL} object\n##' @param ... additional argu= ments 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-nam= es) (:rowname-names) (:result-params "replace") (:result-type . value) (:co= mments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb = . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLEL.R") (:exports . "= both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "ne= ver") (: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 num= eric 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##' @para= m 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##' @par= am plotWPLines if \\code{TRUE}, the wind profile line is plotted\n##' @para= m add if \\code{TRUE}, the plot wil be added to an existing plot\n##' @para= m ... optional arguments for \\code{plot} method\n##' @return incisible NUL= L\n##' @author Rainer M. Krug\n##' @export\nplot.wpLEL <- function(\n x,= \n z,\n xlab =3D \"Wind Speed (m/s)\",\n ylab =3D \"Height above g= round (m)\",\n plotWPValues =3D TRUE,\n plotWPPoints =3D TRUE,\n p= lotWPLines =3D TRUE,\n add =3D FALSE,\n ...\n) {\n if (missing(z)= ) {z <- x$z}\n u <- wpLEL(x, z=3Dz)\n ## setup plot if !add\n if (= !add) {\n plot(\n x =3D c(0, max(x$u, u$u)),\n = y =3D c(0, max(x$z, u$z)),\n type=3D \"n\",\n xl= ab =3D xlab,\n ylab =3D ylab\n )\n }\n ## plot poin= ts\n points(\n x =3D x$u,\n y =3D x$z,\n type= =3D ifelse(plotWPPoints, \"p\", \"n\"),\n ...\n )\n lines(\n = x =3D u$u.onlyTop,\n y =3D u$z,\n type =3D ifelse(plotW= PLines, \"l\", \"n\"),\n lty =3D \"dotted\",\n col =3D \"blue= \"\n )\n lines(\n x =3D u$u,\n y =3D u$z,\n type= =3D ifelse(plotWPLines, \"l\", \"n\"),\n lty =3D \"solid\",\n = col =3D \"black\"\n )\n if (plotWPValues) {\n mx <- par(\"us= r\")[2]\n with(\n x,\n {\n arro= ws(\n x0 =3D c(0, 0, 0 ,0 ,0),\n y0 = =3D c(z0+dep, za, h, dep, zjoint),\n x1 =3D c(4, 4, 4 ,4= ,4 ,4),\n y1 =3D c(z0+dep, za, h, dep, zjoint),\n = length =3D 0,\n col =3D \"grey\",\n = lty =3D \"dotted\"\n )\n text(mx= , z0, paste('z0', round(z0, 2), sep=3D\" =3D \" ), pos =3D 2)\= n text(mx, za, paste('za', round(za, 2), sep=3D= \" =3D \" ), pos =3D 2)\n text(mx, h, paste('hauteur', = round(h, 2), sep=3D\" =3D \" ), pos =3D 2)\n text(mx, d= ep, paste('dep', round(dep, 2), sep=3D\" =3D \" ), pos =3D 2)\n = text(mx, zjoint, paste('zjoint', round(zjoint, 2), sep=3D\" = =3D \" ), pos =3D 2)\n }\n )\n }\n invisible(NULL)\= n}" nil) (7786 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.o= rg::*print.wpLEL" print\.wpLEL:1 ((:colname-names) (:rowname-names) (:resul= t-params "replace") (:result-type . value) (:comments . "link") (:shebang .= "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./packa= ge/EnergyBalance/R/print.wpLEL.R") (:exports . "both") (:results . "replace= ") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:t= angle-mode . 292) (:hlines . "no")) "##' Generic function to print \\code{w= pLEL}\n##'\n##' This function prints a \\code{wpLEL} object\n##' @param x o= bject of class \\code{wpLEL} to be printed\n##' @param ... optional argumen= ts 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 . "") (:cac= he . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyB= alance/R/fitOptim.wpLEL.default.single.R") (:exports . "both") (:results . = "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "y= es") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} t= o 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 fitOpti= m.wpLEL.default.single\n##' @param z height at which wind speeds are measur= ed\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{z= 0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=3D10= , z0=3D0.2, na=3D2, zjoint=3D0.5)}\n##' @param h constant value for \\code{= h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @p= aram za constant value for \\code{za} which will be passed to the\n##' func= tion \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0s= ol} 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{hess= ian}\n##' @return object of class \\code{wpLELFit}. The class contains the = followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of f= unction used for fitting}\n##' \\item{\\code{initial}} {initial values fo= r fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed o= n to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\cod= e{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at = height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, her= e the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted win= d 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 =3D c(dep=3D25, z0=3D0.8*28, na=3D9, zjoint=3D0.2*2),\n = h =3D 28,\n za =3D 37,\n z0sol =3D 0.001,\n ...\n ) {= \n ## Function to be minimised\n wpLELMin <- function(par, z, u, ua, = h, za, z0sol) {\n if (\n isTRUE(\n paramet= erOK(\n z =3D z,\n ua =3D ua= ,\n dep =3D par[1], # par$dep,\n z= 0 =3D par[2], # par$z0,\n na =3D par[3], # par$n= a,\n zjoint =3D par[4], # par$zjoint\n = h =3D h,\n za =3D za,\n z0= sol =3D z0sol\n )\n )\n ) {\n= p <- wpLELDefault(\n z =3D z,\n = ua =3D ua,\n dep =3D par[1], # par$dep,\n = z0 =3D par[2], # par$z0,\n na =3D par[3], # = par$na,\n zjoint =3D par[4], # par$zjoint\n h= =3D h,\n za =3D za,\n z0sol =3D z0= sol,\n check =3D FALSE\n )\n resul= t <- sum( ( (p$u - u)^2 ) / length(u) )\n } else {\n re= sult <- NA\n }\n return( result )\n } \n\n ua <- u[le= ngth(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.defau= lt.single\"\n result$initial <- initial\n result$dot <- list(...)\n = result$z <- z\n result$u <- u\n result$fit <- optim(\n par = =3D c(\n initial[\"dep\"],\n initial[\"z0\"],\n = initial[\"na\"],\n initial[\"zjoint\"]\n ),\n = fn =3D wpLELMin,\n z =3D z,\n u =3D u,\n = ua =3D ua,\n h =3D h,\n za =3D za,\n z0s= ol =3D z0sol,\n ...\n )\n result$wp <- wpLELDefault(\n = z =3D z,\n ua =3D ua,\n dep =3D result$fit$pa= r[\"dep\"],\n z0 =3D result$fit$par[\"z0\"],\n na =3D= result$fit$par[\"na\"],\n zjoint =3D result$fit$par[\"zjoint\"],\n = h =3D h,\n za =3D za,\n z0sol =3D z0sol\n = )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(r= esult)\n}" nil) (7942 nil "file:~/Documents/Projects/EnergyBalance/EnergyBa= lance.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.ma= hat.single.R") (:exports . "both") (:results . "replace") (:session . "*R.E= nergyBalance*") (: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.si= ngle\n##' @param z height at which wind speeds are measured\n##' @param u w= ind 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 wil= l be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol c= onstant 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=3D10, z0=3D0.2, na=3D2, zjoint=3D0.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 f= itting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\it= em{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation = function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed he= ights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\= n##' \\item{\\code{fit}} {result returned from fit, here the function \\c= ode{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class= \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.w= pLEL.mahat.single <- function(\n z,\n u,\n LAI,\n initial =3D c= (na=3D9, zjoint=3D0.2*2, y=3D3),\n h =3D 28,\n za =3D 37,\n = z0sol =3D 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 =3D z,\n u= a =3D ua,\n na =3D par[1], # na\n = zjoint =3D par[2], # zjoint\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n = LAI =3D LAI,\n y =3D par[3] # y\n= )\n result <- sum( ( (p$u - u)^2 ) / len= gth(u) )\n },\n silent =3D 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 =3D c(\n initial[\"na\= "],\n initial[\"zjoint\"],\n initial[\"y\"]\n = ),\n fn =3D wpLELMin,\n z =3D z,\n u =3D u,= \n ua =3D ua,\n h =3D h,\n za =3D za,\n = z0sol =3D z0sol,\n LAI =3D LAI,\n ...\n )\n result= $wp <- wpLELMahat(\n z =3D z,\n ua =3D ua,\n = na =3D result$fit$par[\"na\"],\n zjoint =3D result$fit$par[\"zjo= int\"],\n h =3D h,\n za =3D za,\n z0sol =3D = z0sol,\n LAI =3D LAI,\n y =3D result$fit$par[\"y\"]\n= )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(re= sult)\n}" nil) (8053 nil "file:~/Documents/Projects/EnergyBalance/EnergyBal= ance.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") (:no= web . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.LE.single= .R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalan= ce*") (: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}} t= o fit the input values (\\code{u} and \\code{z}) to a \\code{link{wpLEL}} w= ind profile.\n##' @title fitOptim.wpLEL.LE.single\n##' @param z height at w= hich 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{\\li= nk{optim}} function as\n##' \\code{par}). The parameter are in the order of= \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default valu= e is\n##' \\code{c(dep=3D10, z0=3D0.2, na=3D2, zjoint=3D0.5)}\n##' @param h= constant value for \\code{h} which will be passed to the\n##' function \\c= ode{wpLELDefault()}\n##' @param za constant value for \\code{za} which will= be passed to the\n##' function \\code{wpLELDefault()}\n##' @param ... furt= her arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{metho= d}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @ret= urn object of class \\code{wpLELFit}. The class contains the followig eleme= nts:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used f= or fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' = \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisat= ion function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observe= d 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 c= lass \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOpt= im.wpLEL.LE.single <- function(\n z,\n u,\n LAI,\n initial =3D = c(dep=3D25, z0=3D0.8*28, na=3D9),\n h =3D 28,\n za =3D 37,\= n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za) {\n re= sult <- NA\n try({\n p <- wpLELLE(\n = z =3D z,\n ua =3D ua,\n d= ep =3D par[1], # par$dep,\n z0 =3D par[2], # par$= z0,\n na =3D par[3], # par$na,\n = h =3D h,\n za =3D za\n )\n = result <- sum( ( (p$u - u)^2 ) / length(u) )\n },= \n silent =3D 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 =3D c(\n initial[\"dep\"],\n initial[\= "z0\"],\n initial[\"na\"]\n ),\n fn =3D wpLELM= in,\n z =3D z,\n u =3D u,\n ua =3D ua,\n= h =3D h,\n za =3D za,\n## z0sol =3D z0sol,\= n ...\n )\n result$wp <- wpLELLE(\n z =3D z,\n = ua =3D ua,\n dep =3D result$fit$par[\"dep\"],\n z0= =3D result$fit$par[\"z0\"],\n na =3D result$fit$par[\"na\"]= ,\n h =3D h,\n za =3D 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) (:rownam= e-names) (:result-params "replace") (:result-type . value) (:comments . "li= nk") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:t= angle . "./package/EnergyBalance/R/fitOptim.wpLEL.mahatLE.single.R") (:expo= rts . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eva= l . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' = Fitting of \\code{wpLEL.mahatLE} to a given wind profile using the\n##' \\c= ode{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to f= it the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL.m= ahatLE}} wind profile.\n##' @title fitOptim.wpLEL.mahatLE.single\n##' @para= m z height at which wind speeds are measured\n##' @param u wind speed at he= ights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param h constant valu= e for \\code{h} which will be passed to the\n##' function \\code{wpLELDefau= lt()}\n##' @param za constant value for \\code{za} which will be passed to = the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value f= or \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefa= ult()}\n##' @param initial Initial values for the parameters to be optimize= d\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=3D1= 0, z0=3D0.2, na=3D2, zjoint=3D0.5)}\n##' @param ... further arguments for \= \code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, u= pper}, \\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{opti= m}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}= \n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahatLE.si= ngle <- function(\n z,\n u,\n LAI,\n initial =3D c(na=3D9, y=3D= 3),\n h =3D 28,\n za =3D 37,\n z0sol =3D 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 =3D z,\n ua =3D ua,\n = na =3D par[1], # na\n h =3D h,\n = za =3D za,\n LAI =3D LAI,\n = y =3D par[2] # y\n )\n r= esult <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n si= lent =3D TRUE\n )\n return( result )\n }\n\n ua <- = u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.m= ahatLE.single\"\n result$initial <- initial\n result$dot <- list(...= )\n result$z <- z\n result$u <- u\n result$fit <- optim(\n = par =3D c(\n initial[\"na\"],\n initial[\"y\"]\n = ),\n fn =3D wpLELMin,\n z =3D z,\n u =3D= u,\n ua =3D ua,\n h =3D h,\n za =3D za,\n = z0sol =3D z0sol,\n LAI =3D LAI,\n ...\n )\n re= sult$wp <- wpLELMahatLE(\n z =3D z,\n ua =3D ua,\n = na =3D result$fit$par[\"na\"],\n h =3D h,\n za= =3D za,\n z0sol =3D z0sol,\n LAI =3D LAI,\n y= =3D result$fit$par[\"y\"]\n )\n\n class(result) <- c(class(resu= lt), \"wpLELFit\")\n return(result)\n}" nil) (8264 nil "file:~/Documents= /Projects/EnergyBalance/EnergyBalance.org::*fitOptim.castanea.single" fitOp= tim\.wpLEL\.castanea\.single ((:colname-names) (:rowname-names) (:result-pa= rams "replace") (:result-type . value) (:comments . "link") (:shebang . "")= (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/E= nergyBalance/R/fitOptim.wpLEL.castanea.single.R") (:exports . "both") (:res= ults . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdi= rp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{w= pLEL} 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 ar= e measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Le= af Area Index\n##' @param initial Initial values for the parameters to be o= ptimized\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=3D10, z0=3D0.2, na=3D2, zjoint=3D0.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##' \\c= ode{hessian}\n##' @return object of class \\code{wpLELFit}. The class conta= ins the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {n= ame of function used for fitting}\n##' \\item{\\code{initial}} {initial v= alues for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} = passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\it= em{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind s= peed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from = fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fi= tted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Kru= g\n##' @export\nfitOptim.wpLEL.castanea.single <- function(\n z,\n u,= \n LAI,\n initial =3D c(zjoint=3D0.2*2),\n h =3D 28,\n za = =3D 37,\n z0sol =3D 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 =3D z,\n = ua =3D ua,\n zjoint =3D par[1], # pa= r$zjoint\n h =3D h,\n za =3D= za,\n z0sol =3D z0sol,\n LAI=3DLAI\= n )\n result <- sum( ( (p$u - u)^2 ) / le= ngth(u) )\n },\n silent =3D TRUE\n )\n = return( result )\n }\n\n ua <- u[length(u)]\n result <- list()= \n result$method <- \"fitOptim.wpLEL.castanea.single\"\n result$initi= al <- initial\n result$dot <- list(...)\n result$z <- z\n result$= u <- u\n result$fit <- optim(\n par =3D c(\n initial[\= "zjoint\"]\n ),\n fn =3D wpLELMin,\n z =3D z,\n= u =3D u,\n ua =3D ua,\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n LAI =3D LAI,\n ..= .\n )\n result$wp <- wpLELCastanea(\n z =3D z,\n u= a =3D ua,\n zjoint =3D result$fit$par[\"zjoint\"],\n h = =3D h,\n za =3D za,\n z0sol =3D z0sol,\n LAI = =3D LAI\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n = return(result)\n}" nil) (8370 nil "file:~/Documents/Projects/EnergyBalanc= e/EnergyBalance.org::*fitOptim.wpLEL.default.multiple" fitOptim\.wpLEL\.def= ault\.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 . "repla= ce") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (= :tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wi= nd 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 profil= es in the format as read from \\code{loadWS(wide=3DTRUE, ...)}\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##' aff= ects the verbosity.\n##' @param ... additional arguments to be passed on to= \\code{optim()}\n##' @return an oject of class \\code{wpFit} containing th= e result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOpti= m.wpLEL.default.multiple <- function(\n wso,\n initial =3D c(dep=3D25= , z0=3D0.8*28, na=3D9, zjoint=3D0.2*2),\n h =3D 28,\n za = =3D 37,\n z0sol =3D 0.001,\n silentError =3D 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 = =3D z,\n ua =3D u[length(u)],\n = ##\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n = ## \n dep =3D par[1],\n = z0 =3D par[2],\n na = =3D par[3],\n zjoint =3D par[4]\n = )\n },\n silent =3D = 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=3DTRUE )\n } else {\n = mse <- NA\n }\n return(mse)\n }\n \n ## = construct result list\n result <- list()\n result$method <- \"fitOpti= m.wpLEL.default.multiple\"\n result$initial <- initial\n result$dot <= - list(...)\n ## result$z <- z\n ## result$u <- u\n ## Do the opti= misation\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n= result$fit <- optim(\n par =3D initial,\n fn =3D minFUN,= \n ##\n z =3D z,\n h =3D h,\n za = =3D za,\n z0sol =3D z0sol,\n ##\n wsFit =3D wso,\n = ...\n )\n ## calculate sample wind profile\n if ( (lengt= h(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 <- wpLELDe= fault(\n z =3D z,\n ua =3D mean(wso[2,][[1]]),\n = dep =3D result$fit$par[\"dep\"],\n z0 =3D result$fit$par[= \"z0\"],\n na =3D result$fit$par[\"na\"],\n zjoint =3D re= sult$fit$par[\"zjoint\"],\n h =3D h,\n za =3D za,\n = z0sol =3D z0sol\n )\n ##\n \n class(result) <- c(class(= result), \"wpLELFit\")\n return(result)\n}" nil) (8502 nil "file:~/Docum= ents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahat.multip= le" fitOptim\.wpLEL\.mahat\.multiple ((:colname-names) (:rowname-names) (:r= esult-params "replace") (:result-type . value) (:comments . "link") (:sheba= ng . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./p= ackage/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 i= n \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} = and fit each single\n##' one using the function provided in \\code{FUN}. Re= sults are cached.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param w= so Wind speed profiles in the format as read from \\code{loadWS(wide=3DTRUE= , ...)}\n##' @param initial initial parameter values for fit \n##' @param h= height\n##' @param za za\n##' @param z0sol z0sol\n##' @param silentError s= ielence 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 <- fun= ction(\n wso,\n initial =3D c(na=3D9, zjoint=3D0.2*2, y=3D3),\n h = =3D 28,\n za =3D 37,\n z0sol =3D 0.001,\n silentError = =3D TRUE,\n ...\n ) {\n \n ## Function to be minimised\n min= FUN <- function(\n par,\n ## ## passed in par:\n ## n= a\n ## zjoint\n ## y\n ## ## passed in the other arg= uments:\n z,\n h, za, z0sol,\n ## the data to be fitte= d to\n wsFit\n ) {\n mse <- sapply(\n wsFit= ,\n function(u) {\n p <- NULL\n tr= y( {\n p <- wpLELMahat(\n = z =3D z,\n ua =3D u[length(u)],\n = na =3D par[1],\n zjoint= =3D par[2],\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n = LAI =3D u[[1]],\n y = =3D par[3]\n )\n },\n = silent =3D silentError\n )\n = if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)= ])^2 ) / length(p$u) ) \n } else {\n r= esult <- 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=3DTRUE= )\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 <- i= nitial\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 =3D initial,\= n fn =3D minFUN,\n ##\n z =3D z,\n h = =3D h,\n za =3D za,\n z0sol =3D z0sol,\n ##\n = wsFit =3D 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 =3D z,\n ua =3D mea= n(as.numeric(wso[2,])),\n na =3D result$fit$par[\"na\"],\n = zjoint =3D result$fit$par[\"zjoint\"],\n h =3D h,\n za= =3D za,\n z0sol =3D z0sol,\n LAI =3D mean(as.numeric= (wso[1,])),\n y =3D 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 ((:c= olname-names) (:rowname-names) (:result-params "replace") (:result-type . v= alue) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no"= ) (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.own= Free.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 t= he 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 w= ind 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=3DTRUE, ...)}\n##' @param initial initial par= ameter 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 z= 0sol\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 t= he result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOpt= im.wpLEL.ownFree.multiple <- function(\n wso,\n initial =3D unlist(\n= list(\n dep =3D c(a=3D0.5, b=3D0.02, c=3D-2),\n = z0 =3D c(a=3D0.23, b=3D0.25, c=3D10),\n na =3D c(= a=3D0.23, b=3D0.25, c=3D10),\n zjoint =3D c(a=3D0.23, b=3D0.25, = c=3D10)\n )\n ),\n h =3D 28,\n za =3D 37,\= n z0sol =3D 0.001,\n silentError =3D 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 fi= tted to\n wsFit\n ) {\n mse <- sapply(\n ws= Fit,\n function(u) {\n p <- NULL\n = try( {\n p <- wpLELOwnFree(\n = z =3D z,\n ua =3D u[length(u)],\n = ##\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n = ## .a .b .c\n = dep.a =3D par[ 1], dep.b =3D par[ 2], dep.c =3D par[ 3],\n = z0.a =3D par[ 4], z0.b =3D par[ 5], z0.= c =3D par[ 6],\n na.a =3D par[ 7], na.b = =3D par[ 8], na.c =3D par[ 9],\n zjoint.a = =3D par[10], zjoint.b =3D par[11], zjoint.c =3D par[12],\n = LAI =3D u[[1]]\n )\n = },\n silent =3D 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( resu= lt )\n }\n )\n ## maxMse <- quantile(mse, prob= s=3Dc(0, (1 - exclHighMseProp), 0.5, 1))\n ## mse <- mse[mse <=3D ma= xMse[2]]\n mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n= mse <- sum( ( mse^2 ) / length(mse), na.rm=3DTRUE )\n } = else {\n mse <- NA\n }\n ## print(mse)\n = return(mse)\n }\n \n ## construct result list\n result <- lis= t()\n result$method <- \"fitOptim.wpLEL.ownFree.multiple\"\n result$i= nitial <- initial\n result$dot <- list(...)\n result$wpLELParameter <= - list(\n h =3D h,\n za =3D za,\n z0sol =3D = 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 =3D initial,\n fn =3D mi= nFUN,\n ##\n z =3D z,\n h =3D h,\n za= =3D za,\n z0sol =3D z0sol,\n ##\n wsFit =3D 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(res= ult) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8772 n= il "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Goodness%20= of%20fit%20for%20wpLELFit" Goodness\ of\ fit\ for\ wpLELFit:1 ((:colname-na= mes) (:rowname-names) (:result-params "replace") (:result-type . value) (:c= omments . "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")) "##' Calc= ulate 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##' @p= aram wp wind profile as returned in the wide format of \\code{loadWS}\n##' = @param gofFun function returning the goodnes of fit.\n##' @param silentErro= r sielence error message during fitting. Fitting\n##' is done in a \\code{t= ry()} block so this is purely cosmetical and\n##' affects the verbosity.\n#= #' This function accepts the two argumentsa \\code{obs, exp}.\n##' These ca= n be assumed of being of the same length. An example is the =3Ddefault func= tion:\n##' \n##' \\code{ function(obs, exp){ sum( ( (exp - obs)^2 ) / leng= th(obs) ) } }\n##' \n##' @return vector of the goodnes of fit values, one p= er row in \\code{wp}\n##' @author Rainer M. Krug\n##' @export\ngof.wpLELFit= <- function(\n fit,\n wp,\n gofFun =3D function(obs, exp){ sum( (= (exp - obs)^2 ) / length(obs), na.rm=3DTRUE ) },\n silentError =3D 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 <- wpL= EL(\n fit$wp,\n z =3D o$z,\= n ua =3D wp[i, \"ua\"],\n LA= I =3D wp[i,\"lai\"]\n )\n gof <- = gofFun(\n obs =3D o$ws,\n exp= =3D e$u\n )\n gof\n = },\n silent =3D 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-typ= e . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline .= "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFit= .R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalan= ce*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "= no")) "##' Generic function to plot \\code{wpLELFit}\n##'\n##' This functio= n a \\code{wpLELFit} object by plotting the fitted line\n##' smoothly and a= dding the original points to the graph.\n##' @param x object of class \\cod= e{wpLELFit} to be plotted \n##' @param z numeric vector at which the line s= hould be calculated. If\n##' missing, \\code{x$z} will be used. the more po= ints, the smoother\n##' the line.\n##' @param plotWPValues if \\code{TRUE},= the values and value lines are\n##' drawn\n##' @param plotWPLines if \\cod= e{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 argume= nts for plotting the \\bold{original} points of the fit using the \\code{po= iunts} function\n##' are plotted\n##' @return NULL\n##' @author Rainer M. K= rug\n##' @export\nplot.wpLELFit <- function(\n x,\n z,\n plotWPVal= ues =3D TRUE,\n plotWPLines =3D TRUE,\n plotOrgPoints =3D TRUE,\n = add =3D FALSE,\n ...\n ) {\n xu <- x$wp\n ## plot values (dep,= ...)\n plot.wpLEL(\n xu,\n z,\n plotWPValues =3D p= lotWPValues,\n plotWPPoints =3D FALSE,\n plotWPLines =3D FAL= SE,\n add =3D add\n )\n ## plot fitted lines \n plot.wp= LEL(\n xu,\n z,\n plotWPValues =3D FALSE,\n plo= tWPPoints =3D FALSE,\n plotWPLines =3D plotWPLines,\n add = =3D TRUE\n )\n ## plot original points \n points(\n = x$u,\n x$z,\n type =3D ifelse(plotOrgPoints, \"p\", \"n\"),\n= ...\n )\n}" nil) (8890 nil "file:~/Documents/Projects/Energy= Balance/EnergyBalance.org::*print.wpLELFit" print\.wpLELFit:1 ((:colname-na= mes) (:rowname-names) (:result-params "replace") (:result-type . value) (:c= omments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb= . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLELFit.R") (:export= s . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval = . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Ge= neric 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 <- fun= ction(\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 . "") (:ca= che . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/Energy= Balance/R/wpFitEach.R") (:exports . "both") (:results . "replace") (:sessio= n . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode = . 292) (:hlines . "no")) "##' The function loads individual wind profiles u= sing 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 usin= g the function provided in \\code{FUN}. Results are cached.\n##' @title wpL= ELFitEach\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 suff= ix for cache\n##' @param FUN name of the function to be used for fitting. I= t 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 fo= r 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 highe= st sampled wind speed to one - see \\link{loadWS} for details\n##' @param W= AI Wood Area Index, argument \\code{WAI} of function\n##' \\code{loadWS()}.= Will be added to lai from raw data.\n##' @param selectWPFit a function ret= urning \\bold{a vector} where each\n##' element represents the indices of l= oaded 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.fr= ame} of the loaded wind\n##' profiles, as returned by the function\n##'\n##= ' code{\n##' wso <- loadWS(\n##' wide =3D TR= UE,\n##' onlyComplete =3D TRUE,\n##' minSpeedIncr= easeWide,\n##' maxWindSpeedWide,\n##' maxWindSpee= dOneWide,\n##' WAI =3D WAI\n##' )\n##' }\n##'\n##= ' Examples are:\n##'\n##' \\code{selectWPFit =3D function(wso){TRUE}}\n##'\= n##' which would select all elements in \\code{wso}.This is the default.\n#= #' \n##' \\code{selectWPFit =3D 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 =3D functi= on(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 o= f 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 in= dividual fit.\n##' @author Rainer M. Krug\n##' @export\nwpFitEach <- functi= on(\n new =3D FALSE,\n suffix =3D \"\",\n FUN =3D \"wpLEFitSingle\= ",\n cores =3D detectCores() - 1,\n minSpeedIncreaseWide =3D 0,\n = maxWindSpeedWide =3D 10,\n maxWindSpeedOneWide =3D FALSE,\n WAI =3D 0= ,\n selectWPFit =3D function(wso) { TRUE },\n ...\n ) {\n if (c= ores=3D=3D0) {\n cores <- 1\n }\n fn <- paste0(CACHE, \"/wpFit= Each.\", 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 <- loa= dWS(\n wide =3D TRUE,\n onlyComplete =3D = TRUE,\n minSpeedIncreaseWide,\n maxWindSpeedWide,= \n maxWindSpeedOneWide,\n WAI =3D WAI\n = )\n \n ## #################################\n = ## From now on, LAI (later u[[1]]) is LAI =3D LAI + WAI)\n ## ##= ###############################\n\n ## Get indices for fitting. Mu= st only be done once as the\n ## functions might contain random nu= mber 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 =3D minSpeedIncrea= seWide,\n maxWindSpeedWide =3D maxWindSpeedWide,\n = maxWindSpeedOneWide =3D maxWindSpeedOneWide,\n WAI =3D WAI\n= )\n md$selectWPFit <- list(\n fun =3D s= electWPFit,\n indices =3D indFit\n )\n m= d$dot <- list(...)\n saveRDS(md, paste0(fn, \".metadata.rds\"))\n = \n z <- dfFromLong(wso[1,])$z \n ws <- ws= o[,grep(\"^h[[:digit:]]\", names(wso))]\n ws <- cbind(ua=3Dwso$ua,= ws)\n ws <- cbind(lai=3Dwso$lai, ws)\n ws <- as.data.fra= me(t(ws))\n \n ##\n i <- 0\n no <- ceili= ng(ncol(ws) / cores)\n dat <- mclapply(\n ws[,indFit]= ,\n function(u) {\n f <- FUN(\n = z =3D z,\n u =3D u[-(1:2)],\n = LAI =3D 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)=3D=3Di){\n = cat(i, \"\\tof about\\t\", no, \"\\r\")\n }\n = return(f)\n },\n mc.cores =3D 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 retur= n(dat)\n}" nil) (9085 nil "file:~/Documents/Projects/EnergyBalance/EnergyBa= lance.org::*wpFitMultiple" wpFitMultiple ((:colname-names) (:rowname-names)= (:result-params "replace") (:result-type . value) (:comments . "link") (:s= hebang . "") (: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 indiv= idual wind profiles using the function\n##' \\code{loadWS} and fits each on= e using the function\n##' \\code{FUN}. The results are stored in \\code{./c= ache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each= single\n##' one using the function provided in \\code{FUN}. Results are ca= ched.\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 us= ed for fitting TODO\n##' @param cores number of cores to be used for analys= is - defaults to the number of cores mius one, but is at least 1.\n##' @par= am minSpeedIncreaseWide minimum wind speed difference - see \\link{loadWS} = for details\n##' @param maxWindSpeedWide maximum wind speed - see \\link{lo= adWS} for details\n##' @param maxWindSpeedOneWide standardise highest sampl= ed 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 fo= r 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 ta= kes\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 =3D TRUE,\n##' = onlyComplete =3D TRUE,\n##' minSpeedIncreaseWide,\n= ##' maxWindSpeedWide,\n##' maxWindSpeedOneWide,\n= ##' WAI =3D WAI\n##' )\n##' }\n##'\n##' An exapml= e is\n##'\n##' \\code{selectWPFit =3D function(wso){lapply(1:5, function(x)= {sample(1:nrow(wso), 100)})}}\n##' \n##' which would create a list of 5 ele= ments where each consists of 100\n##' randomly selected wind profiles \\bol= d{selected} for fitting or\n##'\n##' \\code{selectWPFit =3D function(wso){l= apply(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 sele= cted wind profiles \\bold{excluded} from fitting\n##'\n##' @param ... addit= ional 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##' contai= ns the result of an individual fit.\n##' @author Rainer M. Krug\n##' @expor= t\nwpFitMultiple <- function(\n new =3D FALSE,\n suffix =3D \"\",\n = FUN =3D \"fitOptim.wpLEL.ownFree.multiple\",\n cores =3D detectCores()= - 1,\n minSpeedIncreaseWide =3D 0,\n maxWindSpeedWide =3D 10,\n m= axWindSpeedOneWide =3D FALSE,\n minUstar =3D 0.25,\n WAI =3D 0,\n = selectWPFit =3D function(wso) { lapply(1:5, function(x){sample(1:nrow(wso),= 100)}) },\n ...\n ) {\n if (cores=3D=3D0) {\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 (fi= le.exists(fn)) {\n dat <- readRDS(fn)\n } else {\n\n ## = Load Wind Profiles\n wso <- loadWS(\n wide = =3D TRUE,\n onlyComplete =3D TRUE,\n minSpeedIncr= easeWide =3D minSpeedIncreaseWide,\n maxWindSpeedWide =3D maxW= indSpeedWide,\n maxWindSpeedOneWide =3D maxWindSpeedOneWide,\n= minUstar =3D minUstar,\n WAI =3D WAI\n = )\n \n ## #################################\n = ## From now on, LAI (later u[[1]]) is LAI =3D LAI + WAI)\n ## ##= ###############################\n\n ## Get indices for fitting. Mu= st only be done once as the\n ## functions might contain random nu= mber 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 =3D minSpeedIn= creaseWide,\n maxWindSpeedWide =3D maxWindSpeedWide,\n = maxWindSpeedOneWide =3D maxWindSpeedOneWide,\n minUstar = =3D minUstar,\n WAI =3D WAI\n )\n md$sel= ectWPFit <- list(\n fun =3D selectWPFit,\n indice= s =3D indFit\n )\n md$dot <- list(...)\n sav= eRDS(md, paste0(fn, \".metadata.rds\"))\n \n ## Format th= e data\n z <- dfFromLong(wso[1,])$z \n ws <- wso[,= grep(\"^h[[:digit:]]\", names(wso))]\n ws <- cbind(ua=3Dwso$ua, ws= )\n ws <- cbind(lai=3Dwso$lai, ws)\n ws <- as.data.frame(= t(ws))\n\n ## Do the fitting\n i <- 0\n no <- ce= iling(ncol(ws) / cores)\n dat <- mclapply(\n indFit,\= n function(s) {\n f <- FUN(\n = wso =3D ws[,s],\n ...\n )\n= i <<- i + 1\n if (round(i, -2)=3D=3Di){\= n cat(i, \"\\tof about\\t\", no, \"\\r\")\n = }\n return(f)\n },\n mc.c= ores =3D cores\n )\n class(dat) <- c(\"wpLELFitList\"= , class(dat))\n saveRDS(dat, fn)\n }\n if (!(\"wpLELFitLis= t\" %in% class(dat))) {\n class(dat) <- c(\"wpLELFitList\", class(da= t))\n }\n return(dat)\n}" nil) (9242 nil "file:~/Documents/Projects/E= nergyBalance/EnergyBalance.org::*plot.wpLELFitList" plot\.wpLELFitList:1 ((= :colname-names) (:rowname-names) (:result-params "replace") (:result-type .= value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "n= o") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFitLis= t.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBala= nce*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . = "no")) "##' Generic function to plot \\code{wpLELFitList}\n##'\n##' This fu= nction plots an \\code{wpLELFitList} object by plotting the\n##' lines of e= ach 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 d= efault \\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##' @autho= r Rainer M. Krug\n##' @export\nplot.wpLELFitList <- function(\n x,\n = y =3D NULL,\n ...\n ) {\n if (is.null(y)) {\n y <- 1:lengt= h(x)\n }\n plot(\n x[[1]],\n add =3D FALSE,\n ..= .\n )\n ##\n for (i in y[-1]) {\n plot(\n x[= [i]],\n add =3D TRUE,\n ...\n )\n }\n = invisible()\n}" nil) (9283 nil "file:~/Documents/Projects/EnergyBalance/E= nergyBalance.org::*print.wpLELFitList" print\.wpLELFitList:1 ((:colname-nam= es) (:rowname-names) (:result-params "replace") (:result-type . value) (:co= mments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb = . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLELFitList.R") (:exp= orts . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:ev= al . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##'= Generic function to print \\code{wpLELFitList}\n##'\n##' This function pri= nts a \\code{wpLELFitList} object\n##' @param x object of class \\code{wpLE= LFitList} 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 "fi= le:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*airRest%20Generic= %20function%20definition" airRest\ Generic\ function\ definition:1 ((:colna= me-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:~/Docu= ments/Projects/EnergyBalance/EnergyBalance.org::*airRest.wpLEL" airRest\.wp= LEL ((:colname-names) (:rowname-names) (:result-params "replace") (:result-= type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padlin= e . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/airRest.wp= LEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBa= lance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines = . "no")) "##' Generic function for \\code{airRest} to calculate aerial resi= stance\n##'\n##' Calculate aerial resistance based on \\code{wpLEL} object\= n##' @param x object of class \\code{wpLEL}\n##' @param zsource if \\code{N= ULL} (default), \\code{zsource =3D z0 + dep}, unless the numerical value\n#= #' @return object of class \\code{airRest}.\n##' This object contains the f= ollowing 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} : {aeria= l 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. Kru= g\n##' @export\nairRest.wpLEL <- function(\n x,\n zsource =3D NULL\n)= {\n ## resistance top log profile\n ## LEL - from za (very top) to d= ep (above canopy, log profile)\n ## LE - from za (very top) to dep (abo= ve 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 ca= nopy, exp profile)\n if (x$zjoint =3D=3D 0) {\n ## log-exp profil= e\n I3 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( ex= p( x$na * (1 - x$z0sol/x$h) ) - 1 )\n } else {\n ## log-exp-log p= rofile\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 =3D=3D 0) {\n ## log-exp profile\n I4 <- 0\n } else= {\n ## log-exp-log profile\n I4 <- 1 / (x$vk*x$ustarsol) * l= og( x$zjoint/x$z0sol )\n }\n ##\n\n ## resistance from z0sol to za= \n ras =3D I1 + I3 + I4\n\n\n ## resistance from h to zsource (into c= anopy, 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=3D=3D0) {\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$ust= arsol) ) * ( 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$d= ep)) ) * ( 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 a= r$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 "f= ile:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.arLEL" plot= \.arLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:r= esult-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:= padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot= .arLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.Energ= yBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlin= es . "no")) "plot.arLEL <- function(\n x,\n plotWPPoints =3D TRUE,\n = plotWPValues =3D TRUE,\n plotARValues =3D TRUE,\n ...\n) {\n pl= ot.wpLEL(\n x,\n plotWPPoints =3D plotWPPoints,\n plot= WPValues =3D plotWPValues,\n ...\n )\n if (plotARValues) {\n = mx <- par(\"usr\")[2]\n with(\n x,\n {\n= ## arrows(\n ## x0 =3D c(0, 0, 0 ,0 ,0 ,= 0),\n ## y0 =3D c(z0+dep, za, h, hsource, dep, zjoint),\= n ## x1 =3D c(4, 4, 4 ,4 ,4 ,4),\n ## = y1 =3D c(z0+dep, za, h, hsource, dep, zjoint),\n ## len= gth =3D 0,\n ## col =3D \"grey\",\n ## = lty =3D \"dotted\"\n ## )\n \n = \n text(mx*0.4, (za+h)/2., paste(\"R1=3D\", round(R= 1, 2) ) )\n text(mx*0.6= 5, (z0h+dep+h)/2., paste(\"R2z0h=3D\", round(R2z0h, 2), \"R2z0=3D\", round(= R2z0, 2) ) )\n text(mx*0.6, (z0+h)/2., paste(\"R= 3=3D\", round(R3, 2) ) )\n = text(mx*0.6, (2*z0+h)/3., paste(\"R4log=3D\", round(R4log, 2), \"R4= exp=3D\", round(R4exp, 2) ) )\n text(mx*0.5, 2, = paste(\"racz0h=3D\", round(racz0h, 2), \"racz0=3D\", round(racz0, 2) = ) )\n text(mx*0.5, 1, paste(\"raslog=3D\", r= ound(raslog, 2), \"rasexp=3D\", round(rasexp, 2) ) )\n }\n = )\n }\n invisible(NULL)\n}" nil) (9464 nil "file:~/Documents/Projec= ts/EnergyBalance/EnergyBalance.org::*evapoTrans%20Generic%20function%20defi= nition" evapoTrans\ Generic\ function\ definition:1 ((:colname-names) (:row= name-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") (:m= kdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans <- functi= on(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-typ= e . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline .= "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.de= fault.R") (:exports . "both") (:results . "replace") (:session . "*R.Energy= Balance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hline= s . "no")) "evapoTrans.default <- function(\n ras,\n rac,\n Ta = =3D 20,\n frach =3D 1,\n Rnhsol =3D 600,\n RH =3D 50, # delt= ae =3D 5,\n gsol =3D 0.001\n) {\n ## mb (Monteith, 1990)\n es = <- 6.1078 * exp( 17.269 * Ta/(Ta+ 237.3) ) # mb\n ea <- es * RH/10= 0\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.deg= reeC-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 <- f= rach * 3.6 *\n (deltah * Rnhsol) /\n (Landah * (deltah + = Psyh * (1 + 1/(gsol * ras) )))\n ETRhcsol <- frach * 3.6 *\n (Rau= h * Cph * deltae/ras) /\n (Landah * (deltah + Psyh * (1 + 1/(gso= l * 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 =3D ET= Rhrsol,\n etrHcsol =3D ETRhcsol,\n etrHsol =3D ETRhsol,\n = etpCh =3D ETPch\n )\n etp$input <- list(\n ras =3D = ras,\n rac =3D rac,\n Ta =3D Ta,\n frach =3D f= rach,\n Rnhsol =3D Rnhsol,\n RH =3D RH,\n gsol = =3D gsol\n )\n class(etp) <- c(\"evapoTrans\", \"list\")\n attr(et= p, \"method\") <- \"default\"\n return( etp )\n}" nil) (9530 nil "file:~= /Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.airRest" e= vapoTrans\.airRest:1 ((:colname-names) (:rowname-names) (:result-params "re= place") (:result-type . value) (:comments . "link") (:shebang . "") (:cache= . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBal= ance/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 =3D 20,\n frach =3D 1,\n Rnhsol =3D 600,\n RH =3D 50= , # deltae =3D 5,\n gsol =3D 0.001\n) {\n etp <- evapoTrans.default= (\n ras =3D x$ras,\n rac =3D x$rac,\n Ta =3D= Ta,\n frach =3D frach,\n Rnhsol =3D Rnhsol,\n RH = =3D RH,\n gsol =3D gsol\n )\n etp$input$airRest <- x\n a= ttr(etp, \"method\") <- \"airRest\"\n return( etp )\n}" nil) (9559 nil "= file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.wpLE= L" evapoTrans\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "= replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cac= he . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyB= alance/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 =3D 20,\n frach =3D 1,\n Rnhsol =3D 600,\n RH =3D 50, = # deltae =3D 5,\n gsol =3D 0.001\n) {\n etp <- evapoTrans.airRest(\= n x =3D airRest(x),\n Ta =3D Ta,\n frach =3D= frach,\n Rnhsol =3D Rnhsol,\n RH =3D RH,\n gsol = =3D 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-param= s "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:= cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/Ener= gyBalance/R/lhc.etp.R") (:exports . "both") (:results . "replace") (:sessio= n . "*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##' C= reate latin hypercube based on the object \\code{x} of class\n##' \\code{wp= LEL} and calculates the aeril resistance.\n##'\n##' Create latin hypercube = based on the object \\code{x} of class\n##' \\code{wpLEL}. The object \\cod= e{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 La= tin Hypercube sample\n##' @param Min list of named named elements for minim= um 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 suff= ix suffix for file in cache\n##' @param new if \\code{TRUE} the cache is re= created, 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##' @retu= rn 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 =3D FALSE,\n cores =3D parallel::detectCores() - 1\n) = {\n if (missing(suffix)) {\n suffix <- paste0(\".\", paste(names(= Min), sep =3D \"\", collapse=3D\"-\"))\n } else {\n suffix <- pas= te0(\".\", paste(names(Min), sep =3D \"\", collapse=3D\"-\"), 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) !=3D = 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=3Dn, k=3Dlength(Min))\n colnames(dat) <- names(Mi= n)\n ## Transform the 0..1 values to the selected range\n dat= <- sweep(\n x =3D dat,\n MARGIN =3D 2,\n = Max-Min,\n '*'\n )\n dat <- sweep(\n x = =3D dat,\n MARGIN =3D 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 <- depz= 0 < h & depz0 > dat[,\"zjoint\"]\n ## dat <- dat[i,]\n ##= }\n\n dat <- as.data.frame(t(dat))\n ##\n wphelp <- f= unction(...) {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.airRes= t(\n x =3D ar,\n Ta = =3D s[[\"Ta\"]],\n frach =3D 1,\n = Rnhsol =3D s[[\"Rnhsol\"]],\n RH =3D s[[\"= RH\"]],\n gsol =3D 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$etrHr= sol <- etp$etrHrsol\n s$etrHcsol <- etp$etrHcsol\n = s$etrHsol <- etp$etrHsol\n s$etpCh <- = etp$etpCh\n class(s) =3D c(\"lhcAirRest\", class(s))\n = } else {\n s <- NULL\n }\n = i <<- i + 1\n if (round(i, -2) =3D=3D i) {\n = cat(i, \"\\t of about \\t\", no, \"\\t\\t\\r\")\n = }\n return(s)\n },\n mc.cores= =3D cores\n )\n cat(\"\\n\")\n result <- result[!sapp= ly(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 "r= eplace") (:result-type . value) (:comments . "link") (:shebang . "") (:cach= e . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./tests/wpLELTest.= R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalanc= e*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "n= o")) "## stopifnot(require(energyBalance))\n\n## Tolerance for numerical co= mparisons\nepsilon <- 1.0e-9\n\nua <- 3.136\nza <- 37\nz <- seq(\n from = =3D 0,\n to =3D za,\n by =3D 0.1\n)\n\n## Test 1\nu <- wpLEL(\n = z,\n ua =3D ua,\n dep =3D 14,\n z0 =3D 2.8,\n na =3D 7,\= n zjoint =3D 14.31625,\n h =3D 28,\n za =3D 37,\n z0sol =3D 0.0= 1\n)\nu.s <- readRDS(\"./tests/u.rds\")\nstopifnot( max(abs(unlist(u) - unl= ist(u.s)), na.rm=3DTRUE ) < epsilon)\n\nu <- airRest(u)\nu.s <- readRDS(\".= /tests/u.ar.rds\")\nstopifnot( max(abs(unlist(u) - unlist(u.s)), na.rm=3DTR= UE ) < epsilon)\n\n## Test 2\nWAI <- 0.5\nLAI <- 0\nu1 <- wpLEL(\n z,\n = ua =3D ua,\n dep =3D function(PAI) {1.1*h*log(1+(Cd*PAI)^0.25)},\n = PAI =3D WAI + LAI\n)\nu1.s <- readRDS(\"./tests/u1.rds\")\nstopifnot( max= (abs(unlist(u1) - unlist(u1.s)), na.rm=3DTRUE ) < epsilon)\n\nu1 <- airRest= (u1)\nu1.s <- readRDS(\"./tests/u1.ar.rds\")\nstopifnot( max(abs(unlist(u1)= - unlist(u1.s)), na.rm=3DTRUE ) < epsilon)\n\n## Test 3\nWAI <- 0.5\nLAI <= - 6\nu2 <- wpLEL(\n z,\n ua =3D ua,\n dep =3D function(PAI) {1.1*= h*log(1+(Cd*PAI)^0.25)},\n PAI =3D WAI + LAI\n)\nu2.s <- readRDS(\"./tes= ts/u2.rds\")\nstopifnot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=3DTRUE )= < epsilon)\n\nu2 <- airRest(u2)\nu2.s <- readRDS(\"./tests/u2.ar.rds\")\ns= topifnot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=3DTRUE ) < epsilon)" ni= l) (9828 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*P= ackage%20Documentation" Package\ Documentation:1 ((:colname-names) (:rownam= e-names) (:result-params "replace") (:result-type . value) (:comments . "li= nk") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:t= angle . "./package/EnergyBalancePaper/R/EnergyBalancePaper.R") (:exports . = "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "n= ever") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' EnergyB= alancePaper: Companion package for paper\n#'\n#' Companion package for the = paper \\bold{TO BE ADDED} This packagee\n#' contains thew data and the func= tions used to analyse the date and\n#' to create the plots in the paper. I= n addition it also contains\n#' further scripts for analysis and plots not = included in the paper.\n#' \n#' @section EnergyBalancePaper functions and d= ata:\n#' Data: To Be added ...\n#' Functions: To Be added ...\n#'\n#' @do= cType package\n#' @name EnergyBalancePaper\nNULL\n#> NULL" nil) ...)) mapc(#[(by-lang) "@.A.\306 =0B\"A\206.=00 .\307\306 .\"A\203#.\310\306 = .\"A!\206$. \311P!.=0D\312.=0E\313\314\n\"-\207" [by-lang lang specs org-ba= bel-tangle-lang-exts ext org-src-lang-modes assoc intern symbol-name "-mode= " nil mapc #[(spec) "\306\211.\307!.\310!\211.G\311V\205.=00\n).\312!. \3= 13\230\203%.\314\315 !\2027. \316\230\203/.\317\2027. G\311V\2057. \211.\20= 5P.=0E,\203O. \313\230\203O.=0D\320.,Q\202P.=0D\211.-\2054.\321!\322.-!..\= 211./\203w.=0E.\203w.=0E/\316\230\204w.\323..\324\"\210*\325.-!\203\217.=0E= -\326\327.0\"\235\204\217.\330.-!\210\331\332!.1r.1q\210\333\216\334.2!\203= \247.\317\335\336\217\210=0B\203\277.=0E-.3\235\204\277.=0B\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.=07=0B\203.=01\f\204.=01\350.=0E7T.7.-\fB.8\351.8.0\352\353$\20= 3+.=0E0\2023.=0E8.0B\211.0)..\207" [get-spec tangle sheb she-bang tangle-mo= de 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 m= apcar car delete-file generate-new-buffer " *temp*" ((byte-code "\301!\203= \n.\302!\210\301\207" [temp-buffer buffer-name kill-buffer] 2)) fboundp (f= uncall 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-buffe= r] 2)) insert-file-contents assoc :padline 4 write-region 493 cl-member :te= st #[(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/Proj= ects/EnergyBalance/EnergyBalance.org::*CACHE" CACHE:1 ((:colname-names) (:r= owname-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.pa= th( \".\", \"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) (:comment= s . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "ye= s") (:tangle . "./package/EnergyBalance/R/EnergyBalance.R") (:exports . "bo= th") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "neve= r") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' EnergyBala= nce: A package for computating wind profiles and\n#' aerodynamic resistance= s.\n#'\n#' The EnergyBalance package provides functiuons to\n#' fit wind pr= ofiles, calculate the aerial resistance and plot the profiles.\n#' \n#' @se= ction EnergyBalance functions:\n#' To Be added ...\n#'\n#' @docType packag= e\n#' @name EnergyBalance\n#' @importFrom parallel detectCores\n#' @importF= rom 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-ty= pe . 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 compu= tations. The cac=3Dhe holde =3Dtemporary\n#' as well as final results of th= e computations which are saved\n#' automatically to avoid re-computqtion. \= n#' \n#' @format Character vector of length one.\n#' @name CACHE\n#' @docTy= pe data\nNULL" nil) (5986 nil "file:~/Documents/Projects/EnergyBalance/Ener= gyBalance.org::*SQLITEDB" SQLITEDB:1 ((:colname-names) (:rowname-names) (:r= esult-params "replace") (:result-type . value) (:comments . "link") (:sheba= ng . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./p= ackage/EnergyBalance/R/SQLITEDB.R") (:exports . "both") (:results . "replac= e") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:= tangle-mode . 292) (:hlines . "no")) "#' SQLite Database with processed inp= ut data\n#'\n#' File name and path to the sqlite database which holds the p= rocessed\n#' wind speeds and LAI and the indices to increase access speed.\= n#' \n#' @format Character vector of length one.\n#' @name SQLITEDB\n#' @do= cType data\nNULL" nil) (6000 nil "file:~/Documents/Projects/EnergyBalance/E= nergyBalance.org::*getplotlim" getplotlim:1 ((:colname-names) (:rowname-nam= es) (: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 =3D } and \\code{y= lim =3D }. \n##' @param lim if \\code{xlim} or \\code{ylim} return the xorr= esponding\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 Rai= ner M. Krug\n##' @export\ngetplotlim<-function(lim =3D c(\"xlim\", \"ylim\"= )) {\n usr <- par('usr')\n xr <- (usr[2] - usr[1]) / 27 # 27 =3D (100= + 2*4) / 4\n yr <- (usr[4] - usr[3]) / 27\n return(\n switch(= \n EXPR =3D paste(sort(lim), collapse=3D\"\"),\n xlim= =3D c(usr[1] + xr, usr[2] - xr),\n ylim =3D c(usr[3] + yr, usr[= 4] - yr),\n xlimylim =3D list(\n xlim =3D c(usr[1= ] + xr, usr[2] - xr),\n ylim =3D c(usr[3] + yr, usr[4] - yr)= \n ),\n stop(\"Invalid value for lim!\")\n = ) \n )\n}" nil) (6032 nil "file:~/Documents/Projects/Ene= rgyBalance/EnergyBalance.org::*Input%20data%20directory%20discovery%20funct= ions" Input\ data\ directory\ discovery\ functions:1 ((:colname-names) (:ro= wname-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{EnergyBalance= Paper} 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=3Dd and LAI data\n##' @author Rainer M. Krug\n##' @export\ninputDat= aDir <- function() {\n file.path(\n ifelse(\n \"packag= e:EnergyBalancePaper\" %in% search(),\n system.file(package =3D = \"EnergyBalancePaper\"),\n getwd()\n ),\n \"in= putdata\"\n )\n}" nil) (6120 nil "file:~/Documents/Projects/EnergyBa= lance/EnergyBalance.org::*importVentToDB" importVentToDB:1 ((:colname-names= ) (:rowname-names) (:result-params "replace") (:result-type . value) (:comm= ents . "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")) "##' Impor= t wind data\n##'\n##' Import data into sqlite db and fit =3Ddefault=3D to e= ach 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 =3D fn,\n stringsAsFactors =3D FAL= SE,\n header =3D TRUE\n )\n names(wsw) <- c(\n \"da= te\",\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 ws= w$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 =3D=3D i) { cat(i, \" \") }\n wp <- dfFromLong= (wsw[i,])\n if ( !any( is.na( c(wp$z, wp[,3]) ) ) ){\n wp= f <- fitOptim.wpLEL.default.single(\n z =3D wp$z,\n = u =3D wp[,3],\n ## lower =3D c(dep= =3D0, z0=3D0.001, na=3D0.01, zjoint=3D0),\n initial =3D c(d= ep=3D2, z0=3D2, na=3D2, zjoint=3D3)\n ## = upper =3D c(dep=3D27, z0=3Dh, na=3D20, zjoint=3Dh),\n = ## method =3D \"L-BFGS-B\"\n )\n = wsw$ua[i] <- wpf$wp[[\"ua\"]]\n wsw$dep[i] <- wpf$f= it$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 =3D wsw$date,\n time =3D wsw$time,\n julien =3D w= sw$julien,\n z =3D rep(\n c(3,11,17,23,29,37),\n = times =3D rep( nrow(wsw), 6 )\n ),\n ws =3D c= (\n wsw$h03,\n wsw$h11,\n wsw$h17,\n = wsw$h23,\n wsw$h29,\n wsw$h37\n ),\n= ua =3D wsw$ua,\n dep =3D wsw$dep,\n z0 =3D= wsw$z0,\n na =3D wsw$na,\n zjoint =3D wsw$zjoint,\n = h =3D wsw$h,\n za =3D wsw$za,\n ustar =3D wsw$us= tar\n )\n ##\n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITED= B)\n try({\n ## WindSpeed_w\n DBI::dbWriteTable(db= , \"WindSpeed_w\", wsw, overwrite=3DTRUE)\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, ti= me)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsw_date ON WindSp= eed_w (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wsw_time = ON WindSpeed_w (time )\")\n DBI::dbGetQuery(db, \"CREATE INDE= X wsw_julien ON WindSpeed_w (julien)\")\n ## WindSpeed_l\n = DBI::dbWriteTable(db, \"WindSpeed_l\", wsl, overwrite=3DTRUE)\n = DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wsl_dth ON WindSpeed_l (dat= e, 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::dbGet= Query(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) (:r= esult-params "replace") (:result-type . value) (:comments . "link") (:sheba= ng . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./p= ackage/EnergyBalance/R/importLAIToDB.R") (:exports . "both") (:results . "r= eplace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes= ") (:tangle-mode . 292) (:hlines . "no")) "##' Import LAI data\n##'\n##' Im= port LAI data into sqlite db\n##' @param fn file name of LAI data\n##' @ret= urn invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @export\nimport= LAIToDB <- function(fn) {\n lai <- read.csv(\n file =3D fn,\n = stringsAsFactors =3D FALSE,\n header =3D TRUE\n )\n names= (lai) <- c(\n \"doy\",\n \"lai\"\n )\n ##\n db <- DB= I::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try(\n {\n = DBI::dbWriteTable(db, \"LeafAreaIndex\", lai, overwrite=3DTRUE)\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 "f= ile:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*createWsLAI" cre= ateWsLAI:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:= result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (= :padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/cre= ateWsLAI.R") (:exports . "both") (:results . "replace") (:session . "*R.Ene= rgyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hl= ines . "no")) "##' Finalize sqlight databaes of input data\n##'\n##' Create= combined wind speed and LAI table and associated indices in sqlite databas= e.\n##' @return invisible \\code{NULL}\n##' @author Rainer M. Krug\n##' @ex= port\ncreateWsLAI <- function(\n ){\n sql_l <- paste(\n \"CREA= TE TABLE\",\n \" WindSpeedLAI_l\",\n \"AS SELECT\",\n = \" WindSpeed_l.*, LeafAreaIndex.lai AS lai\",\n \"FROM\", \n = \" WindSpeed_l\",\n \"LEFT OUTER JOIN\",\n \" LeafAreaInd= ex\",\n \"ON\",\n \" julien=3DDOY\"\n )\n sql_w <- past= e(\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=3DDOY\"\n )\= n db <- DBI::dbConnect(RSQLite::SQLite(), SQLITEDB)\n try({\n = ##\n DBI::dbGetQuery( conn =3D db, statement =3D \"DROP TABL= E IF EXISTS WindSpeedLAI_l\")\n DBI::dbGetQuery( conn =3D db, st= atement =3D sql_l)\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX w= slail_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 WindSpee= dLAI_l (date )\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslail_t= ime ON WindSpeedLAI_l (time )\")\n DBI::dbGetQuery(db, \"CREA= TE INDEX wslail_julien ON WindSpeedLAI_l (julien)\")\n DBI::dbGe= tQuery(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 W= indSpeedLAI_l (ustar)\")\n ##\n DBI::dbGetQuery( conn= =3D db, statement =3D \"DROP TABLE IF EXISTS WindSpeedLAI_w\")\n = DBI::dbGetQuery( conn =3D db, statement =3D sql_w)\n DBI::dbGe= tQuery(db, \"CREATE UNIQUE INDEX wslaiw_dth ON WindSpeedLAI_w (date, time)\= ")\n DBI::dbGetQuery(db, \"CREATE UNIQUE INDEX wslaiw_jth ON Win= dSpeedLAI_w (julien, time)\")\n DBI::dbGetQuery(db, \"CREATE IND= EX 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 (julie= n)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_lai ON Wind= SpeedLAI_w (lai)\")\n DBI::dbGetQuery(db, \"CREATE INDEX wslaiw_= ustar ON WindSpeedLAI_w (ustar)\")\n }\n )\n DBI::dbDisconnec= t(db)\n invisible(NULL)\n}" nil) (6421 nil "file:~/Documents/Projects/En= ergyBalance/EnergyBalance.org::*createCache" createCache:1 ((:colname-names= ) (:rowname-names) (:result-params "replace") (:result-type . value) (:comm= ents . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . = "yes") (:tangle . "./package/EnergyBalance/R/createCache.R") (:exports . "b= oth") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "nev= er") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Re-creat= e \\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##' @e= xport\n##' @param fnVent file name of Wind Profile csv file\n##' @param fnL= AI 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.cre= ate(CACHE, showWarnings =3D FALSE)\n unlink(SQLITEDB)\n importVentToD= B(fnVent, h)\n importLAIToDB(fnLAI)\n createWsLAI()\n invisible(NU= LL)\n}" nil) (6446 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalan= ce.org::*loadWS" loadWS:1 ((:colname-names) (:rowname-names) (:result-param= s "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:= cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/Ener= gyBalance/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, diff= erent datasets are\n##' loaded, but all contain wind speed at different hei= ghts 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 \\co= de{NULL}. If not \\code{NULL}, the following rules will be\n##' used to fil= ter the wind profiles:\n##' \n##' \\itemize{\n##' \n##' \\item{ differenc= es of wind speeds between each point and the\n##' adjacend lower sampling p= oints has to be larger then the value of\n##' \\code{minSpeedIncreaseWide}}= \n##'\n##' }\n##'\n##' \\bold{Only Applies To \\code{wide=3D=3DTRUE}}\n##' = \n##' @param maxWindSpeedWide numeric value or \\code{null}. If not\n##' \\= code{NULL}, wind profiles with wind speeds higher then\n##' \\code{maxWindS= peedWide} will be filtered out.\n##'\n##' \\bold{Only Applies To \\code{wid= e=3D=3DTRUE}}\n##' \n##' @param maxWindSpeedOneWide Logical - if \\code{TRU= E} the wind profiles will\n##' be standardised to wind speed at highest sam= pling 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=3D=3DTRUE}}\n##' \= n##' @param minUstar minimum ustar value to be included in analysis. The de= fault is 0.25. \\bold{REFERENCE NEEDED}\n##' \n##' @param WAI Wood Area Ind= ex - 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{wi= de} and\n##' \\code{onlyComplete}. The sql statement is evauated and the re= sult is\n##' returned.\n##'\n##' \\bold{Only Applies To \\code{wide=3D=3DTR= UE}}\n##' \n##' @return data.frame containing the data. If the \\code{wide= =3D=3DTRUE},\n##' the class is also set to \\code{wsw}, if \\code{wide=3D= =3DFALSE} to\n##' \\code{wsl}\n##' @author Rainer M. Krug\n##' @export\nloa= dWS <- function(\n wide =3D TRUE,\n onlyComplete =3D TRUE,\n minSp= eedIncreaseWide =3D 0,\n maxWindSpeedWide =3D 10,\n maxWindSpeedOneWi= de =3D FALSE,\n minUstar =3D 0.25,\n WAI =3D 0,\n sql\n ) {\n = if (wide) {\n tbln <- \"WindSpeedLAI_w\"\n } else {\n = tbln <- \"WindSpeedLAI_l\"\n }\n try({ \n db <- dbCon= nect(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=3DTRUE))\n = f <- paste(f, \"IS NOT NULL\", collapse =3D \" AND \")\= n sql <- paste( \"SELECT * FROM \", tbln, \"WHERE\", f= , \"AND ustar >=3D\", minUstar)\n }\n }\n = ws <- DBI::dbGetQuery(db, sql)\n } \n )\n dbDisco= nnect(db)\n ##\n if (length(grep(\"date|time\", names(ws))) >=3D 2) {= \n ws$date <- as.Date(ws$date, format =3D \"%d/%m/%y\")\n ws$= dateTime <- as.POSIXct(paste(ws$date, ws$time), format=3D\"%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=3D= TRUE, value=3DTRUE)\n )\n ]\n ##= \n }\n if (wide) {\n class(ws) <- c(class(ws), \"wsw\")\n = h <- rownames(dfFromLong(ws[2,]))\n if (!is.null(minSpeedIncrease= Wide)) {\n ws <- ws[\n ws[,h] %>%\n = as.matrix %>%\n t %>%\n = diff %>%\n dat= a.frame %>%\n sapply(\n = X =3D .,\n = FUN =3D . %>%\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 =3D .,\n = MARGIN =3D 1,\n FUN =3D max\n = ) %>%\n is_less_than(maxWindSpeedWide),\n= ]\n }\n ua <- dfFromLong(ws[1,]) %>% extra= ct(\"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" dfFromLo= ng:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result= -type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padli= ne . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/dfFromLon= g.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBala= nce*") (: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 c= olumn names\n##' @param x column names\n##' @return heights as encoded in t= he column names in the order as given\n##' @author Rainer M. Krug\n##' @exp= ort\ndfFromLong <- function(\n x\n ) {\n hCols <- grep(\n p= attern =3D \"^h[[:digit:]]\",\n x =3D names(x),\n value= =3D 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 =3D hCols,\n z = =3D h,\n u =3D u\n )\n } else { # is.matrix= (u) =3D=3D TRUE\n result <- data.frame(\n index =3D h= Cols,\n z =3D h,\n u =3D 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\ de= finition:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:= result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (= :padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpL= EL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBal= ance*") (: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 i= nfo}\n##' \\item{\\code{na}} {some info}\n##' \\item{\\code{zjoint}} {s= ome info}\n##' \\item{\\code{h}} {some info}\n##' \\item{\\code{za}} {s= ome info}\n##' \\item{\\code{z0sol}} {some info}\n##' \n##' \\item{\\co= de{vk}} {some info}\n##' \\item{\\code{ua}} {some info}\n##' \\item{\\c= ode{ustar}} {some info}\n##' \\item{\\code{z0h}} {some info}\n##' \\ite= m{\\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 cl= ass \\code{wpLEL}\n##' @author Rainer M. Krug\n##' @export\nwpLEL <- functi= on(x, ...) UseMethod(\"wpLEL\")" nil) (6681 nil "file:~/Documents/Projects/= EnergyBalance/EnergyBalance.org::*parameterOK" parameterOK:1 ((:colname-nam= es) (:rowname-names) (:result-params "replace") (:result-type . value) (:co= mments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb = . "yes") (:tangle . "./package/EnergyBalance/R/parmeterOK.R") (:exports . "= both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "ne= ver") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Check p= arameter for validity\n##'\n##' Check parameter for validity. If they are v= alid, 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##' @p= aram 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 \\co= de{TRUE} if parameter are OK, otherwise a named\n##' \\code{character} vect= or where the names are the parameter which\n##' are not OK and the values t= he error messages to be used\n##' @author Rainer M. Krug\n##' @export\npara= meterOK <- function(\n z,\n ua,\n dep,\n z0,\n na,\n zjoi= nt,\n h,\n za,\n z0sol\n ) {\n result <- NULL\n ## z = 0 <=3D z\n if (any( z < 0 )) {\n result <- c(result, z =3D \"All= z have to be larger or equal than zero!\\n\")\n }\n ## ua 0 <=3D= ua\n if (ua < 0 ) {\n result <- c(result, ua =3D \"ua has to be = larger or equal than zero!\\n\")\n }\n ## dep 0 <=3D dep < h\n = if ((dep < 0) | (dep >=3D h) ) {\n result <- c(result, dep =3D \"dep= has to be larger or equal than zero and smaller than h!\\n\")\n }\n = ## z0 0 < z0 <=3D h\n if ((z0 <=3D 0) | (z0 > h)) {\n res= ult <- c(result, z0 =3D \"z0 has to be larger than zero and smaller or equa= l than h!\\n\")\n } \n ## na 0 < na\n if (na < 0 ) {\n r= esult <- c(result, na =3D \"na has to be larger or equal than zero!\\n\")\n= } \n ## zjoint\n if ((zjoint < 0) | (zjoint > h)) {\n resu= lt <- c(result, zjoint =3D \"zjoint has to larger or equal than 0 and small= er or equal than h!\\n\")\n }\n ## h h >=3D 0\n if (h < 0 ) {\= n result <- c(result, h =3D \"h has to be larger or equal than zero!= \\n\")\n }\n ## za za > h\n if (za <=3D h ) {\n result <= - c(result, za =3D \"za has to be larger than h!\\n\")\n }\n ## z0sol= 0 < z0sol POSSIBLY < h/10 ???\n if (z0sol <=3D 0 ) {\n result <= - c(result, z0sol =3D \"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 ret= urn(result)\n}" nil) (6775 nil "file:~/Documents/Projects/EnergyBalance/Ene= rgyBalance.org::*wpLELDefault" wpLELDefault ((:colname-names) (:rowname-nam= es) (:result-params "replace") (:result-type . value) (:comments . "link") = (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle= . "./package/EnergyBalance/R/wpLELDefault.R") (:exports . "both") (:result= s . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp = . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profile usi= ngLog-Exp_Log shape\n##'\n##' Creates Log-Exp-Log shaped wind profile oblec= t \\code{wpLEL} based on input parameter.\n##' @title Log-Exp-Log wind prof= ile\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 o= f a function would be the parametrisation by Mahat\n##' 2013:\n##'\n##' dep= =3D function(LAI, ...) {h * (0.05 + (LAI^0.02)/2 + (y-1)/20) }\n##'\n##' w= here \\code{h} will be the argument \\code{h} and \\code{LAI} and\n##' \\co= de{y} need to be added as an additional argument when calling\n##' \\code{w= pLELDefault}.\n##'\n##' The argument \\code{...} is needed at the end as al= l arguments in\n##' the function \\code{wpLELDefault} are passed on tho thi= e 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##' n= umeric value or a function which is evaluated in the context of\n##' the fu= nction, i.e. can use all arguments to calculate\n##' \\code{z0}. The last a= rgument has to be \\code{...}. An example for\n##' the usage of a function = would be the parametrisation by Mahat\n##' 2013:\n##'\n##' z0 =3D 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 i= n\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 zjo= int height at which the logarithmic changes to\n##' exponential (\"lower ca= nopy end\")\n##' @param h canopy height h\n##' @param za ???????\n##' @para= m 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 NEE= DED!!!\nwpLELDefault <- function(\n z,\n ua,\n dep,\n z0,\n = na, # =3D 7,\n zjoint,\n h, # =3D 28,\n za, # =3D 37,\n = z0sol,# =3D 0.001,\n noU =3D FALSE,\n check =3D TRUE\n ){ \n = vk <- 0.41\n \n ok <- ifelse(\n check,\n parameterOK= (\n z =3D z,\n ua =3D ua,\n dep = =3D dep,\n z0 =3D z0,\n na =3D na,\n = zjoint =3D zjoint,\n h =3D h,\n za =3D = za,\n z0sol =3D 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 =3D ua * vk / log( (za - dep) / z0) \n ustar <- ua * vk = / log( (za - dep) / z0)\n\n ## profil5.m l30 [[file:./package/EnergyBala= ncePaper/inst/matlab/org/profil5.m::30]]\n ## z0h =3D z0 * exp( -6.27 * = vk * ( ustar^(1/3) ) ); % Calcul de Z0h (Thom)\n z0h <- z0 * exp( -6.2= 7 * vk * ( ustar^(1/3) ) )\n\n ## profil5.m l32 [[file:./package/EnergyB= alancePaper/inst/matlab/org/profil5.m::32]]\n ## zjoi= nt =3D z0h + dep;\n ## if (missing(zjoint)) {zjoint <- z0h + dep}\n\n = ## profil5.m l33 [[file:./package/EnergyBalancePaper/inst/matlab/org/prof= il5.m::33]]\n ## uzjoint =3D ustar / vk * log( (hauteur - dep)/z0 ) * e= xp( - 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 =3D uzjoint * vk / log( (zjoint/z0sol))\n ustarsol <- ife= lse(\n (zjoint =3D=3D 0),\n as.numeric(NA),\n uzjoint = * vk / log( zjoint / z0sol )\n )\n \n ##\n result <- list(\= n z =3D NA,\n u =3D NA,\n u.onlyTop =3D 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 >=3D h) {\n = ## profil5.m l36 [[file:./package/EnergyBalancePaper/inst/matlab/or= g/profil5.m::37]]\n u <- ( ustar/vk ) * log( (z-dep= ) / z0 )\n } else if (z >=3D 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 >=3D 0) {\n ## p= rofil5.m l42 [[file:./package/EnergyBalancePaper/inst/matlab/org/profil5.m:= :42]]\n u <- ( ustarsol/vk ) * log( (z ) / z= 0sol )\n } else {\n u <= - NA\n }\n return(u)\n = }\n )\n )\n names(result$u) <- past= e0(\"h\", z)\n ##\n result$u.onlyTop =3D 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.numeri= c(z0)\n result$na <- as.numeric(na)\n result$zjoint <- as.n= umeric(zjoint)\n result$h <- as.numeric(h)\n result$za = <- as.numeric(za)\n result$z0sol <- as.numeric(z0sol)\n \n re= sult$vk <- as.numeric(vk)\n result$ua <- as.numeric(ua)\n = result$ustar <- as.numeric(ustar)\n result$z0h <- as.numeri= c(z0h)\n result$uzjoint <- as.numeric(uzjoint)\n result$ustarsol <= - as.numeric(ustarsol)\n ##\n result$noU <- noU\n result$che= ck <- check\n ##\n class(result) <- c(\"wpLEL\")\n return(resu= lt)\n}" nil) (6981 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalan= ce.org::*wpLELMahat" wpLEL\.mahat ((:colname-names) (:rowname-names) (:resu= lt-params "replace") (:result-type . value) (:comments . "link") (:shebang = . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./pack= age/EnergyBalance/R/wpLELMahat.R") (:exports . "both") (:results . "replace= ") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:t= angle-mode . 292) (:hlines . "no")) "##' Wind speed profile usingLog-Exp_Lo= g shape using Mahat parametrisation\n##'\n##' Creates Log-Exp-Log shaped wi= nd profile oblect \\code{wpLEL} based on input parameter.\n##' @title Log-E= xp-Log wind profile based on Mahat parametrization\n##' @param z height abo= ve ground\n##' @param ua wind speed at highest point of z\n##' @param na ex= ponential decay coefficient\n##' @param zjoint height at which the logarith= mic 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 profile= s\n##' \\itemize{\n##' \\item{y =3D 1} : {young pine}\n##' \\item{y =3D= 2} : {leafed decideous tree}\n##' \\item{y =3D 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. MA= inly 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 z0= sol,\n LAI,\n y,\n noU =3D FALSE,\n check =3D TRUE\n){ \n de= pFUN <- 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 =3D z,\n= ua =3D ua,\n dep =3D dep,\n z0 = =3D z0,\n na =3D na,\n zjoint =3D zjoint,\n = h =3D h,\n za =3D za,\n z0sol =3D z0= sol\n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n = stop(ok)\n }\n ##\n result <- wpLELDefault(\n z = =3D z,\n ua =3D ua,\n dep =3D dep,\n z0 =3D= z0,\n na =3D na,\n zjoint =3D zjoint,\n h = =3D h,\n za =3D za,\n z0sol =3D z0sol,\n noU = =3D noU,\n check =3D 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::*wpLEL= LE" wpLELLE ((:colname-names) (:rowname-names) (:result-params "replace") (= :result-type . value) (:comments . "link") (:shebang . "") (:cache . "no") = (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wp= LELLE.R") (:exports . "both") (:results . "replace") (:session . "*R.Energy= Balance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hline= s . "no")) "##' Wind speed profile using Log-Exp shape\n##'\n##' Creates Lo= g-Exp shaped wind profile oblect \\code{wpLEL} based on\n##' input paramete= r. Uses \\code{wpLELDefault()} with \\code{zjoint=3D0}\n##' and \\code{z0so= l=3DNA}.\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 functio= n 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 parametrisa= tion by Mahat\n##' 2013:\n##'\n##' dep =3D 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 addition= al argument when calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument = \\code{...} is needed at the end as all arguments in\n##' the function \\co= de{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 a= djust further analysis accordingly!\n##' @param z0 roughness length at cano= py level. The argument can be a\n##' numeric value or a function which is e= valuated 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 exa= mple for\n##' the usage of a function would be the parametrisation by Mahat= \n##' 2013:\n##'\n##' z0 =3D 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 w= hen calling\n##' \\code{wpLELDefault}.\n##'\n##' The argument \\code{...} i= s needed at the end as all arguments in\n##' the function \\code{wpLELDefau= lt} are passed on tho thie function\n##' as \\code{...}.\n##'\n##' When usi= ng a function, it should be taken care to set the\n##' argument \\code{para= metrization} accordingly (in this\n##' example \"Mahat\") to adjust further= analysis accordingly!\n##' @param na exponential decay coefficient\n##' @p= aram h canopy height h\n##' @param za ???????\n##' @param noU if \\code{TRU= E}, do \\bold{not} calculate and return u\n##' @param ... further argumewnt= s which will be passed to the user\n##' defined function \\code{dep} and \\= code{z0}.\n##' @param check default \\code{TRUE}. If \\code{TRUE}, paramete= r 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 =3D FALSE,\n check = =3D TRUE\n ){\n zjoint <- 0\n z0sol <- 0.1\n ##\n ok <- ife= lse(\n check,\n parameterOK(\n z =3D z,\n = ua =3D ua,\n dep =3D dep,\n z0 =3D= z0,\n na =3D na,\n zjoint =3D zjoint,\n = h =3D h,\n za =3D za,\n z0sol =3D z0sol\= n ),\n TRUE\n )\n\n if (!isTRUE(ok)) {\n = stop(ok)\n }\n ##\n result <- wpLELDefault(\n z =3D z= ,\n ua =3D ua,\n dep =3D dep,\n z0 =3D z0,\= n na =3D na,\n zjoint =3D zjoint,\n h =3D h,\= n za =3D za,\n z0sol =3D z0sol,\n noU =3D noU,= \n check =3D 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/w= pLELMahatLE.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##' @par= am ua wind speed at highest point of z\n##' @param na exponential decay coe= fficient\n##' @param h canopy height h\n##' @param za ???????\n##' @param z= 0sol roughness length at soil level (???????)\n##' @param LAI Leaf Area Ind= ex to be used for the calculation of \\code{dep}\n##' @param y integer indi= cating three basic forest profiles\n##' \\itemize{\n##' \\item{y =3D 1} := {young pine}\n##' \\item{y =3D 2} : {leafed decideous tree}\n##' \\ite= m{y =3D 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##' @pa= ram check default \\code{TRUE}. If \\code{TRUE}, parameter will\n##' be cec= ked, if \\code{FALSE} not. MAinly for internal usage.\n##' @return Object o= f class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @refer= ences NEEDED!!!\nwpLELMahatLE <- function(\n z,\n ua,\n na,\n h= ,\n za,\n z0sol,\n LAI,\n y,\n noU =3D FALSE,\n check =3D= 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 =3D z,\n ua =3D ua,= \n dep =3D dep,\n z0 =3D z0,\n na = =3D na,\n zjoint =3D zjoint,\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol\n ),\n = TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##= \n result <- wpLELDefault(\n z =3D z,\n ua =3D ua= ,\n dep =3D dep,\n z0 =3D z0,\n na =3D na,\= n zjoint =3D zjoint,\n h =3D h,\n za =3D za,\= n z0sol =3D z0sol,\n noU =3D noU,\n check =3D FAL= SE\n )\n ##\n result$depFUN <- depFUN\n result$z0FUN <- z0FUN\n= result$LAI <- as.numeric(LAI)\n result$y <- as.numeric(y)\n res= ult$check <- check\n result$parametrization <- \"mahatLE\"\n ##\n = return(result)\n}" nil) (7307 nil "file:~/Documents/Projects/EnergyBalance/= EnergyBalance.org::*wpLELCastanea" wpLELCastanea ((:colname-names) (:rownam= e-names) (:result-params "replace") (:result-type . value) (:comments . "li= nk") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:t= angle . "./package/EnergyBalance/R/wpLELCastanea.R") (:exports . "both") (:= results . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:m= kdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Wind speed profi= le 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 win= d profile\n##' @param z height above ground\n##' @param ua wind speed at hi= ghest 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, defa= ult=3D1.1\n##' @param noU if \\code{TRUE}, do \\bold{not} calculate and ret= urn u\n##' @param check default \\code{TRUE}. If \\code{TRUE}, parameter wi= ll\n##' be cecked, if \\code{FALSE} not. MAinly for internal usage.\n##' @r= eturn Object of class \\code{wpLEL}.\n##' @author Rainer M. Krug\n##' @expo= rt\n##' @references NEEDED!!!\nwpLELCastanea <- function(\n z,\n ua,\= n zjoint,\n h,\n za,\n z0sol,\n LAI,\n WAI =3D 1.1,\n = noU =3D FALSE,\n check =3D 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) # Grani= er\n ##\n naFUN <- function(LAI, WAI) {\n na <- 2.6 * (LAI + W= AI)^0.36\n if (na > 4) {\n na <- 4\n }\n re= turn(na)\n }\n na <- naFUN(LAI, WAI)\n ##\n ok <- ifelse(\n = check,\n parameterOK(\n z =3D z,\n ua= =3D ua,\n dep =3D dep,\n z0 =3D z0,\n = na =3D na,\n zjoint =3D zjoint,\n h = =3D h,\n za =3D za,\n z0sol =3D z0sol\n = ),\n TRUE\n )\n if (!isTRUE(ok)) {\n stop(ok)\n = }\n ##\n result <- wpLELDefault(\n z =3D z,\n u= a =3D ua, \n dep =3D na,\n z0 =3D z0,\n n= a =3D na,\n zjoint =3D zjoint,\n h =3D h, \n = za =3D za,\n z0sol =3D z0sol, \n noU =3D noU,\n = check =3D FALSE\n )\n result$depFUN <- depFUN\n result$z0FU= N <- z0FUN\n result$naFUN <- naFUN\n result$LAI <- as.numeric(LAI)\n = result$WAI <- as.numeric(WAI)\n result$check <- check\n result$par= ametrization <- \"castanea\"\n return(result)\n}" nil) (7415 nil "file:~= /Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLELOwnFree" wpLELOw= nFree ((:colname-names) (:rowname-names) (:result-params "replace") (:resul= t-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padl= ine . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/wpLELOwn= Free.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyB= alance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines= . "no")) "##' Wind speed profile usingLog-Exp_Log shape using ownFree para= metrisation\n##'\n##' Creates Log-Exp-Log shaped wind profile oblect \\code= {wpLEL} based on input parameter.\n##' dep, z0, na and zoint are parametriz= ed using:\n##'\n##' x =3D 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 wi= nd 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 heigh= t 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 s= ee 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 De= tails\n##' @param na.c see Details\n##' @param zjoint.a see Details\n##' @p= aram 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 n= oU 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 dec= ay coefficient\n##' @param zjoint height at which the logarithmic changes t= o\n##' exponential (\"lower canopy end\")\n##' @return Object of class \\co= de{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\n##' @references NEEDED= !!!\nwpLELOwnFree <- function(\n z,\n ua,\n\n h,\n za,\n z0s= ol,\n\n dep.a, dep.b, dep.c,\n z0.a, z0.b, z0.c,\n n= a.a, na.b, na.c,\n zjoint.a, zjoint.b, zjoint.c,\n\n LAI,\n = noU =3D FALSE,\n check =3D TRUE\n ){ \n depFUN <- function(LA= I, 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 <- fu= nction(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 <- dep= FUN(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, zjoin= t.b, zjoint.c)\n ##\n ok <- ifelse(\n check,\n paramete= rOK(\n z =3D z,\n ua =3D ua,\n de= p =3D dep,\n z0 =3D z0,\n na =3D na,\n = zjoint =3D zjoint,\n h =3D h,\n za = =3D za,\n z0sol =3D z0sol\n ),\n TRUE\n = )\n if (!isTRUE(ok)) {\n stop(ok)\n }\n ##\n result <-= wpLELDefault(\n z =3D z,\n ua =3D ua,\n dep =3D de= p,\n z0 =3D z0,\n na =3D na,\n zjoint =3D zjoi= nt,\n h =3D h,\n za =3D za,\n z0sol =3D z0so= l,\n noU =3D noU,\n check =3D 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 <- zjoin= tFUN\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/Energy= Balance/EnergyBalance.org::*wpLEL.wpLEL" wpLEL\.wpLEL:1 ((:colname-names) (= :rowname-names) (:result-params "replace") (:result-type . value) (:comment= s . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "ye= s") (: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 n= ew \\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 profi= le\n##' @param x object of class \\code{wpLEL} to be used as source\n##' fo= r the parameter to create the \\code{wpLEL} object\n##' @param ... \\bold{n= amed} arguments which will be used to create the\n##' new \\code{wpLEL} obj= ect using the \\code{wpLELDefault} function.\n##' @return Object of class \= \code{wpLEL}.\n##' @author Rainer M. Krug\n##' @export\nwpLEL.wpLEL <- func= tion(\n x,\n ...\n){\n iff <- function(test, yes, no) {\n i= f (test) {\n yes\n } else {\n no\n }\n = }\n dot <- list(...)\n u <- switch(\n x$parametrization,\n = \"default\" =3D wpLELDefault( \n z =3D iff(exists(\"= z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n ua =3D iff= (exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"]]),\n dep= =3D iff(exists(\"dep\", dot), dot[[\"dep\"]], x[[\"depOrg\"]]),\n= z0 =3D iff(exists(\"z0\", dot), dot[[\"z0\"]], x[[\= "z0Org\"]]),\n na =3D iff(exists(\"na\", dot), dot[[\"na= \"]], x[[\"na\"]]),\n zjoint =3D iff(exists(\"zjoint\", dot)= , dot[[\"zjoint\"]], x[[\"zjoint\"]]),\n h =3D iff(exists(\= "h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n za =3D if= f(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0= sol =3D iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n= noU =3D iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\= "noU\"]])\n ),\n \"mahat\" =3D wpLELMahat(\n z = =3D iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n = ua =3D iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\"ua\"= ]]),\n na =3D iff(exists(\"na\", dot), dot[[\"na\"]], = x[[\"na\"]]),\n zjoint =3D iff(exists(\"zjoint\", dot), dot[[\= "zjoint\"]], x[[\"zjoint\"]]),\n h =3D iff(exists(\"h\", = dot), dot[[\"h\"]], x[[\"h\"]]),\n za =3D iff(exists= (\"za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol =3D= iff(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n = noU =3D iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]= ),\n LAI =3D iff(exists(\"LAI\", dot), dot[[\"LAI\"]], = x[[\"LAI\"]]),\n y =3D iff(exists(\"y\", dot), dot[[\"= y\"]], x[[\"y\"]])\n ),\n \"LE\" =3D wpLELLE(\n = z =3D iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"= ]]),\n ua =3D iff(exists(\"ua\", dot), dot[[\"ua\"]], = x[[\"ua\"]]),\n dep =3D iff(exists(\"dep\", dot), dot[[\= "dep\"]], x[[\"depOrg\"]]),\n z0 =3D iff(exists(\"z0\", = dot), dot[[\"z0\"]], x[[\"z0Org\"]]),\n na =3D iff(ex= ists(\"na\", dot), dot[[\"na\"]], x[[\"na\"]]),\n h = =3D iff(exists(\"h\", dot), dot[[\"h\"]], x[[\"h\"]]),\n = za =3D iff(exists(\"za\", dot), dot[[\"za\"]], x[[\"za\"]])= ,\n noU =3D iff(exists(\"noU\", dot), dot[[\"noU\"]], x= [[\"noU\"]])\n ),\n \"mahatLE\" =3D wpLELMahatLE(\n = z =3D iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n= ua =3D iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\= "ua\"]]),\n na =3D iff(exists(\"na\", dot), dot[[\"na\"]= ], x[[\"na\"]]),\n h =3D iff(exists(\"h\", dot), d= ot[[\"h\"]], x[[\"h\"]]),\n za =3D iff(exists(\"za\", = dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol =3D iff(exist= s(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n noU = =3D iff(exists(\"noU\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n = LAI =3D iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"= ]]),\n y =3D iff(exists(\"y\", dot), dot[[\"y\"]], = x[[\"y\"]])\n ),\n \"castanea\" =3D wpLELCastanea(\n = z =3D iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]])= ,\n ua =3D iff(exists(\"ua\", dot), dot[[\"ua\"]], x= [[\"ua\"]]),\n zjoint =3D iff(exists(\"zjoint\", dot), dot[[\"zj= oint\"]], x[[\"zjoint\"]]),\n h =3D iff(exists(\"h\", = dot), dot[[\"h\"]], x[[\"h\"]]),\n za =3D iff(exists(\"= za\", dot), dot[[\"za\"]], x[[\"za\"]]),\n z0sol =3D if= f(exists(\"z0sol\", dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n = LAI =3D iff(exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]]),\= n WAI =3D iff(exists(\"WAI\", dot), dot[[\"WAI\"]], x[[= \"WAI\"]])\n ),\n \"ownFree\" =3D wpLELOwnFree(\n = z =3D iff(exists(\"z\", dot), dot[[\"z\"]], x[[\"z\"]]),\n= ua =3D iff(exists(\"ua\", dot), dot[[\"ua\"]], x[[\= "ua\"]]),\n h =3D iff(exists(\"h\", dot), dot[[\"h\"]]= , x[[\"h\"]]),\n za =3D iff(exists(\"za\", dot), do= t[[\"za\"]], x[[\"za\"]]),\n z0sol =3D iff(exists(\"z0sol\"= , dot), dot[[\"z0sol\"]], x[[\"z0sol\"]]),\n \n dep= .a =3D iff(exists(\"dep.a\", dot), dot[[\"dep.a\"]], x[[\"dep.a\"]]),\n = dep.b =3D iff(exists(\"dep.b\", dot), dot[[\"dep.b\"]], x[[\"= dep.b\"]]),\n dep.c =3D iff(exists(\"dep.c\", dot), dot[[\"dep= .c\"]], x[[\"dep.c\"]]),\n\n z0.a =3D iff(exists(\"z0.a\", = dot), dot[[\"z0.a\"]], x[[\"z0.a\"]]),\n z0.b =3D iff(exists(= \"z0.b\", dot), dot[[\"z0.b\"]], x[[\"z0.b\"]]),\n z0.c = =3D iff(exists(\"z0.c\", dot), dot[[\"z0.c\"]], x[[\"z0.c\"]]),\n\n = na.a =3D iff(exists(\"na.a\", dot), dot[[\"na.a\"]], x[[\"na= .a\"]]),\n na.b =3D iff(exists(\"na.b\", dot), dot[[\"na.b\"= ]], x[[\"na.b\"]]),\n na.c =3D iff(exists(\"na.c\", dot), = dot[[\"na.c\"]], x[[\"na.c\"]]),\n\n zjoint.a =3D iff(exists(= \"zjoint.a\", dot), dot[[\"zjoint.a\"]], x[[\"zjoint.a\"]]),\n z= joint.b =3D iff(exists(\"zjoint.b\", dot), dot[[\"zjoint.b\"]], x[[\"zjoin= t.b\"]]),\n zjoint.c =3D iff(exists(\"zjoint.c\", dot), dot[[\"= zjoint.c\"]], x[[\"zjoint.c\"]]),\n\n noU =3D iff(exists(\"no= U\", dot), dot[[\"noU\"]], x[[\"noU\"]]),\n LAI =3D iff= (exists(\"LAI\", dot), dot[[\"LAI\"]], x[[\"LAI\"]])\n ),\n = stop(\"No valid parametrization\")\n )\n return(u)\n}" nil) (7= 668 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*wpLEL.= wpLELFit" wpLEL\.wpLELFit:1 ((:colname-names) (:rowname-names) (:result-par= ams "replace") (:result-type . value) (:comments . "link") (:shebang . "") = (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/En= ergyBalance/R/wpLEL.wpLELFit.R") (:exports . "both") (:results . "replace")= (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tan= gle-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##' @pa= ram x object of class \\code{wpLELFit} to be used as source\n##' for the pa= rameter to ctreate the \\code{wpLEL} object\n##' @param ... additional argu= ments 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-nam= es) (:rowname-names) (:result-params "replace") (:result-type . value) (:co= mments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb = . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLEL.R") (:exports . "= both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "ne= ver") (: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 num= eric 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##' @para= m 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##' @par= am plotWPLines if \\code{TRUE}, the wind profile line is plotted\n##' @para= m add if \\code{TRUE}, the plot wil be added to an existing plot\n##' @para= m ... optional arguments for \\code{plot} method\n##' @return incisible NUL= L\n##' @author Rainer M. Krug\n##' @export\nplot.wpLEL <- function(\n x,= \n z,\n xlab =3D \"Wind Speed (m/s)\",\n ylab =3D \"Height above g= round (m)\",\n plotWPValues =3D TRUE,\n plotWPPoints =3D TRUE,\n p= lotWPLines =3D TRUE,\n add =3D FALSE,\n ...\n) {\n if (missing(z)= ) {z <- x$z}\n u <- wpLEL(x, z=3Dz)\n ## setup plot if !add\n if (= !add) {\n plot(\n x =3D c(0, max(x$u, u$u)),\n = y =3D c(0, max(x$z, u$z)),\n type=3D \"n\",\n xl= ab =3D xlab,\n ylab =3D ylab\n )\n }\n ## plot poin= ts\n points(\n x =3D x$u,\n y =3D x$z,\n type= =3D ifelse(plotWPPoints, \"p\", \"n\"),\n ...\n )\n lines(\n = x =3D u$u.onlyTop,\n y =3D u$z,\n type =3D ifelse(plotW= PLines, \"l\", \"n\"),\n lty =3D \"dotted\",\n col =3D \"blue= \"\n )\n lines(\n x =3D u$u,\n y =3D u$z,\n type= =3D ifelse(plotWPLines, \"l\", \"n\"),\n lty =3D \"solid\",\n = col =3D \"black\"\n )\n if (plotWPValues) {\n mx <- par(\"us= r\")[2]\n with(\n x,\n {\n arro= ws(\n x0 =3D c(0, 0, 0 ,0 ,0),\n y0 = =3D c(z0+dep, za, h, dep, zjoint),\n x1 =3D c(4, 4, 4 ,4= ,4 ,4),\n y1 =3D c(z0+dep, za, h, dep, zjoint),\n = length =3D 0,\n col =3D \"grey\",\n = lty =3D \"dotted\"\n )\n text(mx= , z0, paste('z0', round(z0, 2), sep=3D\" =3D \" ), pos =3D 2)\= n text(mx, za, paste('za', round(za, 2), sep=3D= \" =3D \" ), pos =3D 2)\n text(mx, h, paste('hauteur', = round(h, 2), sep=3D\" =3D \" ), pos =3D 2)\n text(mx, d= ep, paste('dep', round(dep, 2), sep=3D\" =3D \" ), pos =3D 2)\n = text(mx, zjoint, paste('zjoint', round(zjoint, 2), sep=3D\" = =3D \" ), pos =3D 2)\n }\n )\n }\n invisible(NULL)\= n}" nil) (7786 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.o= rg::*print.wpLEL" print\.wpLEL:1 ((:colname-names) (:rowname-names) (:resul= t-params "replace") (:result-type . value) (:comments . "link") (:shebang .= "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./packa= ge/EnergyBalance/R/print.wpLEL.R") (:exports . "both") (:results . "replace= ") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:t= angle-mode . 292) (:hlines . "no")) "##' Generic function to print \\code{w= pLEL}\n##'\n##' This function prints a \\code{wpLEL} object\n##' @param x o= bject of class \\code{wpLEL} to be printed\n##' @param ... optional argumen= ts 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 . "") (:cac= he . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyB= alance/R/fitOptim.wpLEL.default.single.R") (:exports . "both") (:results . = "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "y= es") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{wpLEL} t= o 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 fitOpti= m.wpLEL.default.single\n##' @param z height at which wind speeds are measur= ed\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{z= 0}, \\code{na}, \\code{zjoint}. The default value is\n##' \\code{c(dep=3D10= , z0=3D0.2, na=3D2, zjoint=3D0.5)}\n##' @param h constant value for \\code{= h} which will be passed to the\n##' function \\code{wpLELDefault()}\n##' @p= aram za constant value for \\code{za} which will be passed to the\n##' func= tion \\code{wpLELDefault()}\n##' @param z0sol constant value for \\code{z0s= ol} 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{hess= ian}\n##' @return object of class \\code{wpLELFit}. The class contains the = followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {name of f= unction used for fitting}\n##' \\item{\\code{initial}} {initial values fo= r fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} passed o= n to optimisation function, here \\code{\\link{optim}}}\n##' \\item{\\cod= e{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind speed at = height \\code{z}}\n##' \\item{\\code{fit}} {result returned from fit, her= e the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted win= d 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 =3D c(dep=3D25, z0=3D0.8*28, na=3D9, zjoint=3D0.2*2),\n = h =3D 28,\n za =3D 37,\n z0sol =3D 0.001,\n ...\n ) {= \n ## Function to be minimised\n wpLELMin <- function(par, z, u, ua, = h, za, z0sol) {\n if (\n isTRUE(\n paramet= erOK(\n z =3D z,\n ua =3D ua= ,\n dep =3D par[1], # par$dep,\n z= 0 =3D par[2], # par$z0,\n na =3D par[3], # par$n= a,\n zjoint =3D par[4], # par$zjoint\n = h =3D h,\n za =3D za,\n z0= sol =3D z0sol\n )\n )\n ) {\n= p <- wpLELDefault(\n z =3D z,\n = ua =3D ua,\n dep =3D par[1], # par$dep,\n = z0 =3D par[2], # par$z0,\n na =3D par[3], # = par$na,\n zjoint =3D par[4], # par$zjoint\n h= =3D h,\n za =3D za,\n z0sol =3D z0= sol,\n check =3D FALSE\n )\n resul= t <- sum( ( (p$u - u)^2 ) / length(u) )\n } else {\n re= sult <- NA\n }\n return( result )\n } \n\n ua <- u[le= ngth(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.defau= lt.single\"\n result$initial <- initial\n result$dot <- list(...)\n = result$z <- z\n result$u <- u\n result$fit <- optim(\n par = =3D c(\n initial[\"dep\"],\n initial[\"z0\"],\n = initial[\"na\"],\n initial[\"zjoint\"]\n ),\n = fn =3D wpLELMin,\n z =3D z,\n u =3D u,\n = ua =3D ua,\n h =3D h,\n za =3D za,\n z0s= ol =3D z0sol,\n ...\n )\n result$wp <- wpLELDefault(\n = z =3D z,\n ua =3D ua,\n dep =3D result$fit$pa= r[\"dep\"],\n z0 =3D result$fit$par[\"z0\"],\n na =3D= result$fit$par[\"na\"],\n zjoint =3D result$fit$par[\"zjoint\"],\n = h =3D h,\n za =3D za,\n z0sol =3D z0sol\n = )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(r= esult)\n}" nil) (7942 nil "file:~/Documents/Projects/EnergyBalance/EnergyBa= lance.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.ma= hat.single.R") (:exports . "both") (:results . "replace") (:session . "*R.E= nergyBalance*") (: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.si= ngle\n##' @param z height at which wind speeds are measured\n##' @param u w= ind 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 wil= l be passed to the\n##' function \\code{wpLELDefault()}\n##' @param z0sol c= onstant 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=3D10, z0=3D0.2, na=3D2, zjoint=3D0.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 f= itting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' \\it= em{\\code{dot}} {arguments passed as \\code{...} passed on to optimisation = function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observed he= ights}\n##' \\item{\\code{u}} {observefd wind speed at height \\code{z}}\= n##' \\item{\\code{fit}} {result returned from fit, here the function \\c= ode{\\link{optim}}}\n##' \\item{\\code{wp}} {fitted wind profile of class= \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.w= pLEL.mahat.single <- function(\n z,\n u,\n LAI,\n initial =3D c= (na=3D9, zjoint=3D0.2*2, y=3D3),\n h =3D 28,\n za =3D 37,\n = z0sol =3D 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 =3D z,\n u= a =3D ua,\n na =3D par[1], # na\n = zjoint =3D par[2], # zjoint\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n = LAI =3D LAI,\n y =3D par[3] # y\n= )\n result <- sum( ( (p$u - u)^2 ) / len= gth(u) )\n },\n silent =3D 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 =3D c(\n initial[\"na\= "],\n initial[\"zjoint\"],\n initial[\"y\"]\n = ),\n fn =3D wpLELMin,\n z =3D z,\n u =3D u,= \n ua =3D ua,\n h =3D h,\n za =3D za,\n = z0sol =3D z0sol,\n LAI =3D LAI,\n ...\n )\n result= $wp <- wpLELMahat(\n z =3D z,\n ua =3D ua,\n = na =3D result$fit$par[\"na\"],\n zjoint =3D result$fit$par[\"zjo= int\"],\n h =3D h,\n za =3D za,\n z0sol =3D = z0sol,\n LAI =3D LAI,\n y =3D result$fit$par[\"y\"]\n= )\n\n class(result) <- c(class(result), \"wpLELFit\")\n return(re= sult)\n}" nil) (8053 nil "file:~/Documents/Projects/EnergyBalance/EnergyBal= ance.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") (:no= web . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.LE.single= .R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalan= ce*") (: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}} t= o fit the input values (\\code{u} and \\code{z}) to a \\code{link{wpLEL}} w= ind profile.\n##' @title fitOptim.wpLEL.LE.single\n##' @param z height at w= hich 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{\\li= nk{optim}} function as\n##' \\code{par}). The parameter are in the order of= \\code{dep},\n##' \\code{z0}, \\code{na}, \\code{zjoint}. The default valu= e is\n##' \\code{c(dep=3D10, z0=3D0.2, na=3D2, zjoint=3D0.5)}\n##' @param h= constant value for \\code{h} which will be passed to the\n##' function \\c= ode{wpLELDefault()}\n##' @param za constant value for \\code{za} which will= be passed to the\n##' function \\code{wpLELDefault()}\n##' @param ... furt= her arguments for \\code{optim}. These can be\n##' \\code{gr}, \\code{metho= d}, \\code{lower, upper}, \\code{control} or\n##' \\code{hessian}\n##' @ret= urn object of class \\code{wpLELFit}. The class contains the followig eleme= nts:\n##' \\itemize{\n##' \\item{\\code{method}} {name of function used f= or fitting}\n##' \\item{\\code{initial}} {initial values for fit}\n##' = \\item{\\code{dot}} {arguments passed as \\code{...} passed on to optimisat= ion function, here \\code{\\link{optim}}}\n##' \\item{\\code{z}} {observe= d 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 c= lass \\code{wpLEL}}\n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOpt= im.wpLEL.LE.single <- function(\n z,\n u,\n LAI,\n initial =3D = c(dep=3D25, z0=3D0.8*28, na=3D9),\n h =3D 28,\n za =3D 37,\= n ...\n) {\n wpLELMin <- function(par, z, u, ua, h, za) {\n re= sult <- NA\n try({\n p <- wpLELLE(\n = z =3D z,\n ua =3D ua,\n d= ep =3D par[1], # par$dep,\n z0 =3D par[2], # par$= z0,\n na =3D par[3], # par$na,\n = h =3D h,\n za =3D za\n )\n = result <- sum( ( (p$u - u)^2 ) / length(u) )\n },= \n silent =3D 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 =3D c(\n initial[\"dep\"],\n initial[\= "z0\"],\n initial[\"na\"]\n ),\n fn =3D wpLELM= in,\n z =3D z,\n u =3D u,\n ua =3D ua,\n= h =3D h,\n za =3D za,\n## z0sol =3D z0sol,\= n ...\n )\n result$wp <- wpLELLE(\n z =3D z,\n = ua =3D ua,\n dep =3D result$fit$par[\"dep\"],\n z0= =3D result$fit$par[\"z0\"],\n na =3D result$fit$par[\"na\"]= ,\n h =3D h,\n za =3D 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) (:rownam= e-names) (:result-params "replace") (:result-type . value) (:comments . "li= nk") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:t= angle . "./package/EnergyBalance/R/fitOptim.wpLEL.mahatLE.single.R") (:expo= rts . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eva= l . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' = Fitting of \\code{wpLEL.mahatLE} to a given wind profile using the\n##' \\c= ode{optim} function.\n##'\n##' The function used \\code{\\link{optim}} to f= it the input values\n##' (\\code{u} and \\code{z}) to a \\code{link{wpLEL.m= ahatLE}} wind profile.\n##' @title fitOptim.wpLEL.mahatLE.single\n##' @para= m z height at which wind speeds are measured\n##' @param u wind speed at he= ights \\code{z}\n##' @param LAI Leaf Area Index\n##' @param h constant valu= e for \\code{h} which will be passed to the\n##' function \\code{wpLELDefau= lt()}\n##' @param za constant value for \\code{za} which will be passed to = the\n##' function \\code{wpLELDefault()}\n##' @param z0sol constant value f= or \\code{z0sol} which will be passed\n##' to the function \\code{wpLELDefa= ult()}\n##' @param initial Initial values for the parameters to be optimize= d\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=3D1= 0, z0=3D0.2, na=3D2, zjoint=3D0.5)}\n##' @param ... further arguments for \= \code{optim}. These can be\n##' \\code{gr}, \\code{method}, \\code{lower, u= pper}, \\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{opti= m}}}\n##' \\item{\\code{wp}} {fitted wind profile of class \\code{wpLEL}}= \n##' }\n##' @author Rainer M. Krug\n##' @export\nfitOptim.wpLEL.mahatLE.si= ngle <- function(\n z,\n u,\n LAI,\n initial =3D c(na=3D9, y=3D= 3),\n h =3D 28,\n za =3D 37,\n z0sol =3D 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 =3D z,\n ua =3D ua,\n = na =3D par[1], # na\n h =3D h,\n = za =3D za,\n LAI =3D LAI,\n = y =3D par[2] # y\n )\n r= esult <- sum( ( (p$u - u)^2 ) / length(u) )\n },\n si= lent =3D TRUE\n )\n return( result )\n }\n\n ua <- = u[length(u)]\n result <- list()\n result$method <- \"fitOptim.wpLEL.m= ahatLE.single\"\n result$initial <- initial\n result$dot <- list(...= )\n result$z <- z\n result$u <- u\n result$fit <- optim(\n = par =3D c(\n initial[\"na\"],\n initial[\"y\"]\n = ),\n fn =3D wpLELMin,\n z =3D z,\n u =3D= u,\n ua =3D ua,\n h =3D h,\n za =3D za,\n = z0sol =3D z0sol,\n LAI =3D LAI,\n ...\n )\n re= sult$wp <- wpLELMahatLE(\n z =3D z,\n ua =3D ua,\n = na =3D result$fit$par[\"na\"],\n h =3D h,\n za= =3D za,\n z0sol =3D z0sol,\n LAI =3D LAI,\n y= =3D result$fit$par[\"y\"]\n )\n\n class(result) <- c(class(resu= lt), \"wpLELFit\")\n return(result)\n}" nil) (8264 nil "file:~/Documents= /Projects/EnergyBalance/EnergyBalance.org::*fitOptim.castanea.single" fitOp= tim\.wpLEL\.castanea\.single ((:colname-names) (:rowname-names) (:result-pa= rams "replace") (:result-type . value) (:comments . "link") (:shebang . "")= (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/E= nergyBalance/R/fitOptim.wpLEL.castanea.single.R") (:exports . "both") (:res= ults . "replace") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdi= rp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Fitting of \\code{w= pLEL} 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 ar= e measured\n##' @param u wind speed at heights \\code{z}\n##' @param LAI Le= af Area Index\n##' @param initial Initial values for the parameters to be o= ptimized\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=3D10, z0=3D0.2, na=3D2, zjoint=3D0.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##' \\c= ode{hessian}\n##' @return object of class \\code{wpLELFit}. The class conta= ins the followig elements:\n##' \\itemize{\n##' \\item{\\code{method}} {n= ame of function used for fitting}\n##' \\item{\\code{initial}} {initial v= alues for fit}\n##' \\item{\\code{dot}} {arguments passed as \\code{...} = passed on to optimisation function, here \\code{\\link{optim}}}\n##' \\it= em{\\code{z}} {observed heights}\n##' \\item{\\code{u}} {observefd wind s= peed at height \\code{z}}\n##' \\item{\\code{fit}} {result returned from = fit, here the function \\code{\\link{optim}}}\n##' \\item{\\code{wp}} {fi= tted wind profile of class \\code{wpLEL}}\n##' }\n##' @author Rainer M. Kru= g\n##' @export\nfitOptim.wpLEL.castanea.single <- function(\n z,\n u,= \n LAI,\n initial =3D c(zjoint=3D0.2*2),\n h =3D 28,\n za = =3D 37,\n z0sol =3D 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 =3D z,\n = ua =3D ua,\n zjoint =3D par[1], # pa= r$zjoint\n h =3D h,\n za =3D= za,\n z0sol =3D z0sol,\n LAI=3DLAI\= n )\n result <- sum( ( (p$u - u)^2 ) / le= ngth(u) )\n },\n silent =3D TRUE\n )\n = return( result )\n }\n\n ua <- u[length(u)]\n result <- list()= \n result$method <- \"fitOptim.wpLEL.castanea.single\"\n result$initi= al <- initial\n result$dot <- list(...)\n result$z <- z\n result$= u <- u\n result$fit <- optim(\n par =3D c(\n initial[\= "zjoint\"]\n ),\n fn =3D wpLELMin,\n z =3D z,\n= u =3D u,\n ua =3D ua,\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n LAI =3D LAI,\n ..= .\n )\n result$wp <- wpLELCastanea(\n z =3D z,\n u= a =3D ua,\n zjoint =3D result$fit$par[\"zjoint\"],\n h = =3D h,\n za =3D za,\n z0sol =3D z0sol,\n LAI = =3D LAI\n )\n\n class(result) <- c(class(result), \"wpLELFit\")\n = return(result)\n}" nil) (8370 nil "file:~/Documents/Projects/EnergyBalanc= e/EnergyBalance.org::*fitOptim.wpLEL.default.multiple" fitOptim\.wpLEL\.def= ault\.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 . "repla= ce") (:session . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (= :tangle-mode . 292) (:hlines . "no")) "##' The function loads individual wi= nd 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 profil= es in the format as read from \\code{loadWS(wide=3DTRUE, ...)}\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##' aff= ects the verbosity.\n##' @param ... additional arguments to be passed on to= \\code{optim()}\n##' @return an oject of class \\code{wpFit} containing th= e result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOpti= m.wpLEL.default.multiple <- function(\n wso,\n initial =3D c(dep=3D25= , z0=3D0.8*28, na=3D9, zjoint=3D0.2*2),\n h =3D 28,\n za = =3D 37,\n z0sol =3D 0.001,\n silentError =3D 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 = =3D z,\n ua =3D u[length(u)],\n = ##\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n = ## \n dep =3D par[1],\n = z0 =3D par[2],\n na = =3D par[3],\n zjoint =3D par[4]\n = )\n },\n silent =3D = 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=3DTRUE )\n } else {\n = mse <- NA\n }\n return(mse)\n }\n \n ## = construct result list\n result <- list()\n result$method <- \"fitOpti= m.wpLEL.default.multiple\"\n result$initial <- initial\n result$dot <= - list(...)\n ## result$z <- z\n ## result$u <- u\n ## Do the opti= misation\n z <- as.numeric(gsub(\"h\", \"\", row.names(wso)[-c(1:2)]))\n= result$fit <- optim(\n par =3D initial,\n fn =3D minFUN,= \n ##\n z =3D z,\n h =3D h,\n za = =3D za,\n z0sol =3D z0sol,\n ##\n wsFit =3D wso,\n = ...\n )\n ## calculate sample wind profile\n if ( (lengt= h(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 <- wpLELDe= fault(\n z =3D z,\n ua =3D mean(wso[2,][[1]]),\n = dep =3D result$fit$par[\"dep\"],\n z0 =3D result$fit$par[= \"z0\"],\n na =3D result$fit$par[\"na\"],\n zjoint =3D re= sult$fit$par[\"zjoint\"],\n h =3D h,\n za =3D za,\n = z0sol =3D z0sol\n )\n ##\n \n class(result) <- c(class(= result), \"wpLELFit\")\n return(result)\n}" nil) (8502 nil "file:~/Docum= ents/Projects/EnergyBalance/EnergyBalance.org::*fitOptim.wpLEL.mahat.multip= le" fitOptim\.wpLEL\.mahat\.multiple ((:colname-names) (:rowname-names) (:r= esult-params "replace") (:result-type . value) (:comments . "link") (:sheba= ng . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./p= ackage/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 i= n \\code{./cache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} = and fit each single\n##' one using the function provided in \\code{FUN}. Re= sults are cached.\n##' @title fitOptim.wpLEL.ownFree.multiple\n##' @param w= so Wind speed profiles in the format as read from \\code{loadWS(wide=3DTRUE= , ...)}\n##' @param initial initial parameter values for fit \n##' @param h= height\n##' @param za za\n##' @param z0sol z0sol\n##' @param silentError s= ielence 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 <- fun= ction(\n wso,\n initial =3D c(na=3D9, zjoint=3D0.2*2, y=3D3),\n h = =3D 28,\n za =3D 37,\n z0sol =3D 0.001,\n silentError = =3D TRUE,\n ...\n ) {\n \n ## Function to be minimised\n min= FUN <- function(\n par,\n ## ## passed in par:\n ## n= a\n ## zjoint\n ## y\n ## ## passed in the other arg= uments:\n z,\n h, za, z0sol,\n ## the data to be fitte= d to\n wsFit\n ) {\n mse <- sapply(\n wsFit= ,\n function(u) {\n p <- NULL\n tr= y( {\n p <- wpLELMahat(\n = z =3D z,\n ua =3D u[length(u)],\n = na =3D par[1],\n zjoint= =3D par[2],\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n = LAI =3D u[[1]],\n y = =3D par[3]\n )\n },\n = silent =3D silentError\n )\n = if (!is.null(p)) {\n result <- sum( ( (p$u - u[-(1:2)= ])^2 ) / length(p$u) ) \n } else {\n r= esult <- 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=3DTRUE= )\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 <- i= nitial\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 =3D initial,\= n fn =3D minFUN,\n ##\n z =3D z,\n h = =3D h,\n za =3D za,\n z0sol =3D z0sol,\n ##\n = wsFit =3D 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 =3D z,\n ua =3D mea= n(as.numeric(wso[2,])),\n na =3D result$fit$par[\"na\"],\n = zjoint =3D result$fit$par[\"zjoint\"],\n h =3D h,\n za= =3D za,\n z0sol =3D z0sol,\n LAI =3D mean(as.numeric= (wso[1,])),\n y =3D 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 ((:c= olname-names) (:rowname-names) (:result-params "replace") (:result-type . v= alue) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "no"= ) (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/fitOptim.wpLEL.own= Free.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 t= he 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 w= ind 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=3DTRUE, ...)}\n##' @param initial initial par= ameter 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 z= 0sol\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 t= he result of\n##' the fit.\n##' @author Rainer M. Krug\n##' @export\nfitOpt= im.wpLEL.ownFree.multiple <- function(\n wso,\n initial =3D unlist(\n= list(\n dep =3D c(a=3D0.5, b=3D0.02, c=3D-2),\n = z0 =3D c(a=3D0.23, b=3D0.25, c=3D10),\n na =3D c(= a=3D0.23, b=3D0.25, c=3D10),\n zjoint =3D c(a=3D0.23, b=3D0.25, = c=3D10)\n )\n ),\n h =3D 28,\n za =3D 37,\= n z0sol =3D 0.001,\n silentError =3D 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 fi= tted to\n wsFit\n ) {\n mse <- sapply(\n ws= Fit,\n function(u) {\n p <- NULL\n = try( {\n p <- wpLELOwnFree(\n = z =3D z,\n ua =3D u[length(u)],\n = ##\n h =3D h,\n = za =3D za,\n z0sol =3D z0sol,\n = ## .a .b .c\n = dep.a =3D par[ 1], dep.b =3D par[ 2], dep.c =3D par[ 3],\n = z0.a =3D par[ 4], z0.b =3D par[ 5], z0.= c =3D par[ 6],\n na.a =3D par[ 7], na.b = =3D par[ 8], na.c =3D par[ 9],\n zjoint.a = =3D par[10], zjoint.b =3D par[11], zjoint.c =3D par[12],\n = LAI =3D u[[1]]\n )\n = },\n silent =3D 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( resu= lt )\n }\n )\n ## maxMse <- quantile(mse, prob= s=3Dc(0, (1 - exclHighMseProp), 0.5, 1))\n ## mse <- mse[mse <=3D ma= xMse[2]]\n mse <- mse[!is.na(mse)]\n if (length(mse) > 0) {\n= mse <- sum( ( mse^2 ) / length(mse), na.rm=3DTRUE )\n } = else {\n mse <- NA\n }\n ## print(mse)\n = return(mse)\n }\n \n ## construct result list\n result <- lis= t()\n result$method <- \"fitOptim.wpLEL.ownFree.multiple\"\n result$i= nitial <- initial\n result$dot <- list(...)\n result$wpLELParameter <= - list(\n h =3D h,\n za =3D za,\n z0sol =3D = 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 =3D initial,\n fn =3D mi= nFUN,\n ##\n z =3D z,\n h =3D h,\n za= =3D za,\n z0sol =3D z0sol,\n ##\n wsFit =3D 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(res= ult) <- c(class(result), \"wpLELFit\")\n return(result)\n}" nil) (8772 n= il "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*Goodness%20= of%20fit%20for%20wpLELFit" Goodness\ of\ fit\ for\ wpLELFit:1 ((:colname-na= mes) (:rowname-names) (:result-params "replace") (:result-type . value) (:c= omments . "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")) "##' Calc= ulate 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##' @p= aram wp wind profile as returned in the wide format of \\code{loadWS}\n##' = @param gofFun function returning the goodnes of fit.\n##' @param silentErro= r sielence error message during fitting. Fitting\n##' is done in a \\code{t= ry()} block so this is purely cosmetical and\n##' affects the verbosity.\n#= #' This function accepts the two argumentsa \\code{obs, exp}.\n##' These ca= n be assumed of being of the same length. An example is the =3Ddefault func= tion:\n##' \n##' \\code{ function(obs, exp){ sum( ( (exp - obs)^2 ) / leng= th(obs) ) } }\n##' \n##' @return vector of the goodnes of fit values, one p= er row in \\code{wp}\n##' @author Rainer M. Krug\n##' @export\ngof.wpLELFit= <- function(\n fit,\n wp,\n gofFun =3D function(obs, exp){ sum( (= (exp - obs)^2 ) / length(obs), na.rm=3DTRUE ) },\n silentError =3D 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 <- wpL= EL(\n fit$wp,\n z =3D o$z,\= n ua =3D wp[i, \"ua\"],\n LA= I =3D wp[i,\"lai\"]\n )\n gof <- = gofFun(\n obs =3D o$ws,\n exp= =3D e$u\n )\n gof\n = },\n silent =3D 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-typ= e . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline .= "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFit= .R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalan= ce*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "= no")) "##' Generic function to plot \\code{wpLELFit}\n##'\n##' This functio= n a \\code{wpLELFit} object by plotting the fitted line\n##' smoothly and a= dding the original points to the graph.\n##' @param x object of class \\cod= e{wpLELFit} to be plotted \n##' @param z numeric vector at which the line s= hould be calculated. If\n##' missing, \\code{x$z} will be used. the more po= ints, the smoother\n##' the line.\n##' @param plotWPValues if \\code{TRUE},= the values and value lines are\n##' drawn\n##' @param plotWPLines if \\cod= e{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 argume= nts for plotting the \\bold{original} points of the fit using the \\code{po= iunts} function\n##' are plotted\n##' @return NULL\n##' @author Rainer M. K= rug\n##' @export\nplot.wpLELFit <- function(\n x,\n z,\n plotWPVal= ues =3D TRUE,\n plotWPLines =3D TRUE,\n plotOrgPoints =3D TRUE,\n = add =3D FALSE,\n ...\n ) {\n xu <- x$wp\n ## plot values (dep,= ...)\n plot.wpLEL(\n xu,\n z,\n plotWPValues =3D p= lotWPValues,\n plotWPPoints =3D FALSE,\n plotWPLines =3D FAL= SE,\n add =3D add\n )\n ## plot fitted lines \n plot.wp= LEL(\n xu,\n z,\n plotWPValues =3D FALSE,\n plo= tWPPoints =3D FALSE,\n plotWPLines =3D plotWPLines,\n add = =3D TRUE\n )\n ## plot original points \n points(\n = x$u,\n x$z,\n type =3D ifelse(plotOrgPoints, \"p\", \"n\"),\n= ...\n )\n}" nil) (8890 nil "file:~/Documents/Projects/Energy= Balance/EnergyBalance.org::*print.wpLELFit" print\.wpLELFit:1 ((:colname-na= mes) (:rowname-names) (:result-params "replace") (:result-type . value) (:c= omments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb= . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLELFit.R") (:export= s . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval = . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##' Ge= neric 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 <- fun= ction(\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 . "") (:ca= che . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/Energy= Balance/R/wpFitEach.R") (:exports . "both") (:results . "replace") (:sessio= n . "*R.EnergyBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode = . 292) (:hlines . "no")) "##' The function loads individual wind profiles u= sing 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 usin= g the function provided in \\code{FUN}. Results are cached.\n##' @title wpL= ELFitEach\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 suff= ix for cache\n##' @param FUN name of the function to be used for fitting. I= t 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 fo= r 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 highe= st sampled wind speed to one - see \\link{loadWS} for details\n##' @param W= AI Wood Area Index, argument \\code{WAI} of function\n##' \\code{loadWS()}.= Will be added to lai from raw data.\n##' @param selectWPFit a function ret= urning \\bold{a vector} where each\n##' element represents the indices of l= oaded 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.fr= ame} of the loaded wind\n##' profiles, as returned by the function\n##'\n##= ' code{\n##' wso <- loadWS(\n##' wide =3D TR= UE,\n##' onlyComplete =3D TRUE,\n##' minSpeedIncr= easeWide,\n##' maxWindSpeedWide,\n##' maxWindSpee= dOneWide,\n##' WAI =3D WAI\n##' )\n##' }\n##'\n##= ' Examples are:\n##'\n##' \\code{selectWPFit =3D function(wso){TRUE}}\n##'\= n##' which would select all elements in \\code{wso}.This is the default.\n#= #' \n##' \\code{selectWPFit =3D 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 =3D functi= on(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 o= f 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 in= dividual fit.\n##' @author Rainer M. Krug\n##' @export\nwpFitEach <- functi= on(\n new =3D FALSE,\n suffix =3D \"\",\n FUN =3D \"wpLEFitSingle\= ",\n cores =3D detectCores() - 1,\n minSpeedIncreaseWide =3D 0,\n = maxWindSpeedWide =3D 10,\n maxWindSpeedOneWide =3D FALSE,\n WAI =3D 0= ,\n selectWPFit =3D function(wso) { TRUE },\n ...\n ) {\n if (c= ores=3D=3D0) {\n cores <- 1\n }\n fn <- paste0(CACHE, \"/wpFit= Each.\", 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 <- loa= dWS(\n wide =3D TRUE,\n onlyComplete =3D = TRUE,\n minSpeedIncreaseWide,\n maxWindSpeedWide,= \n maxWindSpeedOneWide,\n WAI =3D WAI\n = )\n \n ## #################################\n = ## From now on, LAI (later u[[1]]) is LAI =3D LAI + WAI)\n ## ##= ###############################\n\n ## Get indices for fitting. Mu= st only be done once as the\n ## functions might contain random nu= mber 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 =3D minSpeedIncrea= seWide,\n maxWindSpeedWide =3D maxWindSpeedWide,\n = maxWindSpeedOneWide =3D maxWindSpeedOneWide,\n WAI =3D WAI\n= )\n md$selectWPFit <- list(\n fun =3D s= electWPFit,\n indices =3D indFit\n )\n m= d$dot <- list(...)\n saveRDS(md, paste0(fn, \".metadata.rds\"))\n = \n z <- dfFromLong(wso[1,])$z \n ws <- ws= o[,grep(\"^h[[:digit:]]\", names(wso))]\n ws <- cbind(ua=3Dwso$ua,= ws)\n ws <- cbind(lai=3Dwso$lai, ws)\n ws <- as.data.fra= me(t(ws))\n \n ##\n i <- 0\n no <- ceili= ng(ncol(ws) / cores)\n dat <- mclapply(\n ws[,indFit]= ,\n function(u) {\n f <- FUN(\n = z =3D z,\n u =3D u[-(1:2)],\n = LAI =3D 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)=3D=3Di){\n = cat(i, \"\\tof about\\t\", no, \"\\r\")\n }\n = return(f)\n },\n mc.cores =3D 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 retur= n(dat)\n}" nil) (9085 nil "file:~/Documents/Projects/EnergyBalance/EnergyBa= lance.org::*wpFitMultiple" wpFitMultiple ((:colname-names) (:rowname-names)= (:result-params "replace") (:result-type . value) (:comments . "link") (:s= hebang . "") (: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 indiv= idual wind profiles using the function\n##' \\code{loadWS} and fits each on= e using the function\n##' \\code{FUN}. The results are stored in \\code{./c= ache}.\n##'\n##' Load all wind profiles using \\code{loadWS()} and fit each= single\n##' one using the function provided in \\code{FUN}. Results are ca= ched.\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 us= ed for fitting TODO\n##' @param cores number of cores to be used for analys= is - defaults to the number of cores mius one, but is at least 1.\n##' @par= am minSpeedIncreaseWide minimum wind speed difference - see \\link{loadWS} = for details\n##' @param maxWindSpeedWide maximum wind speed - see \\link{lo= adWS} for details\n##' @param maxWindSpeedOneWide standardise highest sampl= ed 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 fo= r 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 ta= kes\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 =3D TRUE,\n##' = onlyComplete =3D TRUE,\n##' minSpeedIncreaseWide,\n= ##' maxWindSpeedWide,\n##' maxWindSpeedOneWide,\n= ##' WAI =3D WAI\n##' )\n##' }\n##'\n##' An exapml= e is\n##'\n##' \\code{selectWPFit =3D function(wso){lapply(1:5, function(x)= {sample(1:nrow(wso), 100)})}}\n##' \n##' which would create a list of 5 ele= ments where each consists of 100\n##' randomly selected wind profiles \\bol= d{selected} for fitting or\n##'\n##' \\code{selectWPFit =3D function(wso){l= apply(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 sele= cted wind profiles \\bold{excluded} from fitting\n##'\n##' @param ... addit= ional 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##' contai= ns the result of an individual fit.\n##' @author Rainer M. Krug\n##' @expor= t\nwpFitMultiple <- function(\n new =3D FALSE,\n suffix =3D \"\",\n = FUN =3D \"fitOptim.wpLEL.ownFree.multiple\",\n cores =3D detectCores()= - 1,\n minSpeedIncreaseWide =3D 0,\n maxWindSpeedWide =3D 10,\n m= axWindSpeedOneWide =3D FALSE,\n minUstar =3D 0.25,\n WAI =3D 0,\n = selectWPFit =3D function(wso) { lapply(1:5, function(x){sample(1:nrow(wso),= 100)}) },\n ...\n ) {\n if (cores=3D=3D0) {\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 (fi= le.exists(fn)) {\n dat <- readRDS(fn)\n } else {\n\n ## = Load Wind Profiles\n wso <- loadWS(\n wide = =3D TRUE,\n onlyComplete =3D TRUE,\n minSpeedIncr= easeWide =3D minSpeedIncreaseWide,\n maxWindSpeedWide =3D maxW= indSpeedWide,\n maxWindSpeedOneWide =3D maxWindSpeedOneWide,\n= minUstar =3D minUstar,\n WAI =3D WAI\n = )\n \n ## #################################\n = ## From now on, LAI (later u[[1]]) is LAI =3D LAI + WAI)\n ## ##= ###############################\n\n ## Get indices for fitting. Mu= st only be done once as the\n ## functions might contain random nu= mber 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 =3D minSpeedIn= creaseWide,\n maxWindSpeedWide =3D maxWindSpeedWide,\n = maxWindSpeedOneWide =3D maxWindSpeedOneWide,\n minUstar = =3D minUstar,\n WAI =3D WAI\n )\n md$sel= ectWPFit <- list(\n fun =3D selectWPFit,\n indice= s =3D indFit\n )\n md$dot <- list(...)\n sav= eRDS(md, paste0(fn, \".metadata.rds\"))\n \n ## Format th= e data\n z <- dfFromLong(wso[1,])$z \n ws <- wso[,= grep(\"^h[[:digit:]]\", names(wso))]\n ws <- cbind(ua=3Dwso$ua, ws= )\n ws <- cbind(lai=3Dwso$lai, ws)\n ws <- as.data.frame(= t(ws))\n\n ## Do the fitting\n i <- 0\n no <- ce= iling(ncol(ws) / cores)\n dat <- mclapply(\n indFit,\= n function(s) {\n f <- FUN(\n = wso =3D ws[,s],\n ...\n )\n= i <<- i + 1\n if (round(i, -2)=3D=3Di){\= n cat(i, \"\\tof about\\t\", no, \"\\r\")\n = }\n return(f)\n },\n mc.c= ores =3D cores\n )\n class(dat) <- c(\"wpLELFitList\"= , class(dat))\n saveRDS(dat, fn)\n }\n if (!(\"wpLELFitLis= t\" %in% class(dat))) {\n class(dat) <- c(\"wpLELFitList\", class(da= t))\n }\n return(dat)\n}" nil) (9242 nil "file:~/Documents/Projects/E= nergyBalance/EnergyBalance.org::*plot.wpLELFitList" plot\.wpLELFitList:1 ((= :colname-names) (:rowname-names) (:result-params "replace") (:result-type .= value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline . "n= o") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot.wpLELFitLis= t.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBala= nce*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . = "no")) "##' Generic function to plot \\code{wpLELFitList}\n##'\n##' This fu= nction plots an \\code{wpLELFitList} object by plotting the\n##' lines of e= ach 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 d= efault \\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##' @autho= r Rainer M. Krug\n##' @export\nplot.wpLELFitList <- function(\n x,\n = y =3D NULL,\n ...\n ) {\n if (is.null(y)) {\n y <- 1:lengt= h(x)\n }\n plot(\n x[[1]],\n add =3D FALSE,\n ..= .\n )\n ##\n for (i in y[-1]) {\n plot(\n x[= [i]],\n add =3D TRUE,\n ...\n )\n }\n = invisible()\n}" nil) (9283 nil "file:~/Documents/Projects/EnergyBalance/E= nergyBalance.org::*print.wpLELFitList" print\.wpLELFitList:1 ((:colname-nam= es) (:rowname-names) (:result-params "replace") (:result-type . value) (:co= mments . "link") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb = . "yes") (:tangle . "./package/EnergyBalance/R/print.wpLELFitList.R") (:exp= orts . "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:ev= al . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "##'= Generic function to print \\code{wpLELFitList}\n##'\n##' This function pri= nts a \\code{wpLELFitList} object\n##' @param x object of class \\code{wpLE= LFitList} 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 "fi= le:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*airRest%20Generic= %20function%20definition" airRest\ Generic\ function\ definition:1 ((:colna= me-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:~/Docu= ments/Projects/EnergyBalance/EnergyBalance.org::*airRest.wpLEL" airRest\.wp= LEL ((:colname-names) (:rowname-names) (:result-params "replace") (:result-= type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padlin= e . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/airRest.wp= LEL.R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBa= lance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines = . "no")) "##' Generic function for \\code{airRest} to calculate aerial resi= stance\n##'\n##' Calculate aerial resistance based on \\code{wpLEL} object\= n##' @param x object of class \\code{wpLEL}\n##' @param zsource if \\code{N= ULL} (default), \\code{zsource =3D z0 + dep}, unless the numerical value\n#= #' @return object of class \\code{airRest}.\n##' This object contains the f= ollowing 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} : {aeria= l 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. Kru= g\n##' @export\nairRest.wpLEL <- function(\n x,\n zsource =3D NULL\n)= {\n ## resistance top log profile\n ## LEL - from za (very top) to d= ep (above canopy, log profile)\n ## LE - from za (very top) to dep (abo= ve 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 ca= nopy, exp profile)\n if (x$zjoint =3D=3D 0) {\n ## log-exp profil= e\n I3 <- ( 1 / (x$vk*x$ustar) ) * ( x$h/(x$na*(x$h-x$dep)) ) * ( ex= p( x$na * (1 - x$z0sol/x$h) ) - 1 )\n } else {\n ## log-exp-log p= rofile\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 =3D=3D 0) {\n ## log-exp profile\n I4 <- 0\n } else= {\n ## log-exp-log profile\n I4 <- 1 / (x$vk*x$ustarsol) * l= og( x$zjoint/x$z0sol )\n }\n ##\n\n ## resistance from z0sol to za= \n ras =3D I1 + I3 + I4\n\n\n ## resistance from h to zsource (into c= anopy, 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=3D=3D0) {\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$ust= arsol) ) * ( 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$d= ep)) ) * ( 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 a= r$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 "f= ile:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*plot.arLEL" plot= \.arLEL:1 ((:colname-names) (:rowname-names) (:result-params "replace") (:r= esult-type . value) (:comments . "link") (:shebang . "") (:cache . "no") (:= padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/plot= .arLEL.R") (:exports . "both") (:results . "replace") (:session . "*R.Energ= yBalance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlin= es . "no")) "plot.arLEL <- function(\n x,\n plotWPPoints =3D TRUE,\n = plotWPValues =3D TRUE,\n plotARValues =3D TRUE,\n ...\n) {\n pl= ot.wpLEL(\n x,\n plotWPPoints =3D plotWPPoints,\n plot= WPValues =3D plotWPValues,\n ...\n )\n if (plotARValues) {\n = mx <- par(\"usr\")[2]\n with(\n x,\n {\n= ## arrows(\n ## x0 =3D c(0, 0, 0 ,0 ,0 ,= 0),\n ## y0 =3D c(z0+dep, za, h, hsource, dep, zjoint),\= n ## x1 =3D c(4, 4, 4 ,4 ,4 ,4),\n ## = y1 =3D c(z0+dep, za, h, hsource, dep, zjoint),\n ## len= gth =3D 0,\n ## col =3D \"grey\",\n ## = lty =3D \"dotted\"\n ## )\n \n = \n text(mx*0.4, (za+h)/2., paste(\"R1=3D\", round(R= 1, 2) ) )\n text(mx*0.6= 5, (z0h+dep+h)/2., paste(\"R2z0h=3D\", round(R2z0h, 2), \"R2z0=3D\", round(= R2z0, 2) ) )\n text(mx*0.6, (z0+h)/2., paste(\"R= 3=3D\", round(R3, 2) ) )\n = text(mx*0.6, (2*z0+h)/3., paste(\"R4log=3D\", round(R4log, 2), \"R4= exp=3D\", round(R4exp, 2) ) )\n text(mx*0.5, 2, = paste(\"racz0h=3D\", round(racz0h, 2), \"racz0=3D\", round(racz0, 2) = ) )\n text(mx*0.5, 1, paste(\"raslog=3D\", r= ound(raslog, 2), \"rasexp=3D\", round(rasexp, 2) ) )\n }\n = )\n }\n invisible(NULL)\n}" nil) (9464 nil "file:~/Documents/Projec= ts/EnergyBalance/EnergyBalance.org::*evapoTrans%20Generic%20function%20defi= nition" evapoTrans\ Generic\ function\ definition:1 ((:colname-names) (:row= name-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") (:m= kdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "evapoTrans <- functi= on(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-typ= e . value) (:comments . "link") (:shebang . "") (:cache . "no") (:padline .= "no") (:noweb . "yes") (:tangle . "./package/EnergyBalance/R/evapoTrans.de= fault.R") (:exports . "both") (:results . "replace") (:session . "*R.Energy= Balance*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hline= s . "no")) "evapoTrans.default <- function(\n ras,\n rac,\n Ta = =3D 20,\n frach =3D 1,\n Rnhsol =3D 600,\n RH =3D 50, # delt= ae =3D 5,\n gsol =3D 0.001\n) {\n ## mb (Monteith, 1990)\n es = <- 6.1078 * exp( 17.269 * Ta/(Ta+ 237.3) ) # mb\n ea <- es * RH/10= 0\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.deg= reeC-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 <- f= rach * 3.6 *\n (deltah * Rnhsol) /\n (Landah * (deltah + = Psyh * (1 + 1/(gsol * ras) )))\n ETRhcsol <- frach * 3.6 *\n (Rau= h * Cph * deltae/ras) /\n (Landah * (deltah + Psyh * (1 + 1/(gso= l * 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 =3D ET= Rhrsol,\n etrHcsol =3D ETRhcsol,\n etrHsol =3D ETRhsol,\n = etpCh =3D ETPch\n )\n etp$input <- list(\n ras =3D = ras,\n rac =3D rac,\n Ta =3D Ta,\n frach =3D f= rach,\n Rnhsol =3D Rnhsol,\n RH =3D RH,\n gsol = =3D gsol\n )\n class(etp) <- c(\"evapoTrans\", \"list\")\n attr(et= p, \"method\") <- \"default\"\n return( etp )\n}" nil) (9530 nil "file:~= /Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.airRest" e= vapoTrans\.airRest:1 ((:colname-names) (:rowname-names) (:result-params "re= place") (:result-type . value) (:comments . "link") (:shebang . "") (:cache= . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyBal= ance/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 =3D 20,\n frach =3D 1,\n Rnhsol =3D 600,\n RH =3D 50= , # deltae =3D 5,\n gsol =3D 0.001\n) {\n etp <- evapoTrans.default= (\n ras =3D x$ras,\n rac =3D x$rac,\n Ta =3D= Ta,\n frach =3D frach,\n Rnhsol =3D Rnhsol,\n RH = =3D RH,\n gsol =3D gsol\n )\n etp$input$airRest <- x\n a= ttr(etp, \"method\") <- \"airRest\"\n return( etp )\n}" nil) (9559 nil "= file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*evapoTrans.wpLE= L" evapoTrans\.wpLEL:1 ((:colname-names) (:rowname-names) (:result-params "= replace") (:result-type . value) (:comments . "link") (:shebang . "") (:cac= he . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/EnergyB= alance/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 =3D 20,\n frach =3D 1,\n Rnhsol =3D 600,\n RH =3D 50, = # deltae =3D 5,\n gsol =3D 0.001\n) {\n etp <- evapoTrans.airRest(\= n x =3D airRest(x),\n Ta =3D Ta,\n frach =3D= frach,\n Rnhsol =3D Rnhsol,\n RH =3D RH,\n gsol = =3D 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-param= s "replace") (:result-type . value) (:comments . "link") (:shebang . "") (:= cache . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./package/Ener= gyBalance/R/lhc.etp.R") (:exports . "both") (:results . "replace") (:sessio= n . "*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##' C= reate latin hypercube based on the object \\code{x} of class\n##' \\code{wp= LEL} and calculates the aeril resistance.\n##'\n##' Create latin hypercube = based on the object \\code{x} of class\n##' \\code{wpLEL}. The object \\cod= e{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 La= tin Hypercube sample\n##' @param Min list of named named elements for minim= um 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 suff= ix suffix for file in cache\n##' @param new if \\code{TRUE} the cache is re= created, 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##' @retu= rn 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 =3D FALSE,\n cores =3D parallel::detectCores() - 1\n) = {\n if (missing(suffix)) {\n suffix <- paste0(\".\", paste(names(= Min), sep =3D \"\", collapse=3D\"-\"))\n } else {\n suffix <- pas= te0(\".\", paste(names(Min), sep =3D \"\", collapse=3D\"-\"), 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) !=3D = 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=3Dn, k=3Dlength(Min))\n colnames(dat) <- names(Mi= n)\n ## Transform the 0..1 values to the selected range\n dat= <- sweep(\n x =3D dat,\n MARGIN =3D 2,\n = Max-Min,\n '*'\n )\n dat <- sweep(\n x = =3D dat,\n MARGIN =3D 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 <- depz= 0 < h & depz0 > dat[,\"zjoint\"]\n ## dat <- dat[i,]\n ##= }\n\n dat <- as.data.frame(t(dat))\n ##\n wphelp <- f= unction(...) {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.airRes= t(\n x =3D ar,\n Ta = =3D s[[\"Ta\"]],\n frach =3D 1,\n = Rnhsol =3D s[[\"Rnhsol\"]],\n RH =3D s[[\"= RH\"]],\n gsol =3D 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$etrHr= sol <- etp$etrHrsol\n s$etrHcsol <- etp$etrHcsol\n = s$etrHsol <- etp$etrHsol\n s$etpCh <- = etp$etpCh\n class(s) =3D c(\"lhcAirRest\", class(s))\n = } else {\n s <- NULL\n }\n = i <<- i + 1\n if (round(i, -2) =3D=3D i) {\n = cat(i, \"\\t of about \\t\", no, \"\\t\\t\\r\")\n = }\n return(s)\n },\n mc.cores= =3D cores\n )\n cat(\"\\n\")\n result <- result[!sapp= ly(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 "r= eplace") (:result-type . value) (:comments . "link") (:shebang . "") (:cach= e . "no") (:padline . "no") (:noweb . "yes") (:tangle . "./tests/wpLELTest.= R") (:exports . "both") (:results . "replace") (:session . "*R.EnergyBalanc= e*") (:eval . "never") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "n= o")) "## stopifnot(require(energyBalance))\n\n## Tolerance for numerical co= mparisons\nepsilon <- 1.0e-9\n\nua <- 3.136\nza <- 37\nz <- seq(\n from = =3D 0,\n to =3D za,\n by =3D 0.1\n)\n\n## Test 1\nu <- wpLEL(\n = z,\n ua =3D ua,\n dep =3D 14,\n z0 =3D 2.8,\n na =3D 7,\= n zjoint =3D 14.31625,\n h =3D 28,\n za =3D 37,\n z0sol =3D 0.0= 1\n)\nu.s <- readRDS(\"./tests/u.rds\")\nstopifnot( max(abs(unlist(u) - unl= ist(u.s)), na.rm=3DTRUE ) < epsilon)\n\nu <- airRest(u)\nu.s <- readRDS(\".= /tests/u.ar.rds\")\nstopifnot( max(abs(unlist(u) - unlist(u.s)), na.rm=3DTR= UE ) < epsilon)\n\n## Test 2\nWAI <- 0.5\nLAI <- 0\nu1 <- wpLEL(\n z,\n = ua =3D ua,\n dep =3D function(PAI) {1.1*h*log(1+(Cd*PAI)^0.25)},\n = PAI =3D WAI + LAI\n)\nu1.s <- readRDS(\"./tests/u1.rds\")\nstopifnot( max= (abs(unlist(u1) - unlist(u1.s)), na.rm=3DTRUE ) < epsilon)\n\nu1 <- airRest= (u1)\nu1.s <- readRDS(\"./tests/u1.ar.rds\")\nstopifnot( max(abs(unlist(u1)= - unlist(u1.s)), na.rm=3DTRUE ) < epsilon)\n\n## Test 3\nWAI <- 0.5\nLAI <= - 6\nu2 <- wpLEL(\n z,\n ua =3D ua,\n dep =3D function(PAI) {1.1*= h*log(1+(Cd*PAI)^0.25)},\n PAI =3D WAI + LAI\n)\nu2.s <- readRDS(\"./tes= ts/u2.rds\")\nstopifnot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=3DTRUE )= < epsilon)\n\nu2 <- airRest(u2)\nu2.s <- readRDS(\"./tests/u2.ar.rds\")\ns= topifnot( max(abs(unlist(u2) - unlist(u2.s)), na.rm=3DTRUE ) < epsilon)" ni= l) (9828 nil "file:~/Documents/Projects/EnergyBalance/EnergyBalance.org::*P= ackage%20Documentation" Package\ Documentation:1 ((:colname-names) (:rownam= e-names) (:result-params "replace") (:result-type . value) (:comments . "li= nk") (:shebang . "") (:cache . "no") (:padline . "no") (:noweb . "yes") (:t= angle . "./package/EnergyBalancePaper/R/EnergyBalancePaper.R") (:exports . = "both") (:results . "replace") (:session . "*R.EnergyBalance*") (:eval . "n= ever") (:mkdirp . "yes") (:tangle-mode . 292) (:hlines . "no")) "#' EnergyB= alancePaper: Companion package for paper\n#'\n#' Companion package for the = paper \\bold{TO BE ADDED} This packagee\n#' contains thew data and the func= tions used to analyse the date and\n#' to create the plots in the paper. I= n addition it also contains\n#' further scripts for analysis and plots not = included in the paper.\n#' \n#' @section EnergyBalancePaper functions and d= ata:\n#' Data: To Be added ...\n#' Functions: To Be added ...\n#'\n#' @do= cType package\n#' @name EnergyBalancePaper\nNULL\n#> NULL" nil) ...) ("RDes= cr" (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") (:sheb= ang . "") (:cache . "no") (:padline . "no") (:noweb . "no") (:tangle . "./p= ackage/EnergyBalance/DESCRIPTION") (:exports . "code") (:results . "replace= ") (:eval . "never") (:no-expand . "TRUE") (:hlines . "no") (:session . "no= ne")) "Package: EnergyBalance\nType: Package\nTitle: Fitting of Wind Profil= e, Calculation of Aerodynamic Resistance\nVersion: 0.0.1 \nDate: 2015-08-25= \nAuthor: Rainer M. Krug\nMaintainer: Rainer M Krug \nDesc= ription: Contains function to fit, evaluate and plot wind profiles of the L= og-Exp-Log family of shapes.\nLicense: GPL-3\nLazyData: true\nDepends: DBI,= RSQLite\nImports: magrittr, parallel, lhs" nil) (5933 nil "file:~/Document= s/Projects/EnergyBalance/EnergyBalance.org::*.Rbuiltignore%20File" \.Rbuilt= ignore\ File:1 ((:colname-names) (:rowname-names) (:result-params "replace"= ) (:result-type . value) (:comments . "no") (:shebang . "") (:cache . "no")= (:padline . "no") (:noweb . "no") (:tangle . "./package/EnergyBalance/.Rbu= ildignore") (:exports . "code") (:results . "replace") (:eval . "never") (:= no-expand . "TRUE") (:hlines . "no") (:session . "none")) ".DS_Store\n.Rhis= tory" 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") (:result= s . "replace") (:eval . "never") (:no-expand . "TRUE") (:hlines . "no") (:s= ession . "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 \nDescription: Accompanyi= ng package for the paper XXXXX containig data and scripts used in the analy= sis and the functions to create the graphs.\nLicense: GPL-3\nLazyData: true= \nDepends: EnergyBalance, tgp" nil) (9820 nil "file:~/Documents/Projects/En= ergyBalance/EnergyBalance.org::*.Rbuiltignore%20File" \.Rbuiltignore\ File:= 1 ((:colname-names) (:rowname-names) (:result-params "replace") (:result-ty= pe . 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) =2D-8<---------------cut here---------------end--------------->8--- =2D-=20 Rainer M. Krug, PhD (Conservation Ecology, SUN), MSc (Conservation Biology,= UCT), Dipl. Phys. (Germany) Centre of Excellence for Invasion Biology Stellenbosch University South Africa Tel : +33 - (0)9 53 10 27 44 Cell: +33 - (0)6 85 62 59 98 Fax : +33 - (0)9 58 10 27 44 Fax (D): +49 - (0)3 21 21 25 22 44 email: Rainer@krugs.de Skype: RMkrug PGP: 0x0F52F982 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- Version: GnuPG/MacGPG2 v2 iQEcBAEBCAAGBQJV6WzYAAoJENvXNx4PUvmCukYH/1UjliK+xvSDwWf97vKy2ZaT +j99mJx/0+dJBOv0JpkGMY+sAMezxinia9udHUTdrOn2x77GwqEeziJZB2Jm4vIV 1SCZcd3zU5VpAtfeMO6ub7U2Ol8g47XnvE5R8Qb9lRWZH1Ifj6nodLQrb1vcOsHD SuzvRlpc/fGOz0qBp1zwGbo48kkuMSNFMGrD9ZDDa4jzRBegkBzn6pqibM406cnU 537ZZiBevCUpIlUA9Qw+0sd3EGr891hH++JgY9mu/f9JlBt7ZiUilDm+ek3hkGX/ 19xqJLoSALOH4isHDOZ1TWYVGl3w9t0lwaazd50O6IUR1K675Nc8tanCZS/3pLE= =O6eT -----END PGP SIGNATURE----- --=-=-=--