Bohórquez, Martha Patricia. Geoestadística para datos espaciales, espacio-temporales y funcionales 1.ª ed. Bogotá: Editorial UNAL. 2025. ISBN. 978-628-503-048-2.

Modelo esféricos y algunos modelos derivados

1. Modelo Triangular o de Carpa (Tent). Modelo lineal acotado.

Válido en \(\mathbb{R}^1\)

\[ \gamma_{triangular}(h)=\left\{\begin{array}{lll} \sigma^2\left(\frac{h}{a}\right) & \text { si } & h < a \\ \sigma^2 & \text { si } & h \geq a \end{array}\right. \]

triangleModelSemi <- function(h,a,sigma2) {ifelse(h <= a,sigma2*h/a,sigma2)}
curve(triangleModelSemi(x,10,5),0,15,main="",ylab="",xlab="h",col = "darkblue")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Triangular"))

Modelo Circular.

Válido en \(\mathbb{R}^d\), \(d=1,2\)

\[ \gamma_{circular}(h)= \begin{cases} \sigma^2\left(1-\frac{2}{\pi}\left(\arccos\left(\frac{h}{a}\right)-\frac{h}{a} \sqrt{1-\frac{h^2}{a^2}}\right)\right) & \text { si } \quad h \leq a \\ 0 & \text { si } \quad h \geq a\end{cases} \]

circularModelSemi <- function(h,a,sigma2){ifelse(h<=a,sigma2-sigma2*(-(2/pi)*((h/a)*(1-(h^2/a^2))^0.5-acos(h/a))),sigma2)}
curve(circularModelSemi(x,10,5),0,15,col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Circular"))

Modelo Esférico.

Válido en \(\mathbb{R}^d\), \(d=1,2,3\)

\[ \gamma_{esférico}(h)= \begin{cases}1-\frac{3}{2} \frac{h}{a}+\frac{1}{2} \frac{h^3}{a^3} & \text { si } \quad h \leq a \\ 0 & \text { si } \quad h \geq a\end{cases} \]

sphericalModelSemi <- function(h,a,sigma2){ifelse(h <= a,sigma2-sigma2*(1 - ((3/2)*(h/a)) + ((1/2)*((h**3)/(a**3)))),sigma2)}

curve(sphericalModelSemi(x,10,5),0,15,col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Esférico"))

Modelo Cúbico.

Válido en \(\mathbb{R}^d\), \(d=1,2,3\)

\[ \gamma_{cúbico}(h)= \begin{cases}\sigma^2\left(\frac{7h^2}{a^2}-\frac{35}{4} \frac{h^3}{a^3}+\frac{7}{2} \frac{h^5}{a^5}-\frac{3}{4} \frac{h^7}{a^7}\right) & \text { si } \quad h \leq a \\ 0 & \text { si } \quad h \geq a\end{cases} \]

cubicModelSemi<- function(h,a,sigma2) {
      ifelse(h <= a,sigma2*(7*((h**2)/(a**2)) - (35/4)*((h**3)/(a**3)) + (7/2)*((h**5)/(a**5)) - (3/4)*((h**7)/(a**7))),sigma2)
    }

curve(cubicModelSemi(x,10,5),0,15,col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Cúbico"))

Modelo Pentamodel. Radon transform of order 4 of the spherical covariogram of R7

Válido en \(\mathbb{R}^d\), \(d=1,2,3\)

\[ \gamma_{pentaesférico}(h)=\left\{\begin{array}{l} \sigma^2\left(\frac{22}{3} \frac{h^2}{a^2}-33 \frac{h^4}{a^4}+\frac{77}{2} \frac{h^5}{a^5}-\frac{33}{2} \frac{h^7}{a^7}+\frac{11}{2} \frac{h^9}{a^9}-\frac{5}{6} \frac{h^{11}}{a^{11}}\right) & \text { si } \quad h \leq a \\ 0 & \text { si } \quad h \geq a \end{array}\right. \]

pentaModelSemi <- function(h,a,sigma2) {
          ifelse(h <= a, sigma2*((22/3)*((h**2)/(a**2)) - (33)*((h**4)/(a**4)) + (77/2)*((h**5)/(a**5))-(33/2)*((h**7)/(a**7)) + (11/2)*((h**9)/(a**9)) - (5/6)*((h**11)/(a**11))),sigma2)
        }
        
curve(pentaModelSemi(x,10,5),0,15,col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Pentaesférico"))

Modelo exponencial y modelos derivados.

Modelo Exponencial.

Válido en \(\mathbb{R}^d\), para todo \(d\).

\[ C_{exponencial}(h)=\sigma^2-\sigma^2\exp \left(-\frac{h}{a}\right) \]

expModelSemi <- function(h,a,sigma2){sigma2*(1-exp(-(h/a)))} 
curve(expModelSemi(x,10,5),0,50,col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Exponencial"))

Transformada de Radon de orden 2 de la covarianza exponencial.

Válido en \(\mathbb{R}^d\), para todo \(d\).

\[ C_{expRadon2}(h)=\sigma^2-\sigma^2\left(1+\frac{h}{a}\right) \exp \left(-\frac{h}{a}\right) \]

exp2ModelSemiv <- function(h,a,sigma2){sigma2-sigma2*(1+(h/a))*exp(-(h/a))} 
curve(exp2ModelSemiv(x,10,5),0,60,ylim=c(0,5),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Transformada Radon orden 2 de covarianza exponencial"))

Transformada de Radon de orden 4 de la covarianza exponencial.

Válido en \(\mathbb{R}^d\), para todo \(d\).

\[ C_{expRadon4}(h)=\sigma^2-\sigma^2\left(1+\frac{h}{a}+\frac{1}{3} \frac{h^2}{a^2}\right) \exp \left(-\frac{h}{a}\right) \]

exp4ModelSemi <- function(h,a,sigma2){sigma2-sigma2*(1+(h/a)+((1/3)*((h**2)/(a**2))))*exp(-(h/a))}
curve(exp4ModelSemi(x,a=10,sigma2=5),0,50,ylim=c(0,5),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Transformada Radon orden 4 de covarianza exponencial"))

Modelo Gaussiano.

Válido en \(\mathbb{R}^d\), para todo \(d\). \(a>0\)

\[ C_{gaussiano}(h)=\sigma^2-\sigma^2\exp \left(-\frac{h^2}{a^2}\right) \]

gaussianModelSemi <- function(r,a,sigma2){sigma2*(1-exp(-((r**2)/(a**2))))}
curve(gaussianModelSemi(x,10,5),0,50,ylim=c(0,5),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Gaussiano"))

Modelo estable.

Válido en \(\mathbb{R}^d\), para todo \(d\).

Válido en \(a>0\) y \(0 < \alpha \leq 2\)

\[ C(r)=\exp \left(-\left(\frac{r}{a}\right)^\alpha\right) \quad(a>0,0<\alpha \leq 2) \]

hpowModel <- function(r,a,alpha,sigma2){sigma2-sigma2*exp((-1)*((r/a)**alpha))}
curve(hpowModel(x,10,1.3,5),0,50,ylim=c(0,5),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Estable"))

Modelo Exponencial con amortiguamiento. Válido para \(d=1\)

Válido para \(d=2\) sii \(a2\geq a1\).

Válido para d=3 sii \(a2 \geq a1\sqrt(3)\)

\[ C(h)=\exp \left(-\frac{|h|}{a_l}\right) \cos \left(\frac{h}{a_2}\right) \quad\left(h \in \mathbb{R},\quad a_1,\quad a_2>0\right) \]

ExpAmortModelSemi <- function(h,a1,a2,sigma2) {sigma2-sigma2*exp((-1)*(abs(h)/a1))*cos(h/a2)}
curve(ExpAmortModelSemi(x,6,1.9,5),xlim=c(0,15),ylim=c(0,7),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Exponencial con amortiguamiento"))

Modelo J-Bessel.

Válido en \(\mathbb{R}^d\), para todo \(d\). \(a>0\)

\[ C_n(r)=\kappa_n\left(\frac{r}{a}\right)=2^{n / 2-1} \Gamma\left(\frac{n}{2}\right)\left(\frac{r}{a}\right)^{1-n / 2} J_{n / 2-1}\left(\frac{r}{a}\right) \quad(a>0) \]

besseljModelSemi <- function(r,a,n,sigma2){sigma2-sigma2*(2**((n/2)-1))*gamma(n/2)*((r/a)**(1-(n/2)))*besselJ(x = r/a,nu = ((n/2)-1))}
curve(besseljModelSemi(x,2.5,3,5),xlim=c(0,15),ylim=c(0,6),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Bessel"))

Modelo Seno-Cardinal.

Válido en \(\mathbb{R}^d\), \(d=1,2,3\)

\[ C(r)=\left(\frac{a}{r}\right) \sin \left(\frac{r}{a}\right) \quad\left(h \in \mathbb{R}^3\right) \]

cardinasineModel <- function(r,a,sigma2){sigma2-sigma2*(a/r)*sin(r/a)}
curve(cardinasineModel(x,0.5,5),col="darkblue",main="",ylab="",xlab="h",xlim=c(0,15),ylim=c(0,6)) 
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Seno cardinal"))

Modelo Bessel + Exponencial con amortiguamiento

curve(besseljModelSemi(x,5,3,2.7)+ExpAmortModelSemi(x,6,1.9,2.3),xlim=c(0,15),ylim=c(0,5),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Exponencial con amortiguamiento+Bessel"))

Modelo Estable + Seno cardinal

curve(hpowModel(x,10,1.3,2.5)+cardinasineModel(x,0.5,2.5),xlim=c(0,15),ylim=c(0,5),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Estable+Seno cardinal"))

Modelo Pentaesférico + Triangular

curve(pentaModelSemi(x,10,2.5)+triangleModelSemi(x,10,2.5),main="",ylab="",xlab="h",xlim=c(0,15),ylim=c(0,5),col="darkblue")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Pentaesférico+Triangular"))

Modelo Cauchy.

Válido en \(\mathbb{R}^d\), para todo \(d\).

\[ \gamma(h)=\sigma^2\left(1-\left(1+\frac{h^2}{a^2}\right)^{-\alpha}\right) \]

cauchyModelSemi <- function(r,a,alpha,sigma2){sigma2-sigma2*(1+(r/a)^2)^(-alpha)}
curve(cauchyModelSemi(x,1,7,5),xlim=c(0,15),ylim=c(0,5),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Cauchy"))

Modelo Cauchy generalizado.

Válido en \(\mathbb{R}^d\), para todo \(d\). \(\kappa_1 \geq 0\) y \(0<\kappa_1 \leq 2\)

\[ \gamma(h)=\sigma^2\left(1-\left(1+\left(\frac{h}{a}\right)^{\kappa_2}\right)^{-\kappa_1/\kappa_2}\right) \]

GencauchyModelSemi <- function(h,a,k1,k2,sigma2){sigma2-sigma2*(1+(h/a)^k2)^(-k1/k2)}
curve(GencauchyModelSemi(x,10,5,1.7,5),xlim=c(0,15),ylim=c(0,5),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Cauchy generalizado"))

potencial <- function(h,alpha,sigma2){sigma2*(h)^(alpha)}
curve(potencial(x,1.8,1),xlim=c(0,2.6),ylim=c(0,5),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Potencial"))

Modelo Matern.

Válido en \(\mathbb{R}^d\), para todo \(d\). \(a>0\) y \(\nu>0\)

\[ C(r)=\frac{1}{2^{\nu-1} \Gamma(\nu)}\left(\frac{r}{a}\right)^\nu K_\nu\left(\frac{r}{a}\right) \quad(a>0, \nu \geq 0) \]

MaternKModelSemi <- function(r,a,v,sigma2){sigma2-sigma2*(1/((2**(v-1))*gamma(v)))*((r/a)**v)*besselK(x = r/a,nu = v)}
curve(MaternKModelSemi(x,a =10,v = 0.25,sigma2=5),xlim=c(0,15),ylim=c(0,5),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Matérn"))

Modelo Lanteujoul.

Válido en \(\mathbb{R}^d\), para todo \(d\). \(a>0\) y \(\nu>0\)

\[ \gamma(h;\Theta)=\sigma^2-\sigma^2\sin\left(\frac{\pi}{2}\exp\left(-\frac{|h|}{a}\right)\right) \]

LanteoujulModelSemi <- function(h,a,sigma2){sigma2-sigma2*sin((pi/2)*exp(-h/a))}
curve(LanteoujulModelSemi(x,a =10,sigma2=5),xlim=c(0,40),ylim=c(0,5),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("Lantéoujul"))

Modelo de regionalización: Pepita+esférico+exponencial

Válido en \(\mathbb{R}^3\) el esférico y en \(\mathbb{R}^d\) los otros, entonces la combinación lineal de ellos es válida en \(\mathbb{R}^3\)

curve(4+sphericalModelSemi(x,10,16)+expModelSemi(x,7,4),xlim=c(0,30),ylim=c(0,25),col="darkblue",main="",ylab="",xlab="h")
loc <- par("usr")
text(loc[1], loc[4],expression(paste(gamma,"(h)")), xpd = T, adj = c(1,0))
legend("bottomright",c("pepita+esférico+exponencial"))