MCultivos
Brandon Solano
2026-09-30
#Librerias para modelacion espacial spdep - spatstat
library(spdep)## Warning: package 'spdep' was built under R version 4.5.3## Cargando paquete requerido: spData## To access larger datasets in this package, install the spDataLarge
## package with: `install.packages('spDataLarge',
## repos='https://nowosad.github.io/drat/', type='source')`## Cargando paquete requerido: sf## Linking to GEOS 3.13.1, GDAL 3.11.0, PROJ 9.6.0; sf_use_s2() is TRUElibrary(spatstat)## Warning: package 'spatstat' was built under R version 4.5.3## Cargando paquete requerido: spatstat.data## Warning: package 'spatstat.data' was built under R version 4.5.3## Cargando paquete requerido: spatstat.univar## Warning: package 'spatstat.univar' was built under R version 4.5.3## spatstat.univar 3.2-0## Cargando paquete requerido: spatstat.geom## Warning: package 'spatstat.geom' was built under R version 4.5.3## spatstat.geom 3.8-3## Cargando paquete requerido: spatstat.random## Warning: package 'spatstat.random' was built under R version 4.5.3## spatstat.random 3.5-2## Cargando paquete requerido: spatstat.explore## Warning: package 'spatstat.explore' was built under R version 4.5.3## Cargando paquete requerido: nlme## spatstat.explore 3.8-3## Cargando paquete requerido: spatstat.model## Warning: package 'spatstat.model' was built under R version 4.5.3## Cargando paquete requerido: rpart## spatstat.model 3.7-2## Cargando paquete requerido: spatstat.linnet## Warning: package 'spatstat.linnet' was built under R version 4.5.3## spatstat.linnet 3.5-4##
## spatstat 3.6-3
## For an introduction to spatstat, type 'beginner'data(swedishpines)
X <- swedishpines
plot(X)
class(X)## [1] "ppp" X## Planar point pattern: 71 points
## window: rectangle = [0, 96] x [0, 100] units (one unit = 0.1 metres)summary(X)## Planar point pattern: 71 points
## Average intensity 0.007395833 points per square unit (one unit = 0.1 metres)
##
## Coordinates are integers
## i.e. rounded to the nearest unit (one unit = 0.1 metres)
##
## Window: rectangle = [0, 96] x [0, 100] units
## Window area = 9600 square units
## Unit of length: 0.1 metres#intensidad de puntos por unidad de area = Densidad
plot(density(X, 16))
#imagen tipo kernel descri´tivo para suavisar los puntos
library(shiny)
library(spatstat)
# Cargar los datos de los pinos suecos
data(swedishpines)
X <- swedishpines
ui <- fluidPage(
titlePanel("Densidad Interactiva de Swedish Pines"),
sidebarLayout(
sidebarPanel(
sliderInput("sigma",
"Ancho de banda (Sigma / Suavizado):",
min = 1,
max = 50,
value = 16,
step = 1),
hr(),
helpText("Modifica el valor de sigma para cambiar la intensidad y suavizado de los puntos por unidad de área.")
),
mainPanel(
plotOutput("densityPlot"),
br(),
verbatimTextOutput("summaryText")
)
)
)
server <- function(input, output) {
output$densityPlot <- renderPlot({
# Graficar la densidad basada en el sigma interactivo
plot(density(X, sigma = input$sigma), main = paste("Densidad de Puntos (Sigma =", input$sigma, ")"))
# Superponer los puntos originales para mejor visualización
plot(X, add = TRUE, cols = "white", pch = 16, cex = 0.6)
})
output$summaryText <- renderPrint({
summary(X)
})
}
shinyApp(ui = ui, server = server)Shiny applications not supported in static R Markdown documents
#shiny con contorno y con suavisado de colores
#contour(density(X, 10), axes = FALSE) CONTORNO
library(shiny)
library(spatstat)
# Cargar los datos de los pinos suecos
data(swedishpines)
X <- swedishpines
ui <- fluidPage(
titlePanel("Densidad y Contornos Interactivos de Swedish Pines"),
sidebarLayout(
sidebarPanel(
sliderInput("sigma",
"Ancho de banda (Sigma):",
min = 1,
max = 50,
value = 10, # Iniciamos en 10 según tu nuevo ejemplo
step = 1),
checkboxInput("show_points", "Mostrar puntos de los pinos", TRUE),
checkboxInput("show_contour", "Mostrar líneas de contorno", TRUE),
hr(),
helpText("Ajusta el sigma para recalcular la densidad, los contornos y observar los cambios en tiempo real.")
),
mainPanel(
plotOutput("densityPlot"),
br(),
verbatimTextOutput("summaryText")
)
)
)
server <- function(input, output) {
output$densityPlot <- renderPlot({
# 1. Calcular la densidad basada en el sigma interactivo
dens <- density(X, sigma = input$sigma)
# 2. Graficar la densidad base (mapa de calor)
plot(dens, main = paste("Densidad, Contornos y Puntos (Sigma =", input$sigma, ")"))
# 3. Superponer las líneas de contorno si la opción está activa
if (input$show_contour) {
contour(dens, add = TRUE, axes = FALSE, col = "black", lwd = 1.2)
}
# 4. Superponer los puntos originales si la opción está activa
if (input$show_points) {
plot(X, add = TRUE, cols = "white", pch = 16, cex = 0.7)
}
})
output$summaryText <- renderPrint({
summary(X)
})
}
shinyApp(ui = ui, server = server)Shiny applications not supported in static R Markdown documents
library(shiny)
library(spatstat)
# Cargar los datos de los pinos suecos
data(swedishpines)
X <- swedishpines
ui <- fluidPage(
titlePanel("Análisis Espacial Interactivo: Cuadrantes y Densidad"),
sidebarLayout(
sidebarPanel(
h4("Configuración de Cuadrantes"),
sliderInput("nx", "Cuadrantes Horizontales (nx):", min = 1, max = 10, value = 4),
sliderInput("ny", "Cuadrantes Verticales (ny):", min = 1, max = 10, value = 3),
hr(),
h4("Configuración de Densidad"),
sliderInput("sigma", "Ancho de banda (Sigma):", min = 1, max = 50, value = 16),
checkboxInput("show_density", "Mostrar mapa de densidad", TRUE),
checkboxInput("show_contour", "Mostrar líneas de contorno", FALSE),
hr(),
h4("Personalización de Colores"),
selectInput("col_density", "Paleta de Densidad:",
choices = list("Térmico (Heat)" = "heat",
"Terreno (Terrain)" = "terrain",
"Topográfico (Topo)" = "topo",
"Gris (Gray)" = "gray")),
selectInput("col_text", "Color de los Números (Conteo):",
choices = c("Red" = "red", "Black" = "black", "Blue" = "blue", "Yellow" = "yellow")),
selectInput("col_points", "Color de los Pinos (Puntos):",
choices = c("White" = "white", "Dark Green" = "darkgreen", "Black" = "black", "Orange" = "orange")),
hr(),
helpText("Modifica los parámetros para observar los cambios en tiempo real.")
),
mainPanel(
plotOutput("spatialPlot", height = "600px"),
br(),
h4("Matriz de Conteo por Cuadrantes:"),
verbatimTextOutput("quadratTable")
)
)
)
server <- function(input, output) {
# Asignar la paleta de colores seleccionada para la densidad
get_palette <- reactive({
switch(input$col_density,
"heat" = heat.colors(256),
"terrain" = terrain.colors(256),
"topo" = topo.colors(256),
"gray" = gray.colors(256))
})
output$spatialPlot <- renderPlot({
# 1. Calcular densidad y cuadrantes de forma interna
dens <- density(X, sigma = input$sigma)
Q <- quadratcount(X, nx = input$nx, ny = input$ny)
# 2. Dibujar la capa base (Densidad o Fondo Blanco)
if (input$show_density) {
plot(dens, main = "Análisis Espacial Combinado", col = get_palette())
} else {
plot(X$window, main = "Análisis Espacial Combinado")
}
# 3. Superponer líneas de contorno si está activo
if (input$show_contour) {
contour(dens, add = TRUE, axes = FALSE, col = "black", lwd = 1.2)
}
# 4. Superponer los cuadrantes y el color del texto personalizado
# Usamos text.args para cambiar dinámicamente el color del conteo numérico
plot(Q, add = TRUE, text.args = list(col = input$col_text, cex = 1.5, font = 2))
# 5. Superponer los puntos originales de los pinos
plot(X, add = TRUE, cols = input$col_points, pch = 16, cex = 0.8)
})
output$quadratTable <- renderPrint({
quadratcount(X, nx = input$nx, ny = input$ny)
})
}
shinyApp(ui = ui, server = server)Shiny applications not supported in static R Markdown documents
#Puntos para determianr la disperción de las enfermedades (puntos), por encima de la curva sera agrupada, por debajo de la curva sera dispersa, para que sea aleatoria, se encontrara sobrepuesta en la curva
# la K de Ripley
#"\(\^{K}(t)=\frac{A}{n^{2}}\sum _{i=1}^{n}\sum _{j\ne i}^{n}w_{ij}\cdot I(d_{ij}\le t)\)"
# corrreción de borde,
K <- Kest(X)
plot(K)
# la K de ripley solamnete me permite evaluar si los datos se observan en aleatorio, agrupado, independiente
#La k de ripley cruzada me permite evaluar la coocurencia de dos eventos # para capturar coordenadas dentro de unas imagenes
library(shiny)
library(spatstat)
# Interfaz de Usuario
ui <- fluidPage(
titlePanel("Extractor Interactivo de Daño: Hoja Pixelada (Tipo Minecraft)"),
sidebarLayout(
sidebarPanel(
p(strong("Instrucciones de uso:")),
helpText("1. Observa la hoja pixelada al estilo Minecraft en el lienzo."),
helpText("2. Haz clic directamente sobre cualquier cuadro (píxel) de la hoja donde consideres que se concentra el daño."),
helpText("3. Las coordenadas exactas del centro de la celda se extraerán e irán acumulando automáticamente en la tabla inferior."),
hr(),
actionButton("limpiar", "Limpiar Puntos Extraídos", class = "btn-danger", style = "width: 100%;")
),
mainPanel(
tabsetPanel(
tabPanel("Extractor Espacial",
plotOutput("plot_hoja", click = "plot_click", height = "550px"),
hr(),
h4("Coordenadas de Daño Extraídas (Historial de Clics):"),
tableOutput("tabla_coordenadas")
)
)
)
)
)
# Servidor de la Aplicación
server <- function(input, output, session) {
# 1. Definición rígida de la Ventana de Patrón de Puntos (owin) y la Hoja Pixelada 20x20
ventana_hoja <- owin(c(0, 20), c(0, 20))
# Generar la matriz base de la hoja (Morfología pixelada tipo Minecraft)
grid_base <- expand.grid(x = 0:19, y = 0:19)
# Algoritmo geométrico simple para dibujar el contorno de una hoja simétrica pixelada
# Evaluamos la distancia al "tallo" central y los bordes para darle forma de hoja romboide/ovalada
dist_eje_central <- abs(grid_base$x - 9.5)
dist_base <- grid_base$y
# Condición lógica para activar los píxeles que forman el cuerpo de la hoja
es_hoja <- (dist_base >= 2 & dist_base <= 17) & (dist_eje_central <= (10 - abs(dist_base - 10) * 0.6))
# Reactivo para almacenar las coordenadas seleccionadas interactivamente por el usuario
coordenadas_clic <- reactiveVal(data.frame(ID = integer(), X_Celda = numeric(), Y_Celda = numeric()))
# Escuchar los clics del usuario sobre el gráfico de la hoja
observeEvent(input$plot_click, {
req(input$plot_click$x, input$plot_click$y)
# Identificar de forma discreta en qué celda 1x1 cayó el clic (Alineación exacta al pixel)
celda_x <- floor(input$plot_click$x) + 0.5
celda_y <- floor(input$plot_click$y) + 0.5
# Validar que el clic esté dentro de los límites de la cuadrícula de la hoja (0 a 20)
if (celda_x >= 0 && celda_x <= 20 && celda_y >= 0 && celda_y <= 20) {
df_actual <- coordenadas_clic()
nuevo_id <- nrow(df_actual) + 1
# Agregar la nueva coordenada extraída al historial reactivo
nuevo_punto <- data.frame(ID = nuevo_id, X_Celda = celda_x, Y_Celda = celda_y)
coordenadas_clic(rbind(df_actual, nuevo_punto))
}
})
# Botón para reiniciar/limpiar la extracción de puntos
observeEvent(input$limpiar, {
coordenadas_clic(data.frame(ID = integer(), X_Celda = numeric(), Y_Celda = numeric()))
})
# --- RENDERIZAR MAPA DE LA HOJA PIXELADA ---
output$plot_hoja <- renderPlot({
# Inicializar lienzo plano simétrico cuadrado
plot(NA, xlim = c(0, 20), ylim = c(0, 20),
main = "Diseño de la Hoja en Ventana Espacial\n(Haz clic para marcar las coordenadas del daño)",
xlab = "Eje X (Pixel)", ylab = "Eje Y (Pixel)", asp = 1)
# Fondo gris que simula el vacío exterior de la ventana
rect(0, 0, 20, 20, col = "#ECEFF1", border = "black", lwd = 2)
# Dibujar la cuadrícula rígida estilo Minecraft (Celdas unitarias)
abline(h = 0:20, v = 0:20, col = "#CFD8DC", lty = 1)
# Pintar los píxeles correspondientes al cuerpo de la hoja (Verde)
hoja_x <- grid_base$x[es_hoja] + 0.5
hoja_y <- grid_base$y[es_hoja] + 0.5
points(hoja_x, hoja_y, pch = 15, col = "#4CAF50", cex = 2.4)
# Pintar de forma distintiva el tallo / nervadura central de la hoja (Verde Oscuro)
tallo_idx <- (grid_base$x == 9 & grid_base$y >= 1 & grid_base$y <= 16) & es_hoja
points(grid_base$x[tallo_idx] + 0.5, grid_base$y[tallo_idx] + 0.5, pch = 15, col = "#2E7D32", cex = 2.4)
# Graficar en tiempo real las coordenadas de daño extraídas por el usuario (Cruces Rojas)
puntos_extraidos <- coordenadas_clic()
if (nrow(puntos_extraidos) > 0) {
points(puntos_extraidos$X_Celda, puntos_extraidos$Y_Celda,
pch = 4, col = "#D32F2F", cex = 2, lwd = 3)
}
})
# --- RENDERIZAR TABLA DE RESULTADOS ---
output$tabla_coordenadas <- renderTable({
puntos_extraidos <- coordenadas_clic()
if (nrow(puntos_extraidos) == 0) {
return(data.frame(Mensaje = "No se han seleccionado coordenadas aún."))
}
puntos_extraidos
})
}
# Ejecutar la aplicación
shinyApp(ui = ui, server = server)Shiny applications not supported in static R Markdown documents
#MODELACIÓN DE PUNTOS = puntos por una unidad de area
#MODELOS HOMOGENEOS Y NO HOMOGENEOS, segun la intensidad de los puntos
#tambien hay modelos para la distribución de puntos
# VARIABLES QUE INFLUEN EN LA DENSIDAD DE PUNTOS - modelos poisson - Variables discretas, hay que contar los puntos (total de los datos)
# Al cambiar el tamaño de ventana se puede ver la intensidad homogena o heterogenaplot (bei) # patron no homogeneo ppm <- patron de puntos modelo
x<- ppm(bei~ 1)
x## Stationary Poisson process
## Fitted to point pattern dataset 'bei'
## Intensity: 0.007208
## Estimate S.E. CI95.lo CI95.hi Ztest Zval
## log(lambda) -4.932564 0.01665742 -4.965212 -4.899916 *** -296.1182# ESTE ES UN MODELO BASICO ME PERMITE DESCRIBIR SI ES HOMGENEO O NO, sin_embargo no de p_valor (no importa)
#modelo simple son coovariables ni intercepto "\[\log (\lambda (u))=\beta _{0}\]"
#long (x)= -4,93library(spatstat)
# 1. Definir la intensidad deseada (lambda) y la ventana espacial
# Vamos a simular una intensidad de 50 puntos por unidad de área
lambda_teorico <- 50
ventana <- owin(c(0, 1), c(0, 1)) # Una ventana cuadrada de 1x1
# 2. Simular el patrón de puntos HOMOGÉNEO
set.seed(42) # Fijamos la semilla para que los resultados sean replicables
X_homogeneo <- rpoispp(lambda = lambda_teorico, win = ventana)
# 3. Graficar el patrón generado
plot(X_homogeneo, main = paste("Patrón de Puntos Homogéneo (n =", X_homogeneo$n, ")"),
pch = 16, cols = "navy")
# 4. Ajustar el modelo PPM Homogéneo
modelo_homogeneo <- ppm(X_homogeneo ~ 1)
print(modelo_homogeneo)## Stationary Poisson process
## Fitted to point pattern dataset 'X_homogeneo'
## Intensity: 59
## Estimate S.E. CI95.lo CI95.hi Ztest Zval
## log(lambda) 4.077537 0.1301889 3.822372 4.332703 *** 31.32016# 5. Ver el resumen detallado para obtener estimaciones y valores p
summary(modelo_homogeneo)## Point process model
## Fitted to data: X_homogeneo
## Fitting method: maximum likelihood
## Model was fitted analytically
## Call:
## ppm.formula(Q = X_homogeneo ~ 1)
## Edge correction: "border"
## [border correction distance r = 0 ]
## --------------------------------------------------------------------------------
## Quadrature scheme (Berman-Turner) = data + dummy + weights
##
## Data pattern:
## Planar point pattern: 59 points
## Average intensity 59 points per square unit
## Window: rectangle = [0, 1] x [0, 1] units
## Window area = 1 square unit
##
## Dummy quadrature points:
## 32 x 32 grid of dummy points, plus 4 corner points
## dummy spacing: 0.03125 units
##
## Original dummy parameters: =
## Planar point pattern: 1028 points
## Average intensity 1030 points per square unit
## Window: rectangle = [0, 1] x [0, 1] units
## Window area = 1 square unit
## Quadrature weights:
## (counting weights based on 32 x 32 array of rectangular tiles)
## All weights:
## range: [0.000326, 0.000977] total: 1
## Weights on data points:
## range: [0.000326, 0.000488] total: 0.0282
## Weights on dummy points:
## range: [0.000326, 0.000977] total: 0.972
## --------------------------------------------------------------------------------
## FITTED :
##
## Stationary Poisson process
##
## ---- Intensity: ----
##
##
## Uniform intensity:
## [1] 59
##
## Estimate S.E. CI95.lo CI95.hi Ztest Zval
## log(lambda) 4.077537 0.1301889 3.822372 4.332703 *** 31.32016
##
## ----------- gory details -----
##
## Fitted regular parameters (theta):
## log(lambda)
## 4.077537
##
## Fitted exp(theta):
## log(lambda)
## 59# busca r una imagen
#extraer las coordenadas de la imagen (identifay)
#correr el modelo para desifrar si es modelo es homogeno o no