[spcopula-commits] r138 - / pkg pkg/R pkg/demo pkg/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Oct 1 11:31:42 CEST 2014
Author: ben_graeler
Date: 2014-10-01 11:31:41 +0200 (Wed, 01 Oct 2014)
New Revision: 138
Added:
pkg/man/EU_RB_2005.Rd
rgl_sections.R
Modified:
pkg/DESCRIPTION
pkg/R/utilities.R
pkg/demo/pureSpVineCopula.R
pkg/man/dependencePlot.Rd
Log:
- allow for non-uniform margins in the dependencePlot
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2014-09-19 11:15:54 UTC (rev 137)
+++ pkg/DESCRIPTION 2014-10-01 09:31:41 UTC (rev 138)
@@ -2,7 +2,7 @@
Type: Package
Title: copula driven spatial analysis
Version: 0.2-1
-Date: 2014-09-19
+Date: 2014-10-01
Authors at R: c(person("Benedikt", "Graeler", role = c("aut", "cre"),
email = "ben.graeler at uni-muenster.de"),
person("Marius", "Appel",role = "ctb"))
Modified: pkg/R/utilities.R
===================================================================
--- pkg/R/utilities.R 2014-09-19 11:15:54 UTC (rev 137)
+++ pkg/R/utilities.R 2014-10-01 09:31:41 UTC (rev 138)
@@ -19,7 +19,7 @@
##
dependencePlot <- function(var=NULL, smpl, bandwidth=0.075,
main="Stength of dependence",
- transformation=function (x) x, ...) {
+ transformation=function (x) x, margin=NULL, ...) {
if(is.null(var)) {
if (ncol(smpl)>2) {
smpl <- smpl[,1:2]
@@ -28,9 +28,13 @@
smpl <- smpl[,var]
}
- smoothScatter(smpl,bandwidth=bandwidth, asp=1, xlim=c(0,1), ylim=c(0,1),
- nrpoints=0, main=main,
- transformation=transformation, ...)
+ if(is.null(margin))
+ smoothScatter(smpl,bandwidth=bandwidth, asp=1, xlim=c(0,1), ylim=c(0,1),
+ nrpoints=0, main=main,
+ transformation=transformation, ...)
+ else
+ smoothScatter(margin(smpl), bandwidth=bandwidth, asp=1,
+ nrpoints=0, main=main, ...)
}
##
Modified: pkg/demo/pureSpVineCopula.R
===================================================================
--- pkg/demo/pureSpVineCopula.R 2014-09-19 11:15:54 UTC (rev 137)
+++ pkg/demo/pureSpVineCopula.R 2014-10-01 09:31:41 UTC (rev 138)
@@ -28,10 +28,11 @@
# dMar <- function(x) dgev(x, gevEsti[1], gevEsti[2], gevEsti[3])
meuse$rtZinc <- rank(meuse$zinc)/(length(meuse)+1)
-
+hist(meuse$rtZinc)
## lag classes ##
bins <- calcBins(meuse,var="rtZinc", nbins=10, cutoff=800)
+
## calculate parameters for Kendall's tau function ##
calcKTau <- fitCorFun(bins, degree=2)
curve(calcKTau,0, 1000, col="purple",add=T)
Added: pkg/man/EU_RB_2005.Rd
===================================================================
--- pkg/man/EU_RB_2005.Rd (rev 0)
+++ pkg/man/EU_RB_2005.Rd 2014-10-01 09:31:41 UTC (rev 138)
@@ -0,0 +1,62 @@
+\name{EU_RB_2005}
+\alias{EU_RB_2005}
+\docType{data}
+\title{
+Daily mean PM10 concentrations over Europe in 2005 as used in the JSS manuscript
+}
+\description{
+Daily mean PM10 concentrations over Europe in 2005 as used in the JSS manuscript
+}
+\usage{data("EU_RB_2005")}
+\format{
+ The format is:
+Formal class 'STFDF' [package "spacetime"] with 4 slots
+ ..@ data :'data.frame': 70810 obs. of 3 variables:
+ .. ..$ PM10 : num [1:70810] 28 7 11.9 12.9 14.6 30 31.1 8.4 37.8 37.8 ...
+ .. ..$ EMEP : num [1:70810] 6.36 4.13 5.84 4.93 5.86 ...
+ .. ..$ logResidKrige: num [1:70810] 12.8 12.4 10.6 11.6 17.1 ...
+ ..@ sp :Formal class 'SpatialPointsDataFrame' [package "sp"] with 5 slots
+ .. .. ..@ data :'data.frame': 194 obs. of 8 variables:
+ .. .. .. ..$ station_altitude : int [1:194] 525 581 918 560 172 117 665 1137 330 330 ...
+ .. .. .. ..$ station_european_code: Factor w/ 7734 levels "AD0942A","AD0944A",..: 12 61 112 69 73 14 194 184 23 25 ...
+ .. .. .. ..$ country_iso_code : Factor w/ 39 levels "AD","AL","AT",..: 3 3 3 3 3 3 3 3 3 3 ...
+ .. .. .. ..$ station_start_date : Factor w/ 2344 levels "1900-01-01","1951-04-01",..: 1117 377 296 411 649 134 658 429 672 684 ...
+ .. .. .. ..$ station_end_date : Factor w/ 811 levels "","1900-01-01",..: 1 1 1 1 1 1 1 1 1 736 ...
+ .. .. .. ..$ type_of_station : Factor w/ 5 levels "","Background",..: 2 2 2 2 2 2 2 2 2 2 ...
+ .. .. .. ..$ station_type_of_area : Factor w/ 5 levels "","rural","suburban",..: 2 2 2 2 2 2 2 2 2 2 ...
+ .. .. .. ..$ street_type : Factor w/ 5 levels "","Canyon street: L/H < 1.5",..: 1 1 5 4 4 1 4 1 2 1 ...
+ .. .. ..@ coords.nrs : num(0)
+ .. .. ..@ coords : num [1:194, 1:2] 4592866 4761515 4658756 4690954 4799839 ...
+ .. .. .. ..- attr(*, "dimnames")=List of 2
+ .. .. .. .. ..$ : NULL
+ .. .. .. .. ..$ : chr [1:2] "coords.x1" "coords.x2"
+ .. .. ..@ bbox : num [1:2, 1:2] 2749697 1647732 6412269 4604814
+ .. .. .. ..- attr(*, "dimnames")=List of 2
+ .. .. .. .. ..$ : chr [1:2] "coords.x1" "coords.x2"
+ .. .. .. .. ..$ : chr [1:2] "min" "max"
+ .. .. ..@ proj4string:Formal class 'CRS' [package "sp"] with 1 slots
+ .. .. .. .. ..@ projargs: chr " +proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000 +ellps=GRS80 +units=m +no_defs"
+ ..@ time :An 'xts' object on 2005-01-01/2005-12-31 containing:
+ Data: int [1:365, 1] 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 ...
+ - attr(*, "dimnames")=List of 2
+ ..$ : NULL
+ ..$ : chr "..1"
+ Indexed by objects of class: [POSIXct,POSIXt] TZ: GMT
+ xts Attributes:
+ NULL
+ ..@ endTime: POSIXct[1:365], format: "2005-01-02 01:00:00" "2005-01-03 01:00:00" "2005-01-04 01:00:00" "2005-01-05 01:00:00" ...
+}
+\source{
+Obtained from the european Air Qualtiy airbase http://acm.eionet.europa.eu/databases/airbase/.
+}
+\references{
+http://acm.eionet.europa.eu/databases/airbase/
+
+Graeler, B., L. E. Gerharz, & E. Pebesma (2012): Spatio-temporal analysis and interpolation of PM10 measurements in Europe. ETC/ACM Technical Paper 2011/10, January 2012.
+http://acm.eionet.europa.eu/reports/ETCACM_TP_2011_10_spatio-temp_AQinterpolation
+}
+\examples{
+data("EU_RB_2005")
+str(EU_RB_2005)
+}
+\keyword{datasets}
Modified: pkg/man/dependencePlot.Rd
===================================================================
--- pkg/man/dependencePlot.Rd 2014-09-19 11:15:54 UTC (rev 137)
+++ pkg/man/dependencePlot.Rd 2014-10-01 09:31:41 UTC (rev 138)
@@ -8,29 +8,18 @@
}
\usage{
dependencePlot(var = NULL, smpl, bandwidth = 0.075, main="Stength of dependence",
- transformation = function(x) x, ...)
+ transformation = function(x) x, margin=NULL, ...)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
- \item{var}{
-Column IDs or variable names to be used. If not provided, the first two columns will be used.
+ \item{var}{Column IDs or variable names to be used. If not provided, the first two columns will be used.}
+ \item{smpl}{a matrix (two-columns at least) holding the data}
+ \item{bandwidth}{the bandwidth passed to the smoothing kernel}
+ \item{main}{the title of the plot}
+ \item{transformation}{a transformation passed to the kernel}
+ \item{margin}{a quantile function to back transform the uniform margins to any other desired marginal distribution (typically \code{\link{qnorm}}). Note that the \code{bandwidth} parameter might need adjustment.}
+ \item{\dots}{passed on to the function \code{\link{panel.smoothScatter}}}
}
- \item{smpl}{
-a matrix (two-columns at least) holding the data
-}
- \item{bandwidth}{
-the bandwidth passed to the smoothing kernel
-}
-\item{main}{
-the title of the plot
-}
- \item{transformation}{
-a transformation passed to the kernel
-}
- \item{\dots}{
-passed on to the function \code{\link{panel.smoothScatter}}
-}
-}
\details{
see \code{\link{panel.smoothScatter}}
}
Added: rgl_sections.R
===================================================================
--- rgl_sections.R (rev 0)
+++ rgl_sections.R 2014-10-01 09:31:41 UTC (rev 138)
@@ -0,0 +1,38 @@
+library(copula)
+library(VineCopula)
+library(lattice)
+
+grid <- cbind(rep(1:99/100,99), rep(1:99/100,each=99))
+
+plotData <- as.data.frame(grid)
+plotData$sec1 <- dCopula(grid, joeBiCopula(param = 1.05))
+plotData$sec2 <- dCopula(grid, normalCopula(.4))
+plotData$sec3 <- dCopula(grid, claytonCopula(0.8))
+
+colBreaks <- quantile(c(plotData$sec1,
+ plotData$sec2,
+ plotData$sec3), probs = 0:100/100)
+
+p1 <- levelplot(sec1~V1+V2, plotData, at=colBreaks,
+ col.regions = terrain.colors(102))
+p2 <- levelplot(sec2~V1+V2, plotData, at=colBreaks,
+ col.regions = terrain.colors(102))
+p3 <- levelplot(sec3~V1+V2, plotData, at=colBreaks,
+ col.regions = terrain.colors(102))
+
+print(p1, position=c(0.2,0.65,0.8,1.05), more=T)
+print(p2, position=c(0.2,0.3,0.8,0.7), more=T)
+print(p3, position=c(0.2,-0.05,0.8,0.35))
+
+##
+library(rgl)
+plotData$sl1 <- qnorm(0.2)
+plotData$sl2 <- qnorm(0.5)
+plotData$sl3 <- qnorm(0.8)
+
+plot3d(plotData$sl1, plotData$V1, plotData$V2,
+ col=terrain.colors(102)[findInterval(plotData$sec1, colBreaks)])
+plot3d(plotData$sl2, plotData$V1, plotData$V2,
+ col=terrain.colors(102)[findInterval(plotData$sec2, colBreaks)], add=T)
+plot3d(plotData$sl3, plotData$V1, plotData$V2,
+ col=terrain.colors(102)[findInterval(plotData$sec3, colBreaks)], add=T)
\ No newline at end of file
More information about the spcopula-commits
mailing list