From noreply at r-forge.r-project.org Wed Oct 1 11:31:42 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 1 Oct 2014 11:31:42 +0200 (CEST) Subject: [spcopula-commits] r138 - / pkg pkg/R pkg/demo pkg/man Message-ID: <20141001093142.623CC187661@r-forge.r-project.org> 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