Commit f8c6440b authored by Felix Fauer's avatar Felix Fauer
Browse files

final commit with tau.

parent e45462f3
......@@ -263,26 +263,3 @@ IDF.plot <- function(durations,fitparams,probs=c(0.5,0.9,0.99),
col=cols,lty=lty,lwd=lwd)
}
}
#### IDF.plot.fit ####
#' This is a faster usable version of \code{\link{IDF.plot}}. The only argument needed is a fit object returned by \code{\link{gev.d.fit}}
#'
#' @param fit A fit object returned by \code{\link{gev.d.fit}}
#' @param ... Options to be passed to \code{\link{IDF.plot}}
#' @export
#' @importFrom
#' @example
#' #' data('example',package = 'IDF')
#' # fit d-gev
#' fit <- gev.d.fit(example$dat,example$d,ydat = as.matrix(example[,c("cov1","cov2")])
#' ,mutl = c(1,2),sigma0l = 1)
#' # plot quantiles
#' IDF.plot.fit(fit)
#' # add data points
#' points(example[example$cov1==1,]$d,example[example$cov1==1,]$dat)
IDF.plot.fit <- function(fit){
fitted_params=gev.d.params(fit,...)
ds = fit$ds
IDF.plot(ds, fitted_params,...)
}
\ No newline at end of file
......@@ -27,18 +27,18 @@
#' @examples
#' x <- seq(4,20,0.1)
#' # calculate probability density for one duration
#' dgev.d(q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1,tau=0.1,d=1)
#' dgev.d(q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1,d=1)
#'
#' # calculate probability density for different durations
#' ds <- 1:4
#' dens <- lapply(ds,dgev.d,q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1, tau=0.1)
#' dens <- lapply(ds,dgev.d,q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1)
#'
#' plot(x,dens[[1]],type='l',ylim = c(0,0.21),ylab = 'Probability Density')
#' for(i in 2:4){
#' lines(x,dens[[i]],lty=i)
#' }
#' legend('topright',title = 'Duration',legend = 1:4,lty=1:4)
dgev.d <- function(q,mut,sigma0,xi,theta,eta,tau,d,...) {
dgev.d <- function(q,mut,sigma0,xi,theta,eta,d,tau=0,...) {
if(any(c(length(mut),length(sigma0),length(xi),length(theta),length(eta), length(tau))>1)){
message('One of the parameters mut, sigma0, xi, theta, eta, tau is a vector. ',
'This is not intended and might cause an error.')}
......@@ -84,8 +84,8 @@ dgev.d <- function(q,mut,sigma0,xi,theta,eta,tau,d,...) {
#'
#' @examples
#' x <- seq(4,20,0.1)
#' prob <- pgev.d(q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1,tau=0.1,d=1)
pgev.d <- function(q,mut,sigma0,xi,theta,eta,tau,d,...) {
#' prob <- pgev.d(q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1,d=1)
pgev.d <- function(q,mut,sigma0,xi,theta,eta,tau=0,d, ...) {
if(any(c(length(mut),length(sigma0),length(xi),length(theta),length(eta),length(tau))>1)){
message('One of the parameters mut, sigma0, xi, theta, eta, tau is a vector. ',
'This is not intended and might cause an error.')}
......@@ -132,11 +132,11 @@ pgev.d <- function(q,mut,sigma0,xi,theta,eta,tau,d,...) {
#' @examples
#' p <- c(0.5,0.9,0.99)
#' # calulate quantiles for one duration
#' qgev.d(p=p,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3, tau=0.1,d=1)
#' qgev.d(p=p,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3, d=1)
#'
#' # calculate quantiles for sequence of durations
#' ds <- 2^seq(0,4,0.1)
#' qs <- lapply(ds,qgev.d,p=p,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3, tau=0.1)
#' qs <- lapply(ds,qgev.d,p=p,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3)
#' qs <- simplify2array(qs)
#'
#' plot(ds,qs[1,],ylim=c(3,20),type='l',log = 'xy',ylab='Intensity',xlab = 'Duration')
......@@ -145,7 +145,7 @@ pgev.d <- function(q,mut,sigma0,xi,theta,eta,tau,d,...) {
#' }
#' legend('topright',title = 'p-quantile',
#' legend = p,lty=1:3,bty = 'n')
qgev.d <- function(p,mut,sigma0,xi,theta,eta,tau,d, ...) {
qgev.d <- function(p,mut,sigma0,xi,theta,eta,d,tau=0, ...) {
if(any(c(length(mut),length(sigma0),length(xi),length(theta),length(eta), length(tau))>1)){
message('One of the parameters mut, sigma0, xi, theta, eta is a vector. ',
'This is not intended and might cause an error.')}
......@@ -187,18 +187,18 @@ qgev.d <- function(p,mut,sigma0,xi,theta,eta,tau,d, ...) {
#'
#' @examples
#' # random sample for one duration
#' rgev.d(n=100,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3,tau=0.1,d=1)
#' rgev.d(n=100,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3,d=1)
#'
#' # compare randomn samples for different durations
#' ds <- c(1,4)
#' samp <- lapply(ds,rgev.d,n=100,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3,tau=0.1)
#' samp <- lapply(ds,rgev.d,n=100,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3)
#'
#' hist(samp[[1]],breaks = 10,col=rgb(1,0,0,0.5),freq = FALSE
#' ,ylim=c(0,0.3),xlim=c(3,20),xlab='x',main = 'Random d-GEV samples')
#' hist(samp[[2]],breaks = 10,add=TRUE,col=rgb(0,0,1,0.5),freq = FALSE)
#' legend('topright',fill = c(rgb(1,0,0,0.5),rgb(0,0,1,0.5)),
#' legend = paste('d=',1:2,'h'),title = 'Duration')
rgev.d <- function(n,mut,sigma0,xi,theta,eta,tau,d) {
rgev.d <- function(n,mut,sigma0,xi,theta,eta,d,tau=0) {
if(any(c(length(mut),length(sigma0),length(xi),length(theta),length(eta),length(tau))>1)){
message('One of the parameters mut, sigma0, xi, theta, eta, tau is a vector. ',
'This is not intended and might cause an error.')}
......
......@@ -387,8 +387,8 @@ gev.d.init <- function(xdat,ds,link){
#' ,ydat = as.matrix(train.set[c('cov1','cov2')]))
#' params <- gev.d.params(fit,ydat = as.matrix(test.set[c('cov1','cov2')]))
#' gev.d.lik(xdat = test.set$dat,ds = test.set$d,mut = params[,1],sigma0 = params[,2],xi = params[,3]
#' ,theta = params[,4],eta = params[,5],tau=params[,6],log=TRUE)
gev.d.lik <- function(xdat,ds,mut,sigma0,xi,theta,eta,tau,log=FALSE) {
#' ,theta = params[,4],eta = params[,5],log=TRUE)
gev.d.lik <- function(xdat,ds,mut,sigma0,xi,theta,eta,log=FALSE,tau=0) {
if(any(xi==0)){stop('Function is not defined for shape parameter of zero.')}
if(any(! c(length(ds),length(mut),length(sigma0),length(xi),length(theta),length(eta),length(tau)) %in%
c(1,length(xdat)))){
......
......@@ -4,7 +4,7 @@
\alias{dgev.d}
\title{d-GEV probability density function}
\usage{
dgev.d(q, mut, sigma0, xi, theta, eta, tau, d, ...)
dgev.d(q, mut, sigma0, xi, theta, eta, d, tau = 0, ...)
}
\arguments{
\item{q}{vector of quantiles}
......@@ -16,10 +16,10 @@ shape parameter \eqn{\xi}.}
\item{eta}{numeric value, giving duration exponent \eqn{\eta} (defining slope of the IDF curve)}
\item{tau}{numeric value, giving intensity offset \eqn{\tau} (defining flattening of the IDF curve)}
\item{d}{positive numeric value, giving duration}
\item{tau}{numeric value, giving intensity offset \eqn{\tau} (defining flattening of the IDF curve)}
\item{...}{additional parameters passed to \code{\link[evd]{dgev}}}
}
\value{
......@@ -35,11 +35,11 @@ For details on the d-GEV and the parameter definitions, see \link{IDF-package}.
\examples{
x <- seq(4,20,0.1)
# calculate probability density for one duration
dgev.d(q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1,tau=0.1,d=1)
dgev.d(q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1,d=1)
# calculate probability density for different durations
ds <- 1:4
dens <- lapply(ds,dgev.d,q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1, tau=0.1)
dens <- lapply(ds,dgev.d,q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1)
plot(x,dens[[1]],type='l',ylim = c(0,0.21),ylab = 'Probability Density')
for(i in 2:4){
......
......@@ -4,7 +4,7 @@
\alias{gev.d.lik}
\title{d-GEV Likelihood}
\usage{
gev.d.lik(xdat, ds, mut, sigma0, xi, theta, eta, tau, log = FALSE)
gev.d.lik(xdat, ds, mut, sigma0, xi, theta, eta, log = FALSE, tau = NULL)
}
\arguments{
\item{xdat}{numeric vector containing observations}
......@@ -29,5 +29,5 @@ fit <- gev.d.fit(train.set$dat,train.set$d,mutl = c(1,2),sigma0l = 1
,ydat = as.matrix(train.set[c('cov1','cov2')]))
params <- gev.d.params(fit,ydat = as.matrix(test.set[c('cov1','cov2')]))
gev.d.lik(xdat = test.set$dat,ds = test.set$d,mut = params[,1],sigma0 = params[,2],xi = params[,3]
,theta = params[,4],eta = params[,5],tau=params[,6],log=TRUE)
,theta = params[,4],eta = params[,5],log=TRUE)
}
......@@ -4,7 +4,7 @@
\alias{pgev.d}
\title{d-GEV cumulative distribution function}
\usage{
pgev.d(q, mut, sigma0, xi, theta, eta, tau, d, ...)
pgev.d(q, mut, sigma0, xi, theta, eta, tau = NULL, d, ...)
}
\arguments{
\item{q}{vector of quantiles}
......@@ -39,7 +39,7 @@ For details on the d-GEV and the parameter definitions, see \link{IDF-package}.
}
\examples{
x <- seq(4,20,0.1)
prob <- pgev.d(q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1,tau=0.1,d=1)
prob <- pgev.d(q=x,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.1,d=1)
}
\seealso{
\code{\link{dgev.d}}, \code{\link{qgev.d}}, \code{\link{rgev.d}}
......
......@@ -4,7 +4,7 @@
\alias{qgev.d}
\title{d-GEV quantile function}
\usage{
qgev.d(p, mut, sigma0, xi, theta, eta, tau, d, ...)
qgev.d(p, mut, sigma0, xi, theta, eta, d, tau = NULL, ...)
}
\arguments{
\item{p}{vector of probabilities}
......@@ -15,10 +15,10 @@ qgev.d(p, mut, sigma0, xi, theta, eta, tau, d, ...)
\item{eta}{numeric value, giving duration exponent (defining slope of the IDF curve)}
\item{tau}{numeric value, giving intensity offset (defining flattening of the IDF curve for long durations)}
\item{d}{positive numeric value, giving duration}
\item{tau}{numeric value, giving intensity offset (defining flattening of the IDF curve for long durations)}
\item{...}{additional parameters passed to \code{\link[evd]{qgev}}}
}
\value{
......@@ -40,11 +40,11 @@ For details on the d-GEV and the parameter definitions, see \link{IDF-package}.
\examples{
p <- c(0.5,0.9,0.99)
# calulate quantiles for one duration
qgev.d(p=p,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3, tau=0.1,d=1)
qgev.d(p=p,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3, d=1)
# calculate quantiles for sequence of durations
ds <- 2^seq(0,4,0.1)
qs <- lapply(ds,qgev.d,p=p,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3, tau=0.1)
qs <- lapply(ds,qgev.d,p=p,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3)
qs <- simplify2array(qs)
plot(ds,qs[1,],ylim=c(3,20),type='l',log = 'xy',ylab='Intensity',xlab = 'Duration')
......
......@@ -4,7 +4,7 @@
\alias{rgev.d}
\title{Generation of random variables from d-GEV}
\usage{
rgev.d(n, mut, sigma0, xi, theta, eta, tau, d)
rgev.d(n, mut, sigma0, xi, theta, eta, d, tau = NULL)
}
\arguments{
\item{n}{number of random variables per duration}
......@@ -15,9 +15,9 @@ rgev.d(n, mut, sigma0, xi, theta, eta, tau, d)
\item{eta}{numeric value, giving duration exponent (defining slope of the IDF curve)}
\item{tau}{numeric value, giving intensity offset (defining flattening of the IDF curve)}
\item{d}{positive numeric value, giving duration}
\item{tau}{numeric value, giving intensity offset (defining flattening of the IDF curve)}
}
\value{
list containing vectors of random variables.
......@@ -32,11 +32,11 @@ For details on the d-GEV and the parameter definitions, see \link{IDF-package}
}
\examples{
# random sample for one duration
rgev.d(n=100,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3,tau=0.1,d=1)
rgev.d(n=100,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3,d=1)
# compare randomn samples for different durations
ds <- c(1,4)
samp <- lapply(ds,rgev.d,n=100,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3,tau=0.1)
samp <- lapply(ds,rgev.d,n=100,mut=4,sigma0=2,xi=0,theta=0.1,eta=0.3)
hist(samp[[1]],breaks = 10,col=rgb(1,0,0,0.5),freq = FALSE
,ylim=c(0,0.3),xlim=c(3,20),xlab='x',main = 'Random d-GEV samples')
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment