volta.quad {geoComp}R Documentation

Usage

volta.quad(med.cov, n.pontos = 6, Variancia = FALSE)

Arguments

med.cov
n.pontos
Variancia

Examples

##---- Should be DIRECTLY executable !! ----
##-- ==>  Define data, use random,
##--    or do  help(data=index)  for the standard data sets.

## The function is currently defined as
function(med.cov,    # media e covariancia de cokrigagem
                       n.pontos=6,  # ordem da quadratura de Gauss-Hermite
                       Variancia=FALSE # Calcula ou nao a variancia
                       ){
  mu.ck <- med.cov[[1]]
  sigma.ck <- med.cov[[2]]
  desvio.pd <- sqrt(diag(sigma.ck))
  ic.mu <- data.frame(mu.ck-qnorm(0.975)*desvio.pd,mu.ck+qnorm(0.975)*desvio.pd)
  names(ic.mu) <- c("L.Minimo","L.Maximo")
   g <- function(Y,mu,R,pos){
    arg.agl <-mu+sqrt(2)*t(R)%*%Y
    g1 <- t(pi^-1*agl(arg.agl))
    g2 <- pi^-1*(t(as.matrix(agl(arg.agl)))-g1)%*%t(t(as.matrix(agl(arg.agl)))-g1)
    resultado <- cbind(g1,g2)
    return(resultado[pos])
    }

  # calculando a quadratura de gauss-hermite
  quad.gauss.comp <- function(mu,R,func=g,pos,np=n.pontos){
    AbcPeso <- gauss.quad(np,kind='hermite')
    Y <- AbcPeso$nodes
    peso<- AbcPeso$weights
    soma <- 0
    for(i in 1:np){
      for(j in 1:np){
        soma<-peso[i]*peso[j]*func(Y=c(Y[i],Y[j]),mu=mu,R=R,pos=pos)+soma
        }
      }
    return(soma)
    }
  
  # calculando a quadratura de gauss-hermite para o vetor de medias
  n.linhas <- length(mu.ck)/2
  compo.md <- matrix(ncol=3,nrow=n.linhas)
  seq1 <- seq(1,n.linhas*2,by=2)
  seq2 <- seq(2,n.linhas*2,by=2)

  for(i in 1:n.linhas){
    sigma.ck <- med.cov[[2]][seq1[i]:seq2[i],seq1[i]:seq2[i]]
    mu.ck <- med.cov[[1]][seq1[i]:seq2[i]]
    cp <- quad.gauss.comp(mu=mu.ck,R=chol(sigma.ck),func=g,pos=c(1:3),np=n.pontos)
    compo.md[i,] <- cp
    }
  #rowSums(compo.md)
  
  # calculando a quadratura de gauss-hermite para a matriz de covariancias
  if(Variancia == TRUE){
  compo.var <- matrix(ncol=3,nrow=n.linhas)

  for(i in 1:n.linhas){
    sigma.ck <- med.cov[[2]][seq1[i]:seq2[i],seq1[i]:seq2[i]]
    mu.ck <- med.cov[[1]][seq1[i]:seq2[i]]
    cp <- quad.gauss.comp(mu=mu.ck,R=chol(sigma.ck),func=g,pos=c(4,8,12),np=n.pontos)
    compo.var[i,] <- cp
    }}

  retorna <- list()
  retorna[[1]] <- compo.md

  if(Variancia == TRUE){
  retorna[[2]] <- compo.var}
  
  return(retorna)
  }

[Package geoComp version 0.1-0 Index]