R/prospect.R
In MarcoDVisser/ccrtm: Coupled Chain Radiative Transfer Models
Defines functions
.prospectdv
.prospect5v
.prospectd
.prospect5
prospectd
prospect5
Documented in
prospect5
prospectd
#' PROSPECT model version 5 and 5B
#'
#' The PROSPECT5(b) leaf reflectance model. The model was implemented based on
#' Jacquemoud and Ustin (2019), and is further described in detail in Feret et al (2008).
#' PROSPECT models use the plate models developed in
#' Allen (1969) and Stokes (1862). Set Cbrown to 0 for prospect version 5.
#'
#' @param param A named vector of PROSPECT parameters (note: program ignores case):
#'
#' \itemize{
#' \item [1] = leaf structure parameter (N)
#' \item [2] = chlorophyll a+b content in ug/cm2 (Cab)
#' \item [3] = carotenoids content in ug/cm2 (Car)
#' \item [4] = brown pigments content in arbitrary units (Cbrown)
#' \item [5] = equivalent water thickness in g/cm2 (Cw)
#' \item [6] = leaf dry matter content in g/cm2 - lma - (Cm)
#' }
#'
#' @return spectra matrix with leaf reflectance and transmission
#' for wavelengths 400 to 2500nm:
#' \itemize{
#' \item [1] = leaf reflectance (rho)
#' \item [2] = leaf transmission (tau)
#' }
#'
#' @importFrom expint expint_E1
#'
#' @examples
#' ## see ?fRTM for the typical mode of simulation
#' ## e.g. fRTM(rho~prospect5)
#'
#' ## 1) get parameters
#' defaultpars<-getDefaults(rho~prospect5)
#' ## getDefaults("prospect5") will also work
#'
#' ## 2) get leaf reflectance and transmission
#' rt<-fRTM(rho+tau~prospect5,defaultpars)
#'
#' ## lower-level implementation example
#' ## Alternatively implement directly
#' mypars<-c("N"=1,"Cab"=35,"Car"=20,"Cbrown"=3,"Cw"=0.01,"Cm"=0.01)
#' prospect5(mypars)
#'
#' @references Jacquemoud, S., and Ustin, S. (2019). Leaf optical properties.
#' Cambridge University Press.
#' @references Feret, J.B., Francois, C., Asner, G.P., Gitelson, A.A.,
#' Martin, R.E., Bidel, L.P.R., Ustin, S.L., le Maire, G., Jacquemoud, S. (2008),
#' PROSPECT-4 and 5: Advances in the leaf optical properties model separating photosynthetic
#' pigments. Remote Sens. Environ. 112, 3030-3043.
#' @references Allen W.A., Gausman H.W., Richardson A.J., Thomas J.R.
#' (1969), Interaction of isotropic ligth with a compact plant leaf,
#' Journal of the Optical Society of American, 59:1376-1379.
#' @references Stokes G.G. (1862), On the intensity of the light
#' reflected from or transmitted through a pile of plates,
#' Proceedings of the Royal Society of London, 11:545-556.
#' @useDynLib ccrtm
#' @export
prospect5 <- function(param){
## force case to lower
names(param) <- tolower(names(param))
## input paramters
N <- as.numeric(param["n"])
Cab <- as.numeric(param["cab"])
Car <- as.numeric(param["car"])
Cbrown <- as.numeric(param["cbrown"])
Cw <- as.numeric(param["cw"])
Cm <- as.numeric(param["cm"])
rhoTau <- matrix(0, 2101, 2)
CoefMat <- data_prospect5 ## get reflective and absorbtion coefficient data
l <- CoefMat[,1] # wavelength (nm)
n <- CoefMat[,2] # refractive index
## specific absorption coefficient for each element at each wl (k= total absorbtion coefficient)
alpha <- c(Cab,Car,Cbrown,Cw,Cm)/N
## k <- (Cab*CoefMat[,3]+Car*CoefMat[,4]+Cbrown*CoefMat[,5]+Cw*CoefMat[,6]+Cm*CoefMat[,7])/N;
k <- CoefMat[,-c(1:2)]%*%alpha ## 1% faster
## k[which(k==0)] <- .Machine$double.eps ## precision of zero in R
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-k)*exp(-k)+k^2*expint::expint_E1(k) ## transmittance
## the plate model
## reflectance and transmittance though interface, one layer and N layers
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel(r12,t12,r21,t21, x, y, trans, N)
rhoTau[,1] <- pm[[1]]
rhoTau[,2] <- pm[[2]]
colnames(rhoTau) <- c("rho", "tau")
return(rhoTau)
}
#' PROSPECT model version D
#'
#' The PROSPECTD leaf reflectance model. The model was implemented based on
#' Jacquemoud and Ustin (2019), and is further described in detail in Feret et al (2017).
#' PROSPECT models use the plate models developed in
#' Allen (1969) and Stokes (1862).
#'
#' @param param A named vector of PROSPECT parameters (note: program ignores case):
#' \itemize{
#' \item [1] = leaf structure parameter (N)
#' \item [2] = chlorophyll a+b content in ug/cm2 (Cab)
#' \item [3] = carotenoids content in ug/cm2 (Car)
#' \item [4] = Leaf anthocyanin content (ug/cm2) (Canth)
#' \item [5] = brown pigments content in arbitrary units (Cbrown)
#' \item [6] = equivalent water thickness in g/cm2 (Cw)
#' \item [7] = leaf dry matter content in g/cm2 - lma - (Cm)
#' }
#'
#' @return spectra matrix with leaf reflectance and transmission
#' for wavelengths 400 to 2500nm:
#' \itemize{
#' \item [1] = leaf reflectance (rho)
#' \item [2] = leaf transmission (tau)
#' }
#' @references Jacquemoud, S., and Ustin, S. (2019). Leaf optical properties.
#' Cambridge University Press.
#' @references Feret, J.B., Gitelson, A.A., Noble, S.D., Jacquemoud, S. (2017).
#' PROSPECT-D: Towards modeling leaf optical properties through a complete lifecycle.
#' Remote Sens. Environ. 193, 204-215.
#' @references Allen W.A., Gausman H.W., Richardson A.J., Thomas J.R.
#' (1969), Interaction of isotropic ligth with a compact plant leaf,
#' Journal of the Optical Society of American, 59:1376-1379.
#' @references Stokes G.G. (1862), On the intensity of the light
#' reflected from or transmitted through a pile of plates,
#' Proceedings of the Royal Society of London, 11:545-556.
#' @importFrom expint expint_E1
#' @examples
#' ## see ?fRTM for the typical mode of simulation
#' ## e.g. fRTM(rho~prospectd)
#'
#' ## 1) get parameters
#' defaultpars<-getDefaults(rho~prospectd)
#' ## getDefaults("prospectd") will also work
#'
#' ## 2) get leaf reflectance and transmission
#' rt<-fRTM(rho+tau~prospectd,defaultpars)
#'
#' ## lower-level implementation example
#' ## Alternatively implement directly (case ignored for parameters)
#' mypars<-c("N"=1,"Cab"=35,"Car"=20,"Canth"=15,"Cbrown"=3,"Cw"=0.01,"Cm"=0.01)
#' prospectd(mypars)
#' @export
#' @useDynLib ccrtm
prospectd <- function(param){
## force case to lower
names(param) <- tolower(names(param))
## input paramters
N <- as.numeric(param["n"])
Cab <- as.numeric(param["cab"])
Car <- as.numeric(param["car"])
Canth <- as.numeric(param["canth"])
Cbrown <- as.numeric(param["cbrown"])
Cw <- as.numeric(param["cw"])
Cm <- as.numeric(param["cm"])
rhoTau <- matrix(0, 2101, 2)
# CoefMat <- ccrtm:::data_prospectd ## get reflective and absorbtion coefficient data
CoefMat <- data_prospectd ## get reflective and absorbtion coefficient data
l <- CoefMat[,1] # wavelength (nm)
n <- CoefMat[,2] # refractive index
## specific absorption coefficient for each element at each wl (k= total absorbtion coefficient)
## should be able to switch this to CoefMat%*%Input
## the formula is over N as concentrations are assumed uniform over the
## leaf
k <- (Cab*CoefMat[,3]+Car*CoefMat[,4]+Canth*CoefMat[,5]+Cbrown*CoefMat[,6]+
Cw*CoefMat[,7]+Cm*CoefMat[,8])/N;
## k[which(k==0)] <- .Machine$double.eps ## precision of zero in R
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-k)*exp(-k)+k^2*expint::expint_E1(k) ## transmittance
## the plate model
## reflectance and transmittance though interface, one layer and N layers
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel(r12,t12,r21,t21, x, y, trans, N)
rhoTau[,1] <- pm[[1]]
rhoTau[,2] <- pm[[2]]
colnames(rhoTau) <- c("rho", "tau")
return(rhoTau)
}
# Low level prospect 5 implementation
.prospect5 <- function(param,
expected=c("n","cab","car","cbrown","cw","cm")){
## force case to lower
names(param) <- tolower(names(param))
## input paramters
N <- as.numeric(param[expected[1]])
Cab <- as.numeric(param[expected[2]])
Car <- as.numeric(param[expected[3]])
Cbrown <- as.numeric(param[expected[4]])
Cw <- as.numeric(param[expected[5]])
Cm <- as.numeric(param[expected[6]])
rhoTau <- matrix(0, 2101, 2)
CoefMat <- data_prospect5 ## get reflective and absorbtion coefficient data
n <- CoefMat[,2] # refractive index
alpha <- c(Cab,Car,Cbrown,Cw,Cm)/N
## k <- (Cab*CoefMat[,3]+Car*CoefMat[,4]+Cbrown*CoefMat[,5]+Cw*CoefMat[,6]+Cm*CoefMat[,7])/N;
k <- CoefMat[,-c(1:2)]%*%alpha ## 1% faster
## k[which(k==0)] <- .Machine$double.eps ## precision of zero in R
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-k)*exp(-k)+k^2*expint::expint_E1(k) ## transmittance
## the plate model
## reflectance and transmittance though interface, one layer and N layers
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel(r12,t12,r21,t21, x, y, trans, N)
rhoTau[,1] <- pm[[1]]
rhoTau[,2] <- pm[[2]]
colnames(rhoTau) <- c("rho", "tau")
return(rhoTau)
}
# Low level prospect D implementation
.prospectd <- function(param,
expected=c("n","cab","car",
"canth","cbrown","cw","cm")){
## force case to lower
names(param) <- tolower(names(param))
## input paramters
N <- as.numeric(param[expected[1]])
Cab <- as.numeric(param[expected[2]])
Car <- as.numeric(param[expected[3]])
Canth <- as.numeric(param[expected[4]])
Cbrown <- as.numeric(param[expected[5]])
Cw <- as.numeric(param[expected[6]])
Cm <- as.numeric(param[expected[7]])
rhoTau <- matrix(0, 2101, 2)
CoefMat <- data_prospectd ## get reflective and absorbtion coefficient data
n <- CoefMat[,2] # refractive index
## specific absorption coefficient for each element at each wl (k= total absorbtion coefficient)
alpha <- c(Cab,Car,Canth,Cbrown,Cw,Cm)/N
k <- CoefMat[,-c(1:2)]%*%alpha ## 1% faster
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-k)*exp(-k)+k^2*expint::expint_E1(k) ## transmittance
## the plate model
## reflectance and transmittance though interface, one layer and N layers
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel(r12,t12,r21,t21, x, y, trans, N)
rhoTau[,1] <- pm[[1]]
rhoTau[,2] <- pm[[2]]
colnames(rhoTau) <- c("rho", "tau")
return(rhoTau)
}
## Low level vectorized prospect 5 implementation
## param is expected to be a matrix
.prospect5v <- function(param){
## expected parameters and order
expected <- c("n","cab","car","cbrown","cw","cm")
CoefMat <- ccrtm:::data_prospect5 ## get reflective and absorbtion coefficient data
## force to all to lowercase
colnames(param) <- tolower(colnames(param))
colnames(CoefMat) <- tolower(colnames(CoefMat))
## input paramters
l <- CoefMat[,"l"] ## wavelength
N <- matrix(rep(as.numeric(param[,"n"]),length(l)),byrow=FALSE,ncol=length(l)) ## N matrix
## prepare matrices
Input <- param[,which(colnames(param)!="n")] ## input matrix
Input <- Input[,expected[-1]] ## enforce order
k_i_mat <- t(CoefMat[,expected[-1]]) ## absorbtion k_i
## n x k . k x l = n x l
kmat <- (Input %*% k_i_mat)/N
## k[which(k==0)] <- .Machine$double.eps ## precision of zero in R
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-kmat)*exp(-kmat)+kmat^2*expint::expint_E1(kmat) ## transmittance
## next run it through the plate model
## the plate model
## reflectance and transmittance though interface, one layer and N layers
n <- CoefMat[,2] # refractive index
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel_vectorized(r12,t12,r21,t21, x, y, trans, N[,1])
rho <- pm[[1]]
tau <- pm[[2]]
return(list(rho=rho,tau=tau))
}
## Low level vectorized prospect D implementation
## param is expected to be a matrix
.prospectdv <- function(param){
CoefMat <- ccrtm:::data_prospectd ## get reflective and absorbtion coefficient data
## force to all to lowercase
colnames(param) <- tolower(colnames(param))
colnames(CoefMat) <- tolower(colnames(CoefMat))
## input paramters
l <- CoefMat[,"l"] ## wavelength
N <- matrix(rep(as.numeric(param[,"n"]),length(l)),byrow=FALSE,ncol=length(l)) ## N matrix
## prepare matrices
Input <- param[,which(colnames(param)!="n")] ## input matrix
Input <- Input[,c("cab","car","canth","cbrown","cw","cm")] ## enforce order
k_i_mat <- t(CoefMat[,c("cab","car","canth","cbrown","cw","cm")]) ## absorbtion k_i
## n x k . k x l = n x l
kmat <- (Input %*% k_i_mat)/N
## k[which(k==0)] <- .Machine$double.eps ## precision of zero in R
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-kmat)*exp(-kmat)+kmat^2*expint::expint_E1(kmat) ## transmittance
## next run it through the plate model
## the plate model
## reflectance and transmittance though interface, one layer and N layers
n <- CoefMat[,2] # refractive index
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel_vectorized(r12,t12,r21,t21, x, y, trans, N[,1])
rho <- pm[[1]]
tau <- pm[[2]]
return(list(rho=rho,tau=tau))
}
MarcoDVisser/ccrtm documentation built on Feb. 19, 2025, 1:15 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions .prospectdv .prospect5v .prospectd .prospect5 prospectd prospect5
Documented in prospect5 prospectd
#' PROSPECT model version 5 and 5B
#'
#' The PROSPECT5(b) leaf reflectance model. The model was implemented based on
#' Jacquemoud and Ustin (2019), and is further described in detail in Feret et al (2008).
#' PROSPECT models use the plate models developed in
#' Allen (1969) and Stokes (1862). Set Cbrown to 0 for prospect version 5.
#'
#' @param param A named vector of PROSPECT parameters (note: program ignores case):
#'
#' \itemize{
#' \item [1] = leaf structure parameter (N)
#' \item [2] = chlorophyll a+b content in ug/cm2 (Cab)
#' \item [3] = carotenoids content in ug/cm2 (Car)
#' \item [4] = brown pigments content in arbitrary units (Cbrown)
#' \item [5] = equivalent water thickness in g/cm2 (Cw)
#' \item [6] = leaf dry matter content in g/cm2 - lma - (Cm)
#' }
#'
#' @return spectra matrix with leaf reflectance and transmission
#' for wavelengths 400 to 2500nm:
#' \itemize{
#' \item [1] = leaf reflectance (rho)
#' \item [2] = leaf transmission (tau)
#' }
#'
#' @importFrom expint expint_E1
#'
#' @examples
#' ## see ?fRTM for the typical mode of simulation
#' ## e.g. fRTM(rho~prospect5)
#'
#' ## 1) get parameters
#' defaultpars<-getDefaults(rho~prospect5)
#' ## getDefaults("prospect5") will also work
#'
#' ## 2) get leaf reflectance and transmission
#' rt<-fRTM(rho+tau~prospect5,defaultpars)
#'
#' ## lower-level implementation example
#' ## Alternatively implement directly
#' mypars<-c("N"=1,"Cab"=35,"Car"=20,"Cbrown"=3,"Cw"=0.01,"Cm"=0.01)
#' prospect5(mypars)
#'
#' @references Jacquemoud, S., and Ustin, S. (2019). Leaf optical properties.
#' Cambridge University Press.
#' @references Feret, J.B., Francois, C., Asner, G.P., Gitelson, A.A.,
#' Martin, R.E., Bidel, L.P.R., Ustin, S.L., le Maire, G., Jacquemoud, S. (2008),
#' PROSPECT-4 and 5: Advances in the leaf optical properties model separating photosynthetic
#' pigments. Remote Sens. Environ. 112, 3030-3043.
#' @references Allen W.A., Gausman H.W., Richardson A.J., Thomas J.R.
#' (1969), Interaction of isotropic ligth with a compact plant leaf,
#' Journal of the Optical Society of American, 59:1376-1379.
#' @references Stokes G.G. (1862), On the intensity of the light
#' reflected from or transmitted through a pile of plates,
#' Proceedings of the Royal Society of London, 11:545-556.
#' @useDynLib ccrtm
#' @export
prospect5 <- function(param){
## force case to lower
names(param) <- tolower(names(param))
## input paramters
N <- as.numeric(param["n"])
Cab <- as.numeric(param["cab"])
Car <- as.numeric(param["car"])
Cbrown <- as.numeric(param["cbrown"])
Cw <- as.numeric(param["cw"])
Cm <- as.numeric(param["cm"])
rhoTau <- matrix(0, 2101, 2)
CoefMat <- data_prospect5 ## get reflective and absorbtion coefficient data
l <- CoefMat[,1] # wavelength (nm)
n <- CoefMat[,2] # refractive index
## specific absorption coefficient for each element at each wl (k= total absorbtion coefficient)
alpha <- c(Cab,Car,Cbrown,Cw,Cm)/N
## k <- (Cab*CoefMat[,3]+Car*CoefMat[,4]+Cbrown*CoefMat[,5]+Cw*CoefMat[,6]+Cm*CoefMat[,7])/N;
k <- CoefMat[,-c(1:2)]%*%alpha ## 1% faster
## k[which(k==0)] <- .Machine$double.eps ## precision of zero in R
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-k)*exp(-k)+k^2*expint::expint_E1(k) ## transmittance
## the plate model
## reflectance and transmittance though interface, one layer and N layers
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel(r12,t12,r21,t21, x, y, trans, N)
rhoTau[,1] <- pm[[1]]
rhoTau[,2] <- pm[[2]]
colnames(rhoTau) <- c("rho", "tau")
return(rhoTau)
}
#' PROSPECT model version D
#'
#' The PROSPECTD leaf reflectance model. The model was implemented based on
#' Jacquemoud and Ustin (2019), and is further described in detail in Feret et al (2017).
#' PROSPECT models use the plate models developed in
#' Allen (1969) and Stokes (1862).
#'
#' @param param A named vector of PROSPECT parameters (note: program ignores case):
#' \itemize{
#' \item [1] = leaf structure parameter (N)
#' \item [2] = chlorophyll a+b content in ug/cm2 (Cab)
#' \item [3] = carotenoids content in ug/cm2 (Car)
#' \item [4] = Leaf anthocyanin content (ug/cm2) (Canth)
#' \item [5] = brown pigments content in arbitrary units (Cbrown)
#' \item [6] = equivalent water thickness in g/cm2 (Cw)
#' \item [7] = leaf dry matter content in g/cm2 - lma - (Cm)
#' }
#'
#' @return spectra matrix with leaf reflectance and transmission
#' for wavelengths 400 to 2500nm:
#' \itemize{
#' \item [1] = leaf reflectance (rho)
#' \item [2] = leaf transmission (tau)
#' }
#' @references Jacquemoud, S., and Ustin, S. (2019). Leaf optical properties.
#' Cambridge University Press.
#' @references Feret, J.B., Gitelson, A.A., Noble, S.D., Jacquemoud, S. (2017).
#' PROSPECT-D: Towards modeling leaf optical properties through a complete lifecycle.
#' Remote Sens. Environ. 193, 204-215.
#' @references Allen W.A., Gausman H.W., Richardson A.J., Thomas J.R.
#' (1969), Interaction of isotropic ligth with a compact plant leaf,
#' Journal of the Optical Society of American, 59:1376-1379.
#' @references Stokes G.G. (1862), On the intensity of the light
#' reflected from or transmitted through a pile of plates,
#' Proceedings of the Royal Society of London, 11:545-556.
#' @importFrom expint expint_E1
#' @examples
#' ## see ?fRTM for the typical mode of simulation
#' ## e.g. fRTM(rho~prospectd)
#'
#' ## 1) get parameters
#' defaultpars<-getDefaults(rho~prospectd)
#' ## getDefaults("prospectd") will also work
#'
#' ## 2) get leaf reflectance and transmission
#' rt<-fRTM(rho+tau~prospectd,defaultpars)
#'
#' ## lower-level implementation example
#' ## Alternatively implement directly (case ignored for parameters)
#' mypars<-c("N"=1,"Cab"=35,"Car"=20,"Canth"=15,"Cbrown"=3,"Cw"=0.01,"Cm"=0.01)
#' prospectd(mypars)
#' @export
#' @useDynLib ccrtm
prospectd <- function(param){
## force case to lower
names(param) <- tolower(names(param))
## input paramters
N <- as.numeric(param["n"])
Cab <- as.numeric(param["cab"])
Car <- as.numeric(param["car"])
Canth <- as.numeric(param["canth"])
Cbrown <- as.numeric(param["cbrown"])
Cw <- as.numeric(param["cw"])
Cm <- as.numeric(param["cm"])
rhoTau <- matrix(0, 2101, 2)
# CoefMat <- ccrtm:::data_prospectd ## get reflective and absorbtion coefficient data
CoefMat <- data_prospectd ## get reflective and absorbtion coefficient data
l <- CoefMat[,1] # wavelength (nm)
n <- CoefMat[,2] # refractive index
## specific absorption coefficient for each element at each wl (k= total absorbtion coefficient)
## should be able to switch this to CoefMat%*%Input
## the formula is over N as concentrations are assumed uniform over the
## leaf
k <- (Cab*CoefMat[,3]+Car*CoefMat[,4]+Canth*CoefMat[,5]+Cbrown*CoefMat[,6]+
Cw*CoefMat[,7]+Cm*CoefMat[,8])/N;
## k[which(k==0)] <- .Machine$double.eps ## precision of zero in R
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-k)*exp(-k)+k^2*expint::expint_E1(k) ## transmittance
## the plate model
## reflectance and transmittance though interface, one layer and N layers
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel(r12,t12,r21,t21, x, y, trans, N)
rhoTau[,1] <- pm[[1]]
rhoTau[,2] <- pm[[2]]
colnames(rhoTau) <- c("rho", "tau")
return(rhoTau)
}
# Low level prospect 5 implementation
.prospect5 <- function(param,
expected=c("n","cab","car","cbrown","cw","cm")){
## force case to lower
names(param) <- tolower(names(param))
## input paramters
N <- as.numeric(param[expected[1]])
Cab <- as.numeric(param[expected[2]])
Car <- as.numeric(param[expected[3]])
Cbrown <- as.numeric(param[expected[4]])
Cw <- as.numeric(param[expected[5]])
Cm <- as.numeric(param[expected[6]])
rhoTau <- matrix(0, 2101, 2)
CoefMat <- data_prospect5 ## get reflective and absorbtion coefficient data
n <- CoefMat[,2] # refractive index
alpha <- c(Cab,Car,Cbrown,Cw,Cm)/N
## k <- (Cab*CoefMat[,3]+Car*CoefMat[,4]+Cbrown*CoefMat[,5]+Cw*CoefMat[,6]+Cm*CoefMat[,7])/N;
k <- CoefMat[,-c(1:2)]%*%alpha ## 1% faster
## k[which(k==0)] <- .Machine$double.eps ## precision of zero in R
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-k)*exp(-k)+k^2*expint::expint_E1(k) ## transmittance
## the plate model
## reflectance and transmittance though interface, one layer and N layers
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel(r12,t12,r21,t21, x, y, trans, N)
rhoTau[,1] <- pm[[1]]
rhoTau[,2] <- pm[[2]]
colnames(rhoTau) <- c("rho", "tau")
return(rhoTau)
}
# Low level prospect D implementation
.prospectd <- function(param,
expected=c("n","cab","car",
"canth","cbrown","cw","cm")){
## force case to lower
names(param) <- tolower(names(param))
## input paramters
N <- as.numeric(param[expected[1]])
Cab <- as.numeric(param[expected[2]])
Car <- as.numeric(param[expected[3]])
Canth <- as.numeric(param[expected[4]])
Cbrown <- as.numeric(param[expected[5]])
Cw <- as.numeric(param[expected[6]])
Cm <- as.numeric(param[expected[7]])
rhoTau <- matrix(0, 2101, 2)
CoefMat <- data_prospectd ## get reflective and absorbtion coefficient data
n <- CoefMat[,2] # refractive index
## specific absorption coefficient for each element at each wl (k= total absorbtion coefficient)
alpha <- c(Cab,Car,Canth,Cbrown,Cw,Cm)/N
k <- CoefMat[,-c(1:2)]%*%alpha ## 1% faster
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-k)*exp(-k)+k^2*expint::expint_E1(k) ## transmittance
## the plate model
## reflectance and transmittance though interface, one layer and N layers
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel(r12,t12,r21,t21, x, y, trans, N)
rhoTau[,1] <- pm[[1]]
rhoTau[,2] <- pm[[2]]
colnames(rhoTau) <- c("rho", "tau")
return(rhoTau)
}
## Low level vectorized prospect 5 implementation
## param is expected to be a matrix
.prospect5v <- function(param){
## expected parameters and order
expected <- c("n","cab","car","cbrown","cw","cm")
CoefMat <- ccrtm:::data_prospect5 ## get reflective and absorbtion coefficient data
## force to all to lowercase
colnames(param) <- tolower(colnames(param))
colnames(CoefMat) <- tolower(colnames(CoefMat))
## input paramters
l <- CoefMat[,"l"] ## wavelength
N <- matrix(rep(as.numeric(param[,"n"]),length(l)),byrow=FALSE,ncol=length(l)) ## N matrix
## prepare matrices
Input <- param[,which(colnames(param)!="n")] ## input matrix
Input <- Input[,expected[-1]] ## enforce order
k_i_mat <- t(CoefMat[,expected[-1]]) ## absorbtion k_i
## n x k . k x l = n x l
kmat <- (Input %*% k_i_mat)/N
## k[which(k==0)] <- .Machine$double.eps ## precision of zero in R
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-kmat)*exp(-kmat)+kmat^2*expint::expint_E1(kmat) ## transmittance
## next run it through the plate model
## the plate model
## reflectance and transmittance though interface, one layer and N layers
n <- CoefMat[,2] # refractive index
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel_vectorized(r12,t12,r21,t21, x, y, trans, N[,1])
rho <- pm[[1]]
tau <- pm[[2]]
return(list(rho=rho,tau=tau))
}
## Low level vectorized prospect D implementation
## param is expected to be a matrix
.prospectdv <- function(param){
CoefMat <- ccrtm:::data_prospectd ## get reflective and absorbtion coefficient data
## force to all to lowercase
colnames(param) <- tolower(colnames(param))
colnames(CoefMat) <- tolower(colnames(CoefMat))
## input paramters
l <- CoefMat[,"l"] ## wavelength
N <- matrix(rep(as.numeric(param[,"n"]),length(l)),byrow=FALSE,ncol=length(l)) ## N matrix
## prepare matrices
Input <- param[,which(colnames(param)!="n")] ## input matrix
Input <- Input[,c("cab","car","canth","cbrown","cw","cm")] ## enforce order
k_i_mat <- t(CoefMat[,c("cab","car","canth","cbrown","cw","cm")]) ## absorbtion k_i
## n x k . k x l = n x l
kmat <- (Input %*% k_i_mat)/N
## k[which(k==0)] <- .Machine$double.eps ## precision of zero in R
## using expint::expint_E1 instead of pracma::expint due to performance
## test
trans <- (1-kmat)*exp(-kmat)+kmat^2*expint::expint_E1(kmat) ## transmittance
## next run it through the plate model
## the plate model
## reflectance and transmittance though interface, one layer and N layers
n <- CoefMat[,2] # refractive index
alpha <- 40
t12 <- ctav(alpha,n) ## Transmission of isotropic light from 40degrees
tav90n <- ctav(90,n)
t21 <- tav90n/n^2 ## 90degrees
r12 <- 1-t12
r21 <- 1-t21
x <- t12/tav90n
y <- x*(tav90n-1)+1-t12
pm <- cplateModel_vectorized(r12,t12,r21,t21, x, y, trans, N[,1])
rho <- pm[[1]]
tau <- pm[[2]]
return(list(rho=rho,tau=tau))
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.