Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Rpackages
IDF
Commits
5212b6cd
Commit
5212b6cd
authored
May 10, 2019
by
Jana Ulrich
Browse files
changed gev.d.diag legend
parent
10d6852a
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
52 additions
and
58 deletions
+52
-58
.Rhistory
.Rhistory
+0
-36
.gitignore
.gitignore
+6
-0
IDF.Rproj
IDF.Rproj
+17
-0
NAMESPACE
NAMESPACE
+1
-1
R/IDF.R
R/IDF.R
+20
-15
R/gevdfit.R
R/gevdfit.R
+3
-3
man/IDF.agg.Rd
man/IDF.agg.Rd
+5
-3
No files found.
.Rhistory
View file @
5212b6cd
(
requireNamespace
(
'IDF'
,
quietly
=
TRUE
))
?
IDF.short
IDF.short
(
int.vec
=
test.data
,
durs
=
rep
(
c
(
1
,
2
,
3
),
each
=
100
),
n.y
=
100
)
install.packages
(
"~/Downloads/IDF-covariates-6c1b09f1f9fc97a0b518b9ae025ba535095f63ea.tar.gz"
,
repos
=
NULL
,
type
=
"source"
)
library
(
ismev
)
library
(
IDF
)
test.data
<-
matrix
(
NA
,
ncol
=
3
,
nrow
=
100
)
for
(
i
in
1
:
3
)
test.data
[,
i
]
<-
rgev.d
(
n
=
100
,
d
=
i
)
test.data
<-
as.vector
(
test.data
)
?
rgev.d
for
(
i
in
1
:
3
)
test.data
[,
i
]
<-
rgev.d
(
n
=
100
,
d
=
i
)
?
rgev.d
?
rgev
?
IDF.agg
IDF.agg
(
test.data
,
agg.lev
=
c
(
1
,
2
,
3
))
detach
(
"package:IDF"
,
unload
=
TRUE
)
remove.packages
(
"IDF"
,
lib
=
"~/R/x86_64-pc-linux-gnu-library/3.3"
)
library
(
IDF
)
install.packages
(
"~/Downloads/IDF-covariates-6c1b09f1f9fc97a0b518b9ae025ba535095f63ea.tar.gz"
,
repos
=
NULL
,
type
=
"source"
)
library
(
IDF
)
IDF.agg
(
test.data
,
agg.lev
=
c
(
1
,
2
,
3
))
detach
(
"package:IDF"
,
unload
=
TRUE
)
remove.packages
(
"IDF"
,
lib
=
"~/R/x86_64-pc-linux-gnu-library/3.3"
)
library
(
IDF
)
install.packages
(
"~/Downloads/IDF-covariates-6c1b09f1f9fc97a0b518b9ae025ba535095f63ea(1).tar.gz"
,
repos
=
NULL
,
type
=
"source"
)
library
(
ismev
)
library
(
IDF
)
IDF.agg
(
test.data
,
agg.lev
=
c
(
1
,
2
,
3
))
?
IDF.short
detach
(
"package:IDF"
,
unload
=
TRUE
)
remove.packages
(
"IDF"
,
lib
=
"~/R/x86_64-pc-linux-gnu-library/3.3"
)
?
IDF.short
?
install.packages
devtools
::
install_git
(
'https://gitlab.met.fu-berlin.de/Rpackages/IDF/tree/covariates'
)
devtools
::
install_git
(
'https://gitlab.met.fu-berlin.de/Rpackages/IDF'
)
devtools
::
install_git
(
'https://gitlab.met.fu-berlin.de/Rpackages/IDF/tree/covariates.git'
)
.gitignore
0 → 100644
View file @
5212b6cd
.Rproj.user
.Rhistory
.RData
.Ruserdata
.Rbuildignore
.Rproj
IDF.Rproj
0 → 100644
View file @
5212b6cd
Version: 1.0
RestoreWorkspace: Default
SaveWorkspace: Default
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: Sweave
LaTeX: pdfLaTeX
BuildType: Package
PackageUseDevtools: Yes
PackageInstallArgs: --no-multiarch --with-keep.source
NAMESPACE
View file @
5212b6cd
...
...
@@ -25,7 +25,7 @@ importFrom(graphics,plot)
importFrom(graphics,points)
importFrom(graphics,title)
importFrom(ismev,gev.fit)
importFrom(pbapply,pb
l
apply)
importFrom(pbapply,pb
s
apply)
importFrom(stats,lm)
importFrom(stats,optim)
importFrom(zoo,rollapply)
R/IDF.R
View file @
5212b6cd
...
...
@@ -16,6 +16,7 @@
#' standard date format.
#' @param ds numeric vector of aggregation durations.
#' (Must be multiples of time resolution at all stations.)
#' @param na.accept numeric giving maximum number of missing values for which annual max. should still be calculated
#' @param which.stations optional, subset of stations. Either numeric vector or character vector
#' containing names of elements in data. If not given, all elements in `data` will be used.
#' @param which.mon optional, subset of months of which to calculate the annual maxima from.
...
...
@@ -26,13 +27,13 @@
#' different durations, IDF.agg needs to be run seperately for the different groups of stations.
#' Afterwards he results can be joint together using `rbind`.
#'
#' @return data.frame containing the annual
maxima
in `$xdat`, the corresponding duration in `$ds`
#' @return data.frame containing the annual
intensity maxima [mm/h]
in `$xdat`, the corresponding duration in `$ds`
#' and the station id or name in `$station`.
#'
#' @seealso \code{\link{pgev.d}}
#'
#' @export
#' @importFrom pbapply pb
l
apply
#' @importFrom pbapply pb
s
apply
#' @importFrom zoo rollapply
#'
#' @examples
...
...
@@ -46,17 +47,19 @@
#'## 2 0.4112304 24 1
#'## 3 0.1650978 48 1
#'## 4 0.2356849 48 1
IDF.agg
<-
function
(
data
,
ds
,
which.stations
=
NULL
,
which.mon
=
0
:
11
,
names
=
c
(
'date'
,
'RR'
),
cl
=
NULL
){
IDF.agg
<-
function
(
data
,
ds
,
na.accept
=
0
,
which.stations
=
NULL
,
which.mon
=
0
:
11
,
names
=
c
(
'date'
,
'RR'
),
cl
=
NULL
){
if
(
!
inherits
(
data
,
"list"
))
stop
(
"Argument 'data' must be a list, instead it is a: "
,
class
(
data
))
# function 2: aggregate station data over durations and find annual maxima:
agg.station
<-
function
(
station
){
data.s
<-
data
[[
station
]]
if
(
!
is.data.frame
(
data.s
)){
stop
(
"Elements of 'data' must be data.frames. But element "
,
station
,
" contains: "
,
class
(
data.s
))}
,
station
,
" contains: "
,
class
(
data.s
))}
if
(
sum
(
is.element
(
names
[
1
:
2
],
names
(
data.s
)))
!=
2
){
stop
(
'Dataframe of station '
,
station
,
' does not contain $'
,
names
[
1
]
,
' or $'
,
names
[
2
],
'.'
)}
,
' does not contain $'
,
names
[
1
]
,
' or $'
,
names
[
2
],
'.'
)}
dtime
<-
as.numeric
((
data.s
[,
names
[
1
]][
2
]
-
data.s
[,
names
[
1
]][
1
]),
units
=
"hours"
)
if
(
any
(
ds
%%
dtime
!=
0
)){
...
...
@@ -65,14 +68,18 @@ IDF.agg <- function(data,ds,which.stations = NULL,which.mon = 0:11,names = c('da
# function 1: aggregate over single durations and find annual maxima:
agg.ts
<-
function
(
ds
){
runmean
<-
rollapply
(
data.s
[,
names
[
2
]],
ds
/
dtime
,
FUN
=
sum
,
fill
=
NA
,
align
=
'right'
,
na.rm
=
TRUE
)
runmean
<-
rollapply
(
data.s
[,
names
[
2
]],
ds
/
dtime
,
FUN
=
sum
,
fill
=
NA
,
align
=
'right'
)
runmean
<-
runmean
/
ds
#intensity per hour
subset
<-
is.element
(
as.POSIXlt
(
data.s
[,
names
[
1
]])
$
mon
,
which.mon
)
max
<-
tapply
(
runmean
[
subset
],(
as.POSIXlt
(
data.s
[,
names
[
1
]])
$
year
+1900
)[
subset
],
max
,
na.rm
=
T
)
max
<-
tapply
(
runmean
[
subset
],(
as.POSIXlt
(
data.s
[,
names
[
1
]])
$
year
+1900
)[
subset
],
function
(
vec
){
n.na
<-
sum
(
is.na
(
vec
))
max
<-
ifelse
(
n.na
<=
na.accept
,
max
(
vec
,
na.rm
=
TRUE
),
NA
)
return
(
max
)})
return
(
max
)
# maxima for single durations
}
# call function 1 in lapply to aggregate over all durations at single station
data.agg
<-
sapply
(
ds
,
agg.ts
,
simplify
=
TRUE
)
data.agg
<-
pb
sapply
(
ds
,
agg.ts
,
simplify
=
TRUE
,
cl
=
cl
)
df
<-
data.frame
(
xdat
=
as.vector
(
data.agg
),
ds
=
rep
(
ds
,
each
=
length
(
data.agg
[,
1
])))
df
$
station
<-
rep
(
station
,
length
(
df
$
xdat
))
...
...
@@ -81,12 +88,11 @@ IDF.agg <- function(data,ds,which.stations = NULL,which.mon = 0:11,names = c('da
# which stations should be used?
if
(
is.null
(
which.stations
))
which.stations
<-
1
:
length
(
data
)
# call function 2 in lapply to aggregate over all durations at all stations
station.list
<-
pb
lapply
(
which.stations
,
agg.station
,
cl
=
cl
)
station.list
<-
lapply
(
which.stations
,
agg.station
)
return
(
do.call
(
'rbind'
,
station.list
))
}
#### IDF.plot ####
...
...
@@ -163,6 +169,5 @@ IDF.plot <- function(data,fitparams,probs=c(0.5,0.9,0.99),calc.dur=NULL,
if
(
legend
){
## plot legend
legend
(
x
=
"topright"
,
title
=
st.name
,
legend
=
c
(
dt.name
,
paste
(
probs
,
"quantile"
,
sep
=
" "
)),
col
=
c
(
rgb
(
0
,
0
,
0
,
0.5
),
cols
),
lty
=
c
(
NA
,
rep
(
lty
,
length
(
probs
))),
pch
=
c
(
pch
,
rep
(
NA
,
length
(
probs
))),
lwd
=
c
(
NA
,
rep
(
lwd
,
length
(
probs
))))
}
pch
=
c
(
pch
,
rep
(
NA
,
length
(
probs
))),
lwd
=
c
(
NA
,
rep
(
lwd
,
length
(
probs
))))}
}
R/gevdfit.R
View file @
5212b6cd
...
...
@@ -306,7 +306,7 @@ gev.d.diag <- function(fit,subset=NULL,cols=NULL,pch=NULL,which='both',mfrow=c(1
title
=
c
(
'Residual Probability Plot'
,
'Residual Quantile Plot'
),
emp.lab
=
'Empirical'
,
mod.lab
=
'Model'
,
...
){
# check parameter:
if
(
!
is.element
(
which
,
c
(
'both'
,
'pp'
,
'qq'
)))
stop
(
"Parameter
`
which
`
= "
,
which
,
if
(
!
is.element
(
which
,
c
(
'both'
,
'pp'
,
'qq'
)))
stop
(
"Parameter
'
which
'
= "
,
which
,
" but only 'both','pp' or 'qq' are allowed."
)
# subset data
df
<-
data.frame
(
data
=
fit
$
data
,
ds
=
fit
$
ds
)
...
...
@@ -335,7 +335,7 @@ gev.d.diag <- function(fit,subset=NULL,cols=NULL,pch=NULL,which='both',mfrow=c(1
emp.lab
,
ylab
=
mod.lab
,
col
=
cols
[
df
$
cval
],
pch
=
pch
,
...
)
abline
(
0
,
1
,
col
=
1
,
lwd
=
1
)
title
(
title
[
1
])
if
(
legend
){
legend
(
'bottomright'
,
legend
=
durs
,
pch
=
pch
,
if
(
legend
){
legend
(
'bottomright'
,
legend
=
round
(
durs
,
digits
=
2
)
,
pch
=
pch
,
col
=
cols
[
1
:
length
(
durs
)],
title
=
'Durations'
,
ncol
=
2
)}
}
if
(
which
==
'both'
|
which
==
'qq'
){
...
...
@@ -344,7 +344,7 @@ gev.d.diag <- function(fit,subset=NULL,cols=NULL,pch=NULL,which='both',mfrow=c(1
emp.lab
,
xlab
=
mod.lab
,
col
=
cols
[
df
$
cval
],
pch
=
pch
,
...
)
abline
(
0
,
1
,
col
=
1
,
lwd
=
1
)
title
(
title
[
2
])
if
(
legend
){
legend
(
'bottomright'
,
legend
=
durs
,
pch
=
pch
,
if
(
legend
){
legend
(
'bottomright'
,
legend
=
round
(
durs
,
digits
=
2
)
,
pch
=
pch
,
col
=
cols
[
1
:
length
(
durs
)],
title
=
'Durations'
,
ncol
=
2
)}
}
if
(
which
==
'both'
)
par
(
mfrow
=
c
(
1
,
1
))
# reset par
...
...
man/IDF.agg.Rd
View file @
5212b6cd
...
...
@@ -4,8 +4,8 @@
\alias{IDF.agg}
\title{Aggregation and annual maxima for choosen durations}
\usage{
IDF.agg(data, ds, which.stations = NULL,
which.mon = 0:11,
names = c("date", "RR"), cl = NULL)
IDF.agg(data, ds,
na.accept = 0,
which.stations = NULL,
which.mon = 0:11,
names = c("date", "RR"), cl = NULL)
}
\arguments{
\item{data}{list of data.frames containing time series for every station.
...
...
@@ -16,6 +16,8 @@ standard date format.}
\item{ds}{numeric vector of aggregation durations.
(Must be multiples of time resolution at all stations.)}
\item{na.accept}{numeric giving maximum number of missing values for which annual max. should still be calculated}
\item{which.stations}{optional, subset of stations. Either numeric vector or character vector
containing names of elements in data. If not given, all elements in `data` will be used.}
...
...
@@ -26,7 +28,7 @@ containing names of elements in data. If not given, all elements in `data` will
\item{cl}{optional, number of cores to be used from \code{\link[pbapply]{pblapply}} for parallelization.}
}
\value{
data.frame containing the annual
maxima
in `$xdat`, the corresponding duration in `$ds`
data.frame containing the annual
intensity maxima [mm/h]
in `$xdat`, the corresponding duration in `$ds`
and the station id or name in `$station`.
}
\description{
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment