ilapros

### I use these to generate data for teaching examples 
lnparFromMoments <- function(expectation, variance){
  m <- expectation; s2 <- variance ; m2 <- m^2
  mu <- log(m2/sqrt(s2+m2))
  sigma2 <- log(1+s2/m2)
  c(mu, sqrt(sigma2)) 
}

gammaparFromMoments <- function(expectation, variance, scale = FALSE){
  m <- expectation; s2 <- variance ; m2 <- m^2 

ilapros

gevfp.fit <- function (xdat, ydat = NULL, mul = NULL, sigl = NULL, shl = NULL, 
                        mulink = identity, siglink = identity, shlink = identity, 
                        muinit = NULL, siginit = NULL, shinit = NULL, show = TRUE, 
                        method = "Nelder-Mead", maxit = 10000, 
                        fixedPars = list(mu = NULL, sig = NULL, sh = NULL), ...) {
        z <- list()
        npmu <- length(mul) + 1
        npsc <- length(sigl) + 1
        npsh <- length(shl) + 1
        z$trans <- FALSE

ilapros

gevcv.fit <- function (xdat, ydat = NULL, mul = NULL, taul = NULL, shl = NULL, 
          mulink = identity, taulink = identity, shlink = identity, 
          muinit = NULL, tauinit = NULL, shinit = NULL, show = TRUE, 
          method = "Nelder-Mead", maxit = 10000, ...) {
  z <- list()
  npmu <- length(mul) + 1
  npcv <- length(taul) + 1
  npsh <- length(shl) + 1
  z$trans <- FALSE
  in2 <- sqrt(6 * var(xdat))/pi

ilapros

## slight modification of https://github.com/cran/NSM3/blob/master/R/kendall.ci.R
kendall.ci<-function (x=NULL, y=NULL, alpha=0.05, type="t", bootstrap=F, B=1000, example=F)  {
	# This will produce a 1 - alpha CI for
	# Kendall's tau.  Based on sections 8.3 and 8.4 of:
	#
	#   Nonparametric Statistical Methods, 3e
	#   Hollander, Wolfe & Chicken 
	#
	# bootstrap = F will find the asymptotic CI as in section 8.3.
	# bootstrap = T will find a bootstrap CI as in section 8.4

ilapros

### how to dplyr this? 

df1 <- data.frame(TH2020 = rnorm(200), TH2030 = rnorm(200))
df2 <- data.frame(TH = c(2020,2030), mod1 = runif(2,-2,2), mod2 = runif(2,-2,2), mod3 = runif(2,-2,2), mod4 = runif(2,-2,2))

out <- rbind(apply(df2[df2$TH == 2020,2:5,drop=FALSE], 2, function(x) length(df1[,"TH2020"][df1[,"TH2020"] < x])), 
             apply(df2[df2$TH == 2030,2:5,drop=FALSE], 2, function(x) length(df1[,"TH2030"][df1[,"TH2030"] < x])))      
out <- cbind(c(2020,2030), out)