From 60b2ecb98b4980a96e550e5841be07e66a27c56b Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 19 Apr 2021 15:49:11 +0300 Subject: [PATCH] last changes (TRUE/FALSE and message()) before resubmission to CRAN --- R/digit.curves.R | 4 ++-- R/jt_kde.R | 48 ++++++++++++++++++++++---------------------- R/level_curves.R | 8 ++++---- R/supplement.funct.R | 2 +- man/AnalogSel.Rd | 4 ++++ man/JT.KDE.ap.Rd | 2 +- man/Margins.mod.Rd | 8 ++++++++ man/curve.funct.a.Rd | 2 +- 8 files changed, 45 insertions(+), 33 deletions(-) diff --git a/R/digit.curves.R b/R/digit.curves.R index 4bdeb57..1433e09 100644 --- a/R/digit.curves.R +++ b/R/digit.curves.R @@ -26,8 +26,8 @@ digit.curves.p <- function(start, curve, nPoints, closed=TRUE){ if(nPoints > (nCurvePoints - 1)) { if((nCurvePoints - 1) == 1) nPoints = 1 if((nCurvePoints - 1) > 1) nPoints = nCurvePoints - 2 - cat("\nWarning: because the number of desired points exceeds the number of curve points,") - cat("\nthe number of points will be truncated to", nPoints, "\n\n") + message("\nWarning: because the number of desired points exceeds the number of curve points,") + message("\nthe number of points will be truncated to", nPoints, "\n\n") } start <- as.numeric(start) if(!setequal(start, curve[1,])) curve <- rbind(start, curve) diff --git a/R/jt_kde.R b/R/jt_kde.R index b4c5df6..eb689ae 100644 --- a/R/jt_kde.R +++ b/R/jt_kde.R @@ -30,7 +30,7 @@ #' @examples #' \dontrun{ #' jtres<-JT.KDE.ap(u2=u2,pbas=0.01,pobj=upobj,beta=100,kk=kk,vtau=vtau, -#' devplot=F,mar1=uu[,1],mar2=uu[,2],px=pp[,1],py=pp[,2],interh=interh) +#' devplot=FALSE,mar1=uu[,1],mar2=uu[,2],px=pp[,1],py=pp[,2],interh=interh) #' plot(jtres$levelcurve) #' } #' @importFrom stats approx cor.test na.omit optim @@ -63,7 +63,7 @@ JT.KDE.ap<-function(u2,pbas ,pobj,beta,vtau,devplot=F,kk,mar1,mar2,px,py,interh= pxe<-approx(godx$x, godx$y, xout = lox, method = "linear",yleft = min(px),yright = max(px), rule = 1)$y pye<-approx(gody$x, gody$y, xout = loy, method = "linear",yleft = min(py),yright = max(py), rule = 1)$y - if(devplot==T){ + if(devplot==TRUE){ plot(aa,cont = c(0.05,0.1),display="filled.contour" ,col=viridis(10)) } @@ -120,10 +120,10 @@ JT.KDE.ap<-function(u2,pbas ,pobj,beta,vtau,devplot=F,kk,mar1,mar2,px,py,interh= qc<-.95 rq0<-seq(0.75,0.95,by=0.01) for(q0 in rq0){ - estims<-try(Bv.LT.Dep (data= kk,mod.thresh.u = q0,crit.lev.u = qc,sig.lev=0.05,ci.meth='se',marg.inf=T),silent = T) - qd<-try((estims$par[2]),silent=T) - cd<-try((estims$chiCIs),silent=T) - cc<-try((estims$chi),silent=T) + estims<-try(Bv.LT.Dep (data= kk,mod.thresh.u = q0,crit.lev.u = qc,sig.lev=0.05,ci.meth='se',marg.inf=TRUE),silent = T) + qd<-try((estims$par[2]),silent=TRUE) + cd<-try((estims$chiCIs),silent=TRUE) + cc<-try((estims$chi),silent=TRUE) if(is.numeric(qd)){ qq<-c(qq,qd) @@ -142,15 +142,15 @@ JT.KDE.ap<-function(u2,pbas ,pobj,beta,vtau,devplot=F,kk,mar1,mar2,px,py,interh= sh<-which(sumd<=-0.02|sumd>=0.02 )[1] q0<-rq0[sh-1] plot(sumd) - estims<-try(Bv.LT.Dep (data= kk,mod.thresh.u = q0,crit.lev.u = qc,sig.lev=0.05,ci.meth='se',marg.inf=T),silent = T) + estims<-try(Bv.LT.Dep (data= kk,mod.thresh.u = q0,crit.lev.u = qc,sig.lev=0.05,ci.meth='se',marg.inf=TRUE),silent = T) chat=NA etahat=NA Chilow=NA Chimed=NA - try(chat<-estims$par[1],silent=T) - try(etahat<-estims$par[2],silent=T) - try(Chilow<-estims$chiCIs[1],silent=T) - try(Chimed<-estims$chi,silent=T) + try(chat<-estims$par[1],silent=TRUE) + try(etahat<-estims$par[2],silent=TRUE) + try(Chilow<-estims$chiCIs[1],silent=TRUE) + try(Chimed<-estims$chi,silent=TRUE) #Loop for asymptotic dependence @@ -232,8 +232,8 @@ JT.KDE.ap<-function(u2,pbas ,pobj,beta,vtau,devplot=F,kk,mar1,mar2,px,py,interh= ltl1<-ltl ltl2<-ltl if (pobj[sl]>0.0000001){ - gridx<-(seq(min(ltl[,1],na.rm=T),max(mar1),length.out=100)) - gridy<-(seq(min(ltl[,2],na.rm=T),max(mar2),length.out=100)) + gridx<-(seq(min(ltl[,1],na.rm=TRUE),max(mar1),length.out=100)) + gridy<-(seq(min(ltl[,2],na.rm=TRUE),max(mar2),length.out=100)) ltl1[,1]<-approx(ltl[,1], ltl[,2], xout = gridx, method = "linear", rule = 1)$x ltl1[,2]<-approx(ltl[,1], ltl[,2], xout = gridx, method = "linear", rule = 1)$y @@ -252,8 +252,8 @@ JT.KDE.ap<-function(u2,pbas ,pobj,beta,vtau,devplot=F,kk,mar1,mar2,px,py,interh= tg=50 - gridx<-seq(min(wqobjf[,1],na.rm=T),max(mar1),length.out=tg) - gridy<-seq(min(wqobjf[,2],na.rm=T),max(mar2),length.out=tg) + gridx<-seq(min(wqobjf[,1],na.rm=TRUE),max(mar1),length.out=tg) + gridy<-seq(min(wqobjf[,2],na.rm=TRUE),max(mar2),length.out=tg) pxg<-approx(mar1, px, xout = gridx, method = "linear",yleft = min(px),yright = max(px), rule = 1)$y @@ -265,7 +265,7 @@ JT.KDE.ap<-function(u2,pbas ,pobj,beta,vtau,devplot=F,kk,mar1,mar2,px,py,interh= for (j in 1:(length(pyg)-1)){ coly<-wqobjf[colx,3][which(wqobjf[colx,2]>gridy[j] & wqobjf[colx,2]<=gridy[j+1])] if(length(coly)==0){matjt[j,k]=NA}else{ - matjt[k,j]=mean(coly,na.rm=T)/(1-pxg[k])} + matjt[k,j]=mean(coly,na.rm=TRUE)/(1-pxg[k])} } } @@ -274,7 +274,7 @@ JT.KDE.ap<-function(u2,pbas ,pobj,beta,vtau,devplot=F,kk,mar1,mar2,px,py,interh= for (j in 1:(length(pyg)-1)){ coly<-wqobjf[colx,3][which(wqobjf[colx,1]>gridx[j] & wqobjf[colx,1]<=gridx[j+1])] if(length(coly)==0){matjt[j,k]=matjt[j,k]}else{ - matjt[j,k]=mean(coly,na.rm=T)/(1-pxg[j])} + matjt[j,k]=mean(coly,na.rm=TRUE)/(1-pxg[j])} } } @@ -282,11 +282,11 @@ JT.KDE.ap<-function(u2,pbas ,pobj,beta,vtau,devplot=F,kk,mar1,mar2,px,py,interh= grid <- expand.grid(lon=gridx, lat=gridy) - for (nap in 1: length(pxg)){ matjt[,nap]<-na.approx(matjt[,nap],maxgap = 5,na.rm=F)} + for (nap in 1: length(pxg)){ matjt[,nap]<-na.approx(matjt[,nap],maxgap = 5,na.rm=FALSE)} - for (nap in 1: length(pxg)){ matjt[nap,]<-na.approx(matjt[nap,],maxgap = 5,na.rm=F)} + for (nap in 1: length(pxg)){ matjt[nap,]<-na.approx(matjt[nap,],maxgap = 5,na.rm=FALSE)} - levelplot(matjt ~ lon * lat, data=grid, cuts=20, pretty=T,contour=T) + levelplot(matjt ~ lon * lat, data=grid, cuts=20, pretty=TRUE,contour=TRUE) contour(gridx,gridy,matjt,levels=0.001) sh<-contourLines(gridx,gridy,matjt,levels=pobj) @@ -350,11 +350,11 @@ Cond.mod.ap<-function(u2,tr1,tr2,tsim,num.sim,pobj,interh="comb",mar1,mar2,px,py ext.q=0.95 mex.fit <- mex(data = u2 , which = 1, mqu = thresh1, dqu = ext.q, margins = "Laplace", constrain = F) - mex.fit2 <- mex(data = u2, which = 2, mqu =c(thresh1), dqu = ext.q, constrain=F) + mex.fit2 <- mex(data = u2, which = 2, mqu =c(thresh1), dqu = ext.q, constrain=FALSE) mex.pred <-predict(mex.fit, pqu = tsim, nsim = num.sim,smoothZdistribution=TRUE) - mex.pred2<-predict(mex.fit2, pqu = tsim, nsim = num.sim,smoothZdistribution=T) + mex.pred2<-predict(mex.fit2, pqu = tsim, nsim = num.sim,smoothZdistribution=TRUE) #Estimation of the H&T chi qexp1<-quantile(u2[,2],tsim) @@ -418,7 +418,7 @@ Cond.mod.ap<-function(u2,tr1,tr2,tsim,num.sim,pobj,interh="comb",mar1,mar2,px,py ale[j,k]=jesus[j,k]/(1-lexp[j])}} plot(u2,xlim=c(0,40),ylim=c(0,300)) - contour(lesx,lesy,ale,levels = c(0.1),col=3,ylim=c(0,200),add=T) + contour(lesx,lesy,ale,levels = c(0.1),col=3,ylim=c(0,200),add=TRUE) sh2<-contourLines(lesx,lesy,ale,levels=pobj/(1-tsim)) obx<-c() @@ -453,7 +453,7 @@ Cond.mod.ap<-function(u2,tr1,tr2,tsim,num.sim,pobj,interh="comb",mar1,mar2,px,py jline<-jline[order(jline$j2..1..),] jj1<-as.matrix(j1o[which(j1o[,2]j2o[,1]+q2-q1),]) - mj1<-min(jj1[,1],na.rm=T) + mj1<-min(jj1[,1],na.rm=TRUE) mj2<-max(jj2[,1]) mj3<-max(jj1[,1]) if(mj2>mj1){ diff --git a/R/level_curves.R b/R/level_curves.R index 47cf0f6..9cef137 100644 --- a/R/level_curves.R +++ b/R/level_curves.R @@ -107,8 +107,8 @@ curve.funct<-function(pxf,pyf,mar1,mar2,pos,pobje,ng=100,inter="comb",coco,c1){ #' @importFrom copBasic surfuncCOP #' @return Level curves for a given joint probability -curve.funct.a<-function(px,py,mar1,mar2,pos,pobje,ng=100,inter="comb",logm=F,coco,c1){ - if(logm==T) { +curve.funct.a<-function(px,py,mar1,mar2,pos,pobje,ng=100,inter="comb",logm=FALSE,coco,c1){ + if(logm==TRUE) { mar1<-log(mar1) mar2<-log(mar2) } @@ -168,7 +168,7 @@ curve.funct.a<-function(px,py,mar1,mar2,pos,pobje,ng=100,inter="comb",logm=F,coc clf<-contourLines(coxi,coyi, acp3, levels = pobje) if(is.list(clf)|length(clf)>1){ clf<-as.matrix(data.frame(clf[[1]]$x,clf[[1]]$y))} else{clf<-"error"} - if(logm==T) clf<-exp(clf) + if(logm==TRUE) clf<-exp(clf) return(clf) } @@ -259,7 +259,7 @@ curve.funct.b<-function(pxf,pyf,mar1,mar2,pos,pobje,ng=100,inter="comb",coco,c1) } } grid <- expand.grid(lon=godx, lat=gody) - levelplot(acp3 ~ lon * lat, data=grid, cuts=20, pretty=T) + levelplot(acp3 ~ lon * lat, data=grid, cuts=20, pretty=TRUE) cl2<-contourLines(coxi,coyi, acp3, levels = pobje) if(length(cl2)>0){ cl2<-as.matrix(data.frame(cl2[[1]]$x,cl2[[1]]$y))} else{cl2<-NA} diff --git a/R/supplement.funct.R b/R/supplement.funct.R index cd2cadd..eca9363 100644 --- a/R/supplement.funct.R +++ b/R/supplement.funct.R @@ -28,7 +28,7 @@ AnalogSel<-function(u2){ et<-c(etalist[which(etalist>=etint[1]&etalist<=etint[3])]) ct<-c(chilist[which(chilist>=chint[1]&chilist<=chint[3])]) if(chint[1]>0.1)et<-c() - cat(paste(c("analogous datasets to be tested: \n eta = ",et," \n chi = ",ct),collapse= " ")) + message(paste(c("analogous datasets to be tested: \n eta = ",et," \n chi = ",ct),collapse= " ")) AnSel<-list(et=et,ct=ct) } diff --git a/man/AnalogSel.Rd b/man/AnalogSel.Rd index bc7b42c..8ce952c 100644 --- a/man/AnalogSel.Rd +++ b/man/AnalogSel.Rd @@ -17,3 +17,7 @@ No return value, called for side effects Automatically select analaugous datasets from the 60 datasets created in Tilloy et al.(2020) see: https://nhess.copernicus.org/articles/20/2091/2020/nhess-20-2091-2020.html for more detaila } +\examples{ +data(porto) +AnalogSel(fire01meantemp) +} diff --git a/man/JT.KDE.ap.Rd b/man/JT.KDE.ap.Rd index f0c45b1..5f2deb8 100644 --- a/man/JT.KDE.ap.Rd +++ b/man/JT.KDE.ap.Rd @@ -59,7 +59,7 @@ Fit bivariate joint tail model with Kernel density estimator (Adapted from Coole \examples{ \dontrun{ jtres<-JT.KDE.ap(u2=u2,pbas=0.01,pobj=upobj,beta=100,kk=kk,vtau=vtau, -devplot=F,mar1=uu[,1],mar2=uu[,2],px=pp[,1],py=pp[,2],interh=interh) +devplot=FALSE,mar1=uu[,1],mar2=uu[,2],px=pp[,1],py=pp[,2],interh=interh) plot(jtres$levelcurve) } } diff --git a/man/Margins.mod.Rd b/man/Margins.mod.Rd index b8fd6c4..974de6f 100644 --- a/man/Margins.mod.Rd +++ b/man/Margins.mod.Rd @@ -24,3 +24,11 @@ a list of containing the following pseudo observations (uniform margins) with a \description{ Compute uniform margins with Generalized Pareto Distribution above threshold } +\examples{ +data(porto) +tr1=0.9 +tr2=0.9 +fire01meantemp=na.omit(fire01meantemp) +u=fire01meantemp +marmod=Margins.mod(tr1,tr2,u=fire01meantemp) +} diff --git a/man/curve.funct.a.Rd b/man/curve.funct.a.Rd index 0c1261d..2af31f1 100644 --- a/man/curve.funct.a.Rd +++ b/man/curve.funct.a.Rd @@ -13,7 +13,7 @@ curve.funct.a( pobje, ng = 100, inter = "comb", - logm = F, + logm = FALSE, coco, c1 )