library(spatstat)

Intensidad

Intensidad homogénea

Cuando en cualquier sub-región B bidimensional el número esperado de puntos de X que caen en B es proporcional al área de B.

El estimador de la intensidad puede ser computado usando las funciones “npoints” y “area.owin” o usando la función “intensity.ppp”:

Ejemplo 1:

La intensidad estimada es 0.0074 árboles por decímetro cuadrado.

data(swedishpines)
intensity(swedishpines)
[1] 0.007395833
unitname(swedishpines)
0.1 metres 
intensity(rescale(swedishpines))
[1] 0.7395833
plot(swedishpines)

Ejemplo 2

Si el patrón de puntos es múltiple entonces la función “intensity.ppp” retorna un vector de intensidades, una para cada tipo.

data(amacrine)
intensity(amacrine)
     off       on 
88.68302 94.92830 
unitname(amacrine)
662 microns 
summary(amacrine)
Marked planar point pattern:  294 points
Average intensity 183.6113 points per square unit (one unit = 
662 microns)

Coordinates are given to 4 decimal places

Multitype:
    frequency proportion intensity
off       142  0.4829932  88.68302
on        152  0.5170068  94.92830

Window: rectangle = [0, 1.6012085] x [0, 1] units
Window area = 1.60121 square units
Unit of length: 662 microns
sum(intensity(amacrine))
[1] 183.6113
plot(amacrine)

Conteo de cuadrantes

Una forma sencilla de verificar la falta de homogeneidad es probar si las regiones de igual área contienen aproximadamente el mismo número de puntos, como debe esperarse en un proceso puntual homogéneo.

swp = rescale(swedishpines)
Q3 = quadratcount(swp, nx=3, ny=4)
Q3
          x
y          [0,3.2) [3.2,6.4) [6.4,9.6]
  [7.5,10]       5         4         6
  [5,7.5)        8         8         6
  [2.5,5)        5         6         6
  [0,2.5)        3         5         9
plot(intensity (Q3, image=T))
plot(Q3, add=T)
plot(swp, add=T)

Test de homogeneidad

# Prueba Chi-cuadrada
#**********************************
# H0: La intensidad es homogenea
# Ha: La intensidad es no homogenea
# Si p<a entonces rechazamos H0.
#**********************************
tS = quadrat.test(swp, 3, 3)
tS

    Chi-squared test of CSR using quadrat counts

data:  swp
X2 = 4.6761, df = 8, p-value = 0.4169
alternative hypothesis: two.sided

Quadrats: 3 by 3 grid of tiles
plot(swp)
plot(tS, add=T)

  • Dado que 0.41>0.05 No rechazamos la hipótesis nula, y la intensidad es homogénea.

Estimación usando kernel

La función intensidad puede ser estimada usando una función kernel. Con spatstat utilzamos la función density, por defecto, utilizamos un kernel gaussiano, con el ancho de banda de suavisado determinado por el argumento sigma. Por defecto se utiliza la corrección uniforme, y la salida es una imagen im.

D = density(swedishpines)
plot(D)
plot(swedishpines, add=T)
contour(D, add=T)

persp(D, theta= 30, phi = 30, col = "lightblue")

Sigma controla el grado del suavisado:

D05 = density(swedishpines, sigma=0.5)
D1 = density(swedishpines, sigma=1)
D15 = density(swedishpines, sigma=1.5)

Seleccionando ancho de banda bw

# Seleccionando ancho de banda bw
bw = bw.ppl (rescale(swedishpines))
Likelihood Cross-Validation criterion was minimised at right-hand end of interval [0.224, 6.93]; use argument 㤼㸱srange㤼㸲 to specify a wider interval for bandwidth 㤼㸱sigma㤼㸲
bw
   sigma 
6.931089 
plot(bw)

Cuadrantes escogidos por una covariable

Nuevos datos: bei
Un patrón de puntos que muestra la ubicación de 3605 árboles en una selva tropical. Acompañado de datos de covariables que dan la elevación (altitud) y pendiente de elevación en la región de estudio

data(bei)
class(bei)
bei

Intensidad usando kernel

data(bei)
class(bei)
[1] "ppp"
bei
Planar point pattern: 3604 points
window: rectangle = [0, 1000] x [0, 500] metres
# Intensidad usando kernel
intensity(bei)
[1] 0.007208
D = density(bei)
plot(D)
plot(bei, add=T)
contour(D, add=T, col="white")

Covariable elevación

# Covariable
elev = bei.extra$elev
class(elev)
[1] "im"
plot(elev)
plot(bei, add=T)

Dividiendo la covariable en 4 cuantiles iguales

# Dividiendo la covariable en 4 cuantiles iguales
b = quantile(elev, probs = (0:4)/4, type = 2)
Zcut = cut(elev, breaks = b, labels = 1:4)
V = tess(image=Zcut)
textureplot (V)

plot(V)

Conteo por cuadrante

# Conteo por cuadrante
There were 12 warnings (use warnings() to see them)
qb = quadratcount(bei, tess = V)
qb
tile
   1    2    3    4 
 714  883 1344  663 

Ejercicio

Realizar lo anterior con los datos de Medellín.

Planar point pattern: 1702 points
window: polygonal boundary
enclosing rectangle: [827.7456, 840.7194] x [1174.8959, 
1190.0705] units
*** 4 illegal points stored in attr(,“rejects”) ***

1. Conteo de cuadrantes

# Conteo de cuadrantes:
Q3S = quadratcount(S, nx=3, ny=4)
Q3S
             x
y             [828,832) [832,836) [836,841]
  [1186,1190]        31       344        99
  [1182,1186)       308       205       189
  [1179,1182)        98       191       121
  [1175,1179)         3       109         4
4 illegal points also plotted

# Test de homogeneidad
tS1 = quadrat.test(S, 3, 4)
tS1 

    Chi-squared test of CSR using quadrat counts

data:  S
X2 = 271.37, df = 11, p-value < 2.2e-16
alternative hypothesis: two.sided

Quadrats: 12 tiles (irregular windows)

2. Estimación usando kernel

D1 = density(S)
plot(D1)
plot(S, add=T)
4 illegal points also plotted
contour(D1, add=T, col="white")

LS0tDQp0aXRsZTogIioqQW7DoWxpc2lzIGV4cGxvcmF0b3JpbyBkZSBkYXRvcyAtIFBQUCoqIg0KYXV0aG9yOiAiRWlsaW4gTHVuYSBNLiINCmRhdGU6ICIxMi9NYXlvLzIwMjEiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpgYGB7cn0NCmxpYnJhcnkoc3BhdHN0YXQpDQpgYGANCg0KIyMgKipJbnRlbnNpZGFkKioNCg0KIyMjICoqSW50ZW5zaWRhZCBob21vZ8OpbmVhKioNCg0KQ3VhbmRvIGVuIGN1YWxxdWllciBzdWItcmVnacOzbiBCIGJpZGltZW5zaW9uYWwgZWwgbsO6bWVybyBlc3BlcmFkbyBkZSBwdW50b3MgZGUgWCBxdWUgY2FlbiBlbiBCIGVzIHByb3BvcmNpb25hbCBhbCDDoXJlYSBkZSBCLg0KDQpFbCBlc3RpbWFkb3IgZGUgbGEgaW50ZW5zaWRhZCBwdWVkZSBzZXIgY29tcHV0YWRvIHVzYW5kbyBsYXMgZnVuY2lvbmVzIOKAnG5wb2ludHPigJ0geSDigJxhcmVhLm93aW7igJ0gbyB1c2FuZG8gbGEgZnVuY2nDs24g4oCcaW50ZW5zaXR5LnBwcOKAnToNCg0KKipFamVtcGxvIDE6KioNCg0KTGEgaW50ZW5zaWRhZCBlc3RpbWFkYSBlcyAwLjAwNzQgw6FyYm9sZXMgcG9yIGRlY8OtbWV0cm8gY3VhZHJhZG8uIA0KDQpgYGB7cn0NCmRhdGEoc3dlZGlzaHBpbmVzKQ0KaW50ZW5zaXR5KHN3ZWRpc2hwaW5lcykNCnVuaXRuYW1lKHN3ZWRpc2hwaW5lcykNCmludGVuc2l0eShyZXNjYWxlKHN3ZWRpc2hwaW5lcykpDQpwbG90KHN3ZWRpc2hwaW5lcykNCmBgYA0KDQoNCioqRWplbXBsbyAyKioNCg0KU2kgZWwgcGF0csOzbiBkZSBwdW50b3MgZXMgbcO6bHRpcGxlIGVudG9uY2VzIGxhIGZ1bmNpw7NuIOKAnGludGVuc2l0eS5wcHDigJ0gcmV0b3JuYSB1biB2ZWN0b3IgZGUgaW50ZW5zaWRhZGVzLCB1bmEgcGFyYSBjYWRhIHRpcG8uIA0KDQpgYGB7ciBwYWdlZC5wcmludD1GQUxTRX0NCmRhdGEoYW1hY3JpbmUpDQppbnRlbnNpdHkoYW1hY3JpbmUpDQp1bml0bmFtZShhbWFjcmluZSkNCnN1bW1hcnkoYW1hY3JpbmUpDQpzdW0oaW50ZW5zaXR5KGFtYWNyaW5lKSkNCnBsb3QoYW1hY3JpbmUpDQpgYGANCg0KIyMjICoqQ29udGVvIGRlIGN1YWRyYW50ZXMqKg0KDQpVbmEgZm9ybWEgc2VuY2lsbGEgZGUgdmVyaWZpY2FyIGxhIGZhbHRhIGRlIGhvbW9nZW5laWRhZCBlcyBwcm9iYXIgc2kgbGFzIHJlZ2lvbmVzIGRlIGlndWFsIMOhcmVhIGNvbnRpZW5lbiBhcHJveGltYWRhbWVudGUgZWwgbWlzbW8gbsO6bWVybyBkZSBwdW50b3MsIGNvbW8gZGViZSBlc3BlcmFyc2UgZW4gdW4gcHJvY2VzbyBwdW50dWFsIGhvbW9nw6luZW8uDQoNCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQpzd3AgPSByZXNjYWxlKHN3ZWRpc2hwaW5lcykNClEzID0gcXVhZHJhdGNvdW50KHN3cCwgbng9Mywgbnk9NCkNClEzDQpwbG90KGludGVuc2l0eSAoUTMsIGltYWdlPVQpKQ0KcGxvdChRMywgYWRkPVQpDQpwbG90KHN3cCwgYWRkPVQpDQpgYGANCg0KIyMjICoqVGVzdCBkZSBob21vZ2VuZWlkYWQqKg0KDQpgYGB7cn0NCiMgUHJ1ZWJhIENoaS1jdWFkcmFkYQ0KIyoqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioNCiMgSDA6IExhIGludGVuc2lkYWQgZXMgaG9tb2dlbmVhDQojIEhhOiBMYSBpbnRlbnNpZGFkIGVzIG5vIGhvbW9nZW5lYQ0KIyBTaSBwPGEgZW50b25jZXMgcmVjaGF6YW1vcyBIMC4NCiMqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqDQp0UyA9IHF1YWRyYXQudGVzdChzd3AsIDMsIDMpDQp0Uw0KcGxvdChzd3ApDQpwbG90KHRTLCBhZGQ9VCkNCmBgYA0KKiBEYWRvIHF1ZSAgMC40MT4wLjA1IE5vIHJlY2hhemFtb3MgbGEgaGlww7N0ZXNpcyBudWxhLCB5IGxhIGludGVuc2lkYWQgZXMgaG9tb2fDqW5lYS4NCg0KIyMjICoqRXN0aW1hY2nDs24gdXNhbmRvIGtlcm5lbCoqDQoNCkxhIGZ1bmNpw7NuIGludGVuc2lkYWQgcHVlZGUgc2VyIGVzdGltYWRhIHVzYW5kbyB1bmEgZnVuY2nDs24ga2VybmVsLiBDb24gc3BhdHN0YXQgdXRpbHphbW9zIGxhIGZ1bmNpw7NuIGRlbnNpdHksIHBvciBkZWZlY3RvLCB1dGlsaXphbW9zIHVuIGtlcm5lbCBnYXVzc2lhbm8sIGNvbiBlbCBhbmNobyBkZSBiYW5kYSBkZSBzdWF2aXNhZG8gZGV0ZXJtaW5hZG8gcG9yIGVsIGFyZ3VtZW50byBzaWdtYS4gUG9yIGRlZmVjdG8gc2UgdXRpbGl6YSBsYSBjb3JyZWNjacOzbiB1bmlmb3JtZSwgeSBsYSBzYWxpZGEgZXMgdW5hIGltYWdlbiBpbS4NCg0KYGBge3J9DQpEID0gZGVuc2l0eShzd2VkaXNocGluZXMpDQpwbG90KEQpDQpwbG90KHN3ZWRpc2hwaW5lcywgYWRkPVQpDQpjb250b3VyKEQsIGFkZD1UKQ0KcGVyc3AoRCwgdGhldGE9IDMwLCBwaGkgPSAzMCwgY29sID0gImxpZ2h0Ymx1ZSIpDQpgYGANCg0KU2lnbWEgY29udHJvbGEgZWwgZ3JhZG8gZGVsIHN1YXZpc2FkbzoNCg0KYGBge3J9DQpEMDUgPSBkZW5zaXR5KHN3ZWRpc2hwaW5lcywgc2lnbWE9MC41KQ0KRDEgPSBkZW5zaXR5KHN3ZWRpc2hwaW5lcywgc2lnbWE9MSkNCkQxNSA9IGRlbnNpdHkoc3dlZGlzaHBpbmVzLCBzaWdtYT0xLjUpDQpgYGANCg0KYGBge3IgZWNobz1GQUxTRX0NCnBhcihtZnJvdz1jKDEsMykpIA0KcGxvdChEMDUsIG1haW49InNpZ21hPTAuNSIpDQpwbG90KHN3ZWRpc2hwaW5lcywgYWRkPVQpDQpjb250b3VyKEQwNSwgYWRkPVQpDQoNCnBsb3QoRDEsIG1haW49InNpZ21hPTEiKQ0KcGxvdChzd2VkaXNocGluZXMsIGFkZD1UKQ0KY29udG91cihEMSwgYWRkPVQpDQoNCnBsb3QoRDE1LCBtYWluPSJzaWdtYT0xLjUiKQ0KcGxvdChzd2VkaXNocGluZXMsIGFkZD1UKQ0KY29udG91cihEMTUsIGFkZD1UKQ0KYGBgDQoNCiMjIyAqKlNlbGVjY2lvbmFuZG8gYW5jaG8gZGUgYmFuZGEgYncqKg0KDQoNCmBgYHtyfQ0KIyBTZWxlY2Npb25hbmRvIGFuY2hvIGRlIGJhbmRhIGJ3DQpidyA9IGJ3LnBwbCAocmVzY2FsZShzd2VkaXNocGluZXMpKQ0KYncNCnBsb3QoYncpDQpgYGANCg0KIyMjICoqQ3VhZHJhbnRlcyBlc2NvZ2lkb3MgcG9yIHVuYSBjb3ZhcmlhYmxlKioNCg0KKipOdWV2b3MgZGF0b3M6IGJlaSoqICANClVuIHBhdHLDs24gZGUgcHVudG9zIHF1ZSBtdWVzdHJhIGxhIHViaWNhY2nDs24gZGUgMzYwNSDDoXJib2xlcyBlbiB1bmEgc2VsdmEgdHJvcGljYWwuIEFjb21wYcOxYWRvIGRlIGRhdG9zIGRlIGNvdmFyaWFibGVzIHF1ZSBkYW4gbGEgZWxldmFjacOzbiAoYWx0aXR1ZCkgeSBwZW5kaWVudGUgZGUgZWxldmFjacOzbiBlbiBsYSByZWdpw7NuIGRlIGVzdHVkaW8NCg0KYGBge3J9DQpkYXRhKGJlaSkNCmNsYXNzKGJlaSkNCmJlaQ0KDQpgYGANCg0KKipJbnRlbnNpZGFkIHVzYW5kbyBrZXJuZWwqKg0KDQpgYGB7cn0NCiMgSW50ZW5zaWRhZCB1c2FuZG8ga2VybmVsDQppbnRlbnNpdHkoYmVpKQ0KRCA9IGRlbnNpdHkoYmVpKQ0KcGxvdChEKQ0KcGxvdChiZWksIGFkZD1UKQ0KY29udG91cihELCBhZGQ9VCwgY29sPSJ3aGl0ZSIpDQpgYGANCg0KKipDb3ZhcmlhYmxlIGVsZXZhY2nDs24qKg0KYGBge3J9DQojIENvdmFyaWFibGUNCmVsZXYgPSBiZWkuZXh0cmEkZWxldg0KY2xhc3MoZWxldikNCnBsb3QoZWxldikNCnBsb3QoYmVpLCBhZGQ9VCkNCmBgYA0KKipEaXZpZGllbmRvIGxhIGNvdmFyaWFibGUgZW4gNCBjdWFudGlsZXMgaWd1YWxlcyoqDQoNCmBgYHtyfQ0KIyBEaXZpZGllbmRvIGxhIGNvdmFyaWFibGUgZW4gNCBjdWFudGlsZXMgaWd1YWxlcw0KYiA9IHF1YW50aWxlKGVsZXYsIHByb2JzID0gKDA6NCkvNCwgdHlwZSA9IDIpDQpaY3V0ID0gY3V0KGVsZXYsIGJyZWFrcyA9IGIsIGxhYmVscyA9IDE6NCkNClYgPSB0ZXNzKGltYWdlPVpjdXQpDQp0ZXh0dXJlcGxvdCAoVikNCnBsb3QoVikNCmBgYA0KDQoNCioqQ29udGVvIHBvciBjdWFkcmFudGUqKg0KYGBge3J9DQojIENvbnRlbyBwb3IgY3VhZHJhbnRlDQpxYiA9IHF1YWRyYXRjb3VudChiZWksIHRlc3MgPSBWKQ0KcWINCmBgYA0KDQoNCg0KDQoNCg0KIyAqKkVqZXJjaWNpbyoqDQoNClJlYWxpemFyIGxvIGFudGVyaW9yIGNvbiBsb3MgZGF0b3MgZGUgTWVkZWxsw61uLg0KYGBge3IgZWNobz1GQUxTRX0NCnBsb3QoUykNClMNCmBgYA0KDQoqKjEuIENvbnRlbyBkZSBjdWFkcmFudGVzKioNCmBgYHtyfQ0KIyBDb250ZW8gZGUgY3VhZHJhbnRlczoNClEzUyA9IHF1YWRyYXRjb3VudChTLCBueD0zLCBueT00KQ0KUTNTDQpgYGANCg0KYGBge3IgZWNobz1GQUxTRX0NCnBsb3QoaW50ZW5zaXR5IChRM1MsIGltYWdlPVQpKQ0KcGxvdChTLCBhZGQ9VCkNCnBsb3QoUTNTLCBhZGQ9VCwgY29sPSJ3aGl0ZSIpDQpgYGANCg0KDQoNCg0KYGBge3J9DQojIFRlc3QgZGUgaG9tb2dlbmVpZGFkDQp0UzEgPSBxdWFkcmF0LnRlc3QoUywgMywgNCkNCnRTMSANCmBgYA0KDQoqIERhZG8gcXVlIHAgZXMgbWVub3IgcXVlIDAuMDUsIHJlY2hhemFtb3MgbGEgaGlww7N0ZXNpcyBudWxhLCB5IHBvciBlbmRlLCBsYSBpbnRlbnNpZGFkIGVzIG5vIGhvbW9nw6luZWEuDQoNCioqMi4gRXN0aW1hY2nDs24gdXNhbmRvIGtlcm5lbCoqDQoNCmBgYHtyfQ0KRDEgPSBkZW5zaXR5KFMpDQpwbG90KEQxKQ0KcGxvdChTLCBhZGQ9VCkNCmNvbnRvdXIoRDEsIGFkZD1ULCBjb2w9IndoaXRlIikNCmBgYA0KDQoNCg0KDQoNCg==