ajout du debut du projet

DESCRIPTION

@@ -0,0 +1,13 @@
+Package: BIOMASS
+Type: Package
+Title: Estimating Aboveground Biomass and Its Uncertainty in Tropical Forests
+Version: 1.1
+Date: 2017-01-03
+Author: Maxime REJOU-MECHAIN, Ariane TANGUY, Camille PIPONIOT, Jerome CHAVE, Bruno HERAULT
+Maintainer: Maxime REJOU-MECHAIN <maxime.rejou@gmail.com>
+Description: Contains functions to estimate aboveground biomass/carbon and its uncertainty in tropical forests. These functions allow to (1) retrieve and to correct taxonomy, (2) estimate wood density and its uncertainty, (3) construct height-diameter models, (4) estimate the above-ground biomass/carbon at the stand level with associated uncertainty. To cite BIOMASS, please use citation("BIOMASS").
+License: GPL-2
+Depends: R(>= 2.10.0)
+Imports: minpack.lm, raster, msm, httr, jsonlite, methods, graphics, stats, utils
+VignetteBuilder: knitr
+Suggests: knitr, rmarkdown

NAMESPACE

@@ -0,0 +1,10 @@
+importFrom("minpack.lm","nlsLM", "nls.lm.control") 
+importFrom("raster","raster", "getData", "extract") 
+importFrom("msm","rtnorm") 
+importFrom("httr","content", "GET", "upload_file", "POST", "config") 
+importFrom("jsonlite","fromJSON") 
+importFrom("graphics", "legend", "lines", "par", "plot")
+importFrom("stats", "SSmicmen", "lm", "median", "na.omit", "quantile", "rnorm", "sd")
+importFrom("utils", "data", "download.file", "unzip", "write.table")
+importFrom("methods", "is")
+exportPattern("^[[:alpha:]]+")

NEWS

@@ -0,0 +1,13 @@
+* version 1.2
+- Duplicated genera from the plantList have been fixed in the "genusFamily" dataset (e.g. The family Jungermanniaceae was given for the genus Massularia, now the dataset gives the Rubiaceae family)
+
+* version 1.1
+- The NouraguesHD dataset has now taxonomic information
+- The warning message from the computeAGB function has been removed
+- The correctTaxo function have been slightly modified to handle species names not recognized by TNRS
+- The getWoodDensity function has been slightly modified to deal with NA values in addWoodDensityData, which is now a data.frame of three colums and not four (the family column is now internaly built).
+- The computeAGB and AGBmonteCarlo functions have an additional argument: Dlim (see help).
+- The AGBmonteCarlo function has now an option to propagate error up to the carbon estimate (see the argument Carbon).
+
+* version 1.0
+Initial version of BIOMASS

R/AGBmonteCarlo.R

@@ -0,0 +1,179 @@
+AGBmonteCarlo <- function(D, WD = NULL, errWD = NULL, H = NULL, errH = NULL, 
+                          HDmodel = NULL, coord = NULL, Dpropag = NULL, n = 1000, Carbon = FALSE, Dlim = NULL)
+{  
+  if(n > 1000 | n < 50) 
+    stop("n cannot be smaller than 50 or larger than 1000")
+
+  ### Propagate error with Markov Chain Monte Carlo approach
+
+  # --------------------- D ---------------------
+
+  D_simu <- replicate(n, D)
+
+  if(!is.null(Dpropag))
+  {
+    if(length(Dpropag) == 1 && Dpropag == "chave2004")
+    {
+      # Propagation of the measurement error on D: based on Chave et al. 2004 (p.412) Phil. Trans. R. Soc. Lond. B. 
+      fivePercent <- round(length(D) * 5 / 100)
+      chaveError <- function(x)
+      { 
+        ## Assigning large errors on 5% of the trees
+        largeErrSample <- sample(length(x), fivePercent)
+        x[largeErrSample] <- msm::rtnorm(n = fivePercent, mean = x[largeErrSample], sd = 4.64, lower = 0.1, upper = 500)
+        ## Assigning small errors on the remaining 95% trees
+        D_sd <- 0.0062 * x[-largeErrSample] + 0.0904
+        x[-largeErrSample] <- msm::rtnorm(n =length(D_sd), mean = x[-largeErrSample], sd = D_sd, lower = 0.1, upper = 500)
+        return(x)
+      }
+      D_simu <- apply(D_simu, 2, chaveError)
+
+    }
+    else
+    {
+      if(!is.numeric(Dpropag) | !length(Dpropag)%in%c(1,length(D))) 
+        stop("Dpropag should be set to one of these options:
+             - \"chave2004\"
+             - a single sd value that will be applied to all trees
+             - a vector of sd values of the same length as D")
+      D_simu <- apply(D_simu, 2, function(x) msm::rtnorm(n = length(x), mean = x, sd = Dpropag, lower = 0.1, upper = 500))
+    }
+  }
+
+  # --------------------- WD ---------------------
+
+  if(!is.null(WD) & !is.null(errWD)){
+    ### Propagation of the error on WD
+    WD_simu <- replicate(n, WD)
+
+    if(length(errWD) == 1)
+      errWD = rep(errWD, length(WD))
+    if(length(errWD) != length(WD))
+      stop("Your wood density vector (WD) and the vector of the associated errors (errWD) don't have the same length")
+
+    #### Below 0.08 and 1.39 are the minimum and the Maximum WD value from the global wood density database respectively
+    WD_simu <- apply(WD_simu, 2, function(x) msm::rtnorm(n = length(x), mean = x, sd = errWD, lower = 0.08, upper = 1.39))
+  }
+  else
+    stop("The WD and errWD arguments must be not NULL")
+
+
+  # --------------------- H ---------------------
+
+  if(is.null(HDmodel) & is.null(coord) & is.null(H))
+    stop("Input missing, you need to provide one of the following arguments:
+             - H
+             - HDmodel
+             - coord")
+
+  # if there is data for H
+  if(!is.null(HDmodel) | !is.null(H))
+  {    
+    if(!is.null(HDmodel))
+      # Propagation of the error thanks to the local model of H
+      H_simu <- apply(D_simu,2,function(x) predictHeight(x, model = HDmodel, err = TRUE))
+    else
+    {
+      if(is.null(errH))
+        stop("Cannot propagate height errors without information on associated errors (errH is null), if you do not want to propagate H errors please set errH to 0")
+      # Propagation of the error using the errH value(s)
+      H_simu <- replicate(n, H) 
+      H_simu <- apply(H_simu, 2, function(x) msm::rtnorm(x, mean = x, sd = errH, lower = 1.3, upper = max(x) + 15))
+    }
+
+    # --------------------- AGB 
+
+    param_4 <- NULL
+    data(param_4, envir = environment()) # posterior parameters from MCMC algorithm
+    selec <- sample(1:nrow(param_4), n)    
+    RSE <- param_4[selec,"sd"]
+
+    # Construct a matrix where each column contains random errors taken from N(0,RSEi) with i varying between 1 and n
+    matRSE <- mapply(function(x,y){rnorm(mean = x, sd = y, n = length(D))}, x = 0, y = RSE)
+
+    # Posterior model parameters
+    Ealpha <- param_4[selec,"intercept"]
+    Ebeta <- param_4[selec,"logagbt"]
+
+    # Propagation of the error using simulated parameters
+    Comp <- log(WD_simu * H_simu * D_simu^2)
+    Comp <- sweep(Comp, MARGIN = 2, Ebeta, "*")
+    Comp <- sweep(Comp, MARGIN = 2, Ealpha, "+")
+    Comp <- Comp + matRSE
+
+    # Backtransformation
+    AGB_simu <- exp(Comp)/1000
+  }
+
+  # --------------------- Coordinates ---------------------
+
+  # If there is no data for H, but site coordinates
+  if(!is.null(coord))
+  {
+    if(is.null(dim(coord))) 
+      coord <- as.matrix(t(coord))
+    if(nrow(coord) == 1)
+      coord <- cbind(rep(coord[1], length(D)), rep(coord[2], length(D)))
+    if(nrow(coord) != length(D))
+      stop("coord should be either
+             - a vector (e.g. c(longitude, latitude))
+             - a matrix with two columns (longitude and latitude) 
+             having the same number of rows as the number of trees (length(D))")
+
+    # Equ 7
+    # Log(agb) = -1.803 - 0.976 (0.178TS - 0.938CWD - 6.61PS) + 0.976log(WD) + 2.673log(D) -0.0299log(D2)
+    param_7 <- NULL
+    data(param_7, envir = environment()) # posterior parameters from MCMC algorithm
+    selec <- sample(1:nrow(param_7), n)    
+
+    bioclimParams <- getBioclimParam(coord) # get bioclim variables corresponding to the coordinates
+
+    # Posterior model parameters 
+    intercept <- param_7[selec, "intercept"] # vector of simulated intercept
+    coeffWD <- param_7[selec, "logwsg"] # vector of simulated parameter associated to ln(WD)
+    coefflnD <- param_7[selec, "logdbh"] # vector of simulated parameter associated to ln(D) 
+    coefflnD2 <- param_7[selec, "logdbh2"] # vector of simulated parameter associated to ln(D)^2
+    coeffE <- -param_7[selec, "E"] # vector of simulated parameter associated to E
+    coeffTmp <- param_7[selec, "temp"] # vector of of simulated parameter associated to tempsea coeff
+    coeffCWD <- param_7[selec, "cwd"] # vector of of simulated parameter associated to CWD coeff
+    coeffPS <- param_7[selec, "prec"] # vector of of simulated parameter associated to precSeas coeff
+    RSE <- param_7[selec,"sd"] # vector of simulated RSE values
+
+    # Recalculating n E values based on posterior parameters associated with the bioclimatic variables
+    Tmp <- replicate(n, bioclimParams$tempSeas)
+    CWD <- replicate(n, bioclimParams$CWD)
+    PS <- replicate(n, bioclimParams$precSeas)
+
+    Esim <- sweep(Tmp, MARGIN = 2, coeffTmp, "*") + sweep(CWD, MARGIN = 2, coeffCWD, "*") +
+      sweep(PS, MARGIN = 2, coeffPS, "*")
+
+    # Applying AGB formula over simulated matrices and vectors
+    AGB_simu <- sweep(sweep(log(WD_simu), MARGIN = 2, coeffWD, "*") + 
+                        sweep(log(D_simu), MARGIN = 2, coefflnD, "*") + 
+                        sweep(log(D_simu)^2, MARGIN = 2, coefflnD2, "*")+
+                        sweep(Esim, MARGIN = 2, coeffE, "*"),
+                      MARGIN = 2, intercept, '+')
+    # Construct a matrix where each column contains random errors taken from N(0,RSEi) with i varying between 1 and n
+    matRSE <- mapply(function(x,y){rnorm(mean = x, sd = y, n = length(D))}, x = 0, y = RSE)
+    AGB_simu <- AGB_simu + matRSE
+    AGB_simu <- exp(AGB_simu)/1000
+  }  
+
+  if(!is.null(Dlim)) AGB_simu[D<Dlim,] <- 0  
+
+  if(Carbon == FALSE){
+    res <- list(meanAGB = mean(apply(AGB_simu, 2, sum, na.rm = T)), 
+                medAGB = median(apply(AGB_simu, 2, sum, na.rm = T)), 
+                sdAGB = sd(apply(AGB_simu, 2, sum, na.rm = T)), 
+                credibilityAGB = quantile(apply(AGB_simu, 2, sum, na.rm = T), probs = c(0.025,0.975)), 
+                AGB_simu = AGB_simu)
+  }else{
+    AGC_simu <- AGB_simu*rnorm(mean = 47.13, sd = 2.06,n = n*length(D))/100 # Biomass to carbon ratio calculated from Thomas and Martin 2012 forests data stored in DRYAD (tropical angiosperm stems carbon content)
+    res <- list(meanAGC = mean(apply(AGC_simu, 2, sum, na.rm = T)), 
+                medAGC = median(apply(AGC_simu, 2, sum, na.rm = T)), 
+                sdAGC = sd(apply(AGC_simu, 2, sum, na.rm = T)), 
+                credibilityAGC = quantile(apply(AGC_simu, 2, sum, na.rm = T), probs = c(0.025,0.975)), 
+                AGC_simu = AGC_simu)
+  }
+  return(res)
+}

R/BIOMASS-internal.R

@@ -0,0 +1,126 @@
+.Random.seed <-
+c(403L, 10L, 1419428254L, -146196392L, -1530329669L, 1952344921L, 
+-1140016920L, 666147094L, -1765152111L, 1222281027L, 1086820946L, 
+-2038778652L, -1993507033L, 1387920253L, 1248132724L, -2067267494L, 
+-1881810779L, 611191487L, -1742753466L, 614508496L, 1509380595L, 
+-1772831471L, -2120009408L, -720910050L, 570142185L, -451797221L, 
+-1095775958L, 2076639820L, -988791281L, 1484230981L, -1967334660L, 
+1426452818L, -1951361331L, -915960185L, -1291683474L, 1326216008L, 
+-2126026933L, 1461956265L, -1141091336L, 638946086L, 772119617L, 
+-690442797L, 1949056898L, 577401780L, 985402167L, -844756435L, 
+541584196L, -925892502L, 491068117L, 1105314927L, -602636938L, 
+-2115000672L, -519756957L, 2118043649L, 1727001456L, -679249138L, 
+208647545L, 1256411403L, 1241256506L, 1776339260L, -1278736769L, 
+-2144449067L, 1526055916L, -509160126L, -1350432099L, 1067149079L, 
+-2051864962L, 396371512L, 641491227L, 464766585L, 1124205256L, 
+-1378037002L, 326687537L, -860247197L, 599572786L, -271891836L, 
+106327751L, -247712355L, -134078188L, 979996602L, -1555183099L, 
+-120325153L, 1477030502L, -1031918096L, 1374108435L, -1699724111L, 
+-919546016L, -1271646978L, 1439601801L, 1965298619L, -2100134518L, 
+374512748L, 1501263343L, 1332530725L, 292866780L, -1841618766L, 
+-855559251L, -2025822361L, 248485006L, 1045041512L, -1172139669L, 
+1486349065L, 373200280L, 156574918L, 1901911585L, -1912783181L, 
+-1299946462L, 1743052308L, 1733120663L, 1866206349L, -1618869852L, 
+919563146L, 1552041973L, 106350159L, -1554022058L, 369675264L, 
+372098371L, -1323341599L, 1728299600L, 1157619374L, -1126561191L, 
+-747597205L, -1775355942L, -560187236L, -804554081L, -1144514315L, 
+-2120941172L, 193408098L, -1020838851L, 839126711L, -90018466L, 
+95810712L, 1769545723L, 1939735961L, 1947801128L, -334672170L, 
+706177873L, 1409920515L, 1567773074L, -471068892L, 84894183L, 
+-525496771L, 197515444L, 296906522L, 943899749L, 798199039L, 
+-1670873722L, 2002678544L, -567244877L, 1711844433L, -1814884352L, 
+-1098465058L, -20432087L, -829176101L, -1766656534L, 582950284L, 
+-1645342001L, -1741762939L, -640094916L, -1055117294L, 656342797L, 
+860404807L, -503329234L, -1057876088L, -1393696117L, -641444759L, 
+-1191028680L, 1340395750L, -369969023L, -1889492973L, 1889068994L, 
+-1497382796L, -398592393L, 185722733L, -1255420L, 1331876650L, 
+473098389L, -88852689L, 522444342L, -1747498400L, 1695307939L, 
+-1056064575L, -1919289424L, 571613902L, -1826340807L, 1247393355L, 
+-1348125702L, 72091388L, -894547137L, -1653980139L, -1440882900L, 
+497759234L, 1644328669L, 1707886039L, 1474015422L, -493829384L, 
+653117659L, -427934919L, 1892241032L, -107627978L, 1996395121L, 
+1009387683L, 780386802L, 1854886212L, 1220037127L, -1316079651L, 
+-753962796L, 1315598330L, -1994594491L, -1184857185L, -513783514L, 
+1389074864L, 1303130707L, -385876623L, 1573538976L, -798897090L, 
+-914291895L, -709553669L, 1839756746L, -232178900L, 719762223L, 
+-1491572251L, -488590180L, 83640562L, -1898456723L, -1775757657L, 
+581671118L, -650594776L, -1607352789L, -1112741088L, -1659687988L, 
+762676448L, 1275955906L, 440369192L, 385975212L, 31097532L, 127471090L, 
+-1474482640L, -621942876L, 2005018040L, 1613080410L, -949581680L, 
+-635092100L, 89185044L, 711835970L, 930362112L, 758806460L, -1660583088L, 
+-1935078110L, 937436744L, -228161524L, -1028515748L, -1647304238L, 
+673317376L, 1256339796L, 1710228712L, 537107706L, 1960107728L, 
+865154348L, 1696700660L, -1697538670L, 1892716896L, 1059139596L, 
+1000507104L, 1954679394L, 7251624L, 1991571020L, -1256922244L, 
+-658189006L, -1695173008L, 1777724228L, -516615208L, -1305956486L, 
+-239498704L, -819520580L, -1922268588L, 1729717314L, 1887125664L, 
+-755938628L, 902950352L, 1951922018L, -1845130520L, -610782004L, 
+-1312113156L, 590408178L, -417569152L, 841164276L, 829584008L, 
+-2039746758L, -234492080L, -506520468L, 1267848596L, 1021809746L, 
+1242954208L, 1165847756L, -1648117600L, 577649026L, -2033579800L, 
+-418845972L, -527149764L, -1569663886L, -882119568L, -2023427036L, 
+-1463451592L, -126962918L, 259720400L, 1892401980L, 1948610452L, 
+-2121828478L, -1053614656L, -1857293764L, -157148784L, -61267422L, 
+2040003848L, -754613620L, -750598372L, 1427855506L, 1332971904L, 
+1051912724L, -1740033240L, 346168890L, -1657716272L, -1534261908L, 
+1638865844L, -2085581806L, -1953408544L, 756825036L, 635721952L, 
+1883443234L, -113455832L, 900492812L, -278705348L, -198466574L, 
+2140532464L, 2111271492L, -113971624L, 269480762L, 1188930032L, 
+886423228L, -1542681324L, 561338050L, 201971808L, 331573116L, 
+-395514928L, -531280606L, -66759000L, 95398796L, 2102410428L, 
+-1797232846L, 801405504L, -2021990220L, 1207888456L, -1064071750L, 
+480715280L, 1680013036L, 1951970644L, 1327101202L, 1371814304L, 
+1832261324L, -165728672L, 2009889730L, -1983550680L, -1229849684L, 
+-1060020420L, 700874098L, -455020752L, -1619299036L, -1401330888L, 
+-690839846L, -95540336L, 1312742140L, -1080417388L, 937566274L, 
+15278336L, 1804745788L, 972330320L, 912248994L, 243385672L, -2019210484L, 
+1017260764L, -1614319278L, 1779148928L, 83627092L, 429122536L, 
+-1793508102L, 525139792L, -428288212L, -320922252L, 1683529618L, 
+358939744L, -6265460L, 1664537440L, -538511902L, 762348456L, 
+573483212L, 1536971772L, -1071545934L, -823243280L, -2064064572L, 
+1584728408L, 560881018L, 406210480L, 625032636L, -985402284L, 
+-2114005054L, -278640608L, -671842116L, -992577968L, -774842398L, 
+2137069672L, 1631901772L, 466470140L, 2135894002L, 1285528832L, 
+2133665140L, 213491720L, -1027234886L, 89785808L, 766803948L, 
+-1865276012L, 1713316306L, -21800608L, -667083956L, -719584992L, 
+-1469094014L, -1416216856L, -1403311892L, -1454602180L, 1956417394L, 
+-244699536L, 2099366948L, -1350492360L, -854602598L, 51909328L, 
+828772540L, 1319775892L, -86266238L, 1394761920L, 1601537852L, 
+-739045232L, -1923609054L, -420549624L, -84472564L, 1395887260L, 
+-438857198L, -136334464L, -1903938028L, -560370136L, -2145968838L, 
+1053224400L, 1996310636L, 926844212L, -1403278702L, -1865265312L, 
+-1430606004L, 182806496L, -599374645L, 1205032252L, 620790122L, 
+-377336929L, 277055017L, -455677762L, 1323528620L, -882979075L, 
+-607323577L, 2024634672L, 653279822L, -688412037L, -324527651L, 
+1614131210L, 483889448L, -1456337007L, 821502339L, -1973698940L, 
+-1836360526L, 1124629511L, 1898227793L, 534263766L, -1054812492L, 
+455206597L, 360749071L, -453138296L, 1321605542L, -836026029L, 
+1126822581L, -1208276974L, 496675296L, 1671527497L, 497683067L, 
+-1509944500L, 1791710938L, -872281393L, 1001601689L, -1574316370L, 
+-1136540740L, 1834523693L, -414256169L, -2015749600L, -1951089794L, 
+589981003L, -2111273139L, 1618709882L, -1610100808L, -1579174559L, 
+625051923L, 1308451124L, 1564130114L, -1556808873L, -741524831L, 
+1281448806L, -290138780L, -166125419L, -2069286465L, -1882225320L, 
+513342326L, 246626691L, -1921098811L, 706183394L, 1154807120L, 
+-131722119L, 1217980331L, -1885090532L, -1885648310L, -753078721L, 
+-831700343L, 152970910L, -1929874612L, 1300632349L, -1495162201L, 
+318065104L, -1046232722L, 2028973083L, 779462013L, -245812374L, 
+1030964744L, 456653489L, -760740573L, 605697572L, -168149806L, 
+1777188135L, 158144369L, 1799607734L, -2036785836L, -1988584475L, 
+819996143L, -221516504L, -234652282L, -7898701L, -2067131115L, 
+1540380530L, 1403319232L, 1282618409L, -746626917L, -46215828L, 
+654980474L, -1957480785L, -627450439L, -1858961458L, -1215803620L, 
+178585229L, 1126113015L, -1650044416L, -92742562L, -40689877L, 
+110029869L, -430203750L, -2025893800L, -2006124607L, 561633395L, 
+-670051948L, -1444044766L, 671803191L, -1780323839L, -1806814458L, 
+1598496580L, 280736373L, 843965407L, 602818360L, 1568637206L, 
+787479843L, 1244606181L, -1113221374L, 631455088L, -1570202343L, 
+531485963L, -1396926980L, -959877590L, -1814301089L, -861436439L, 
+715175678L, -1511201044L, -1637640643L, -286669305L, 802621936L, 
+-1356457586L, 1220325307L, -651871843L, -914131126L, -647345304L, 
+-1572975279L, 1936481859L, -96812220L, 635854834L, -693166649L, 
+1184392081L, 1852922646L, 155086708L, 1704627717L, 99137103L, 
+-1647603128L, 254280678L, 317762835L, 358687349L, 661229650L, 
+-115285344L, -528380023L, 866700219L, 1318128652L, 1552595354L, 
+10754319L, 1092380505L, -991786514L, 1179391100L, 1673785581L, 
+-708921449L, -290078965L)