Skip to content

[R-es] RV: Mapa de Calor con Google Maps de fondo

1 message · Gilsanz, Jose Luis

Original
Gilsanz, Jose Luis
# 
Hola :

De momento el problema lo he resuelto, en parte, fuera de R, aunque quiero ver a fondo las soluciones que me propones, sobre datos reales, porque tienen una pinta estupenda. ;-)

Como lo que busco es convertir una serie de coordenadas geográficas (puntos) en una ?malla? de superficies el usar el método MBA me va bien.
Jugando con la resolución del MBA obtengo una malla más o menos detallada según necesito, luego utilizo un código html (de ahí que diga que lo he resuelto fuera de R) para superponer el png generado a partir de la malla MBA sobre GoogleMaps.
De esta manera obtengo un html dinámico que me permite, entre otras cosas, hacer zoom sobre el mapa de calor.

El código que uso para generar el png es básicamente el que tu indicas al principio:
##Cargamos datos
datos <- readWorksheet(wb,'Datos',colTypes = c('numeric','numeric','numeric','character','character','character','character'),header=TRUE)

##Calculamos aproximacion de superficies segun coordenadas y valores
d <- datos[, c(1,2,3)]
superf <- mba.surf(d, resolucion, resolucion,extend=FALSE)$xyz.est

##Mapa de calor segun valores de Z en (x,y) con leyenda, sin  ejes y sin fondo
png(filename = paste(fichero,sep=''),width = ancho , height = alto, units='px')

##Ajustamos parametros graficos y generamos PNG
x<-par()
par(mar=c(0,0,1.1,0.2))
image.plot(superf, bg= NULL, axes=FALSE, nlevel = niveles,  main = 'Titulo de Pruebas')
par(x)

dev.off()


La aproximación que indicas por densidad, replicando en frecuencias, el valor de la z  también la había sopesado, pero me temo que va a haber una fase 2 de esto en la que necesitare los datos sin transformar, además de que no me parece una solución muy elegante.
Estoy seguro de que hay alguna manera de obtener esto sin tener que ?emular? la distribución de densidad a partir de los valores de z, pero esto lo dejo para cuando ande un poquito menos saturado de trabajo.

Muchas gracias por vuestros aportes a todos.

PD: Para los que controlen de javascript y html Google dispone de una API para generar ?directamente? mapas de calor, lo podeis ver aquí;
https://developers.google.com/maps/documentation/javascript/heatmaplayer



De: Javier Villacampa González [mailto:javier.villacampa.gonzalez en gmail.com]
Enviado el: sábado, 24 de octubre de 2015 17:34
Para: r-help-es-request en r-project.org<mailto:r-help-es-request en r-project.org>; Gilsanz, Jose Luis
Asunto: Re: Mapa de Calor con Google Maps de fondo

Le he estado dando vueltas a tu problema, yo en su día lo que hacía era crear tantos puntos como había en x e y. Con MBA lo que estas creando es el spline que pasa por las tres coordenas. Si quieres esa aproximación no he encontrado nada para tu problema. Aunque dudo mucho que quieras dibujar un spline, o más bien creo que te da lo mismo dibujar un spline o una densidad.

Para solventar el problema con densidades lo que he hecho yo clásicamente ha sido repetir los puntos (x,y) tantas veces como aparezca z. No es la mejor solución , pero creo que te puede valer y depende lo que quieras representar en el mapa es mejor solución que un spline.
No se si esta solución te valdrá (pruebala y nos cuentas, entiendo que nada es optimo pero algo espero ayudarte):


###################################################
library(dplyr)
library(data.table)
library(jpeg)
library(ggplot2)
library(png)
library(grid)

x_coord <- c(1,2,3,4)
y_coord <- c(1,2,3,4)
value <- c(12,15,19,30)
foo <- data.frame(x_coord, y_coord, value)
library(MBA)
foo=foo[ order(foo[,1], foo[,2],foo[,3]), ]
mba.int<http://mba.int> <- mba.surf(foo, 300, 300, extend=T)$xyz.est
library(fields)
fields::image.plot(mba.int<http://mba.int>)



data <- foo
varInteger_Txt <- "value"
varX_Txt <- "x_coord"
varY_Txt <- "y_coord"

tranform <- function(data, varInteger_Txt, varX_Txt, varY_Txt){
  data <- data[, c(varInteger_Txt, varX_Txt, varY_Txt)]

  Original_values <- nrow(data)
  data <- data[ !duplicated(data[,varX_Txt], data[,varY_Txt]),]
  Final_values <- nrow(data)

  if(Original_values != Final_values){
    warning("You add repited values please check your data set")
  }


  data[,varInteger_Txt ] <- as.integer(data[,varInteger_Txt ])
  Number_of_Repetitions <- data[,varInteger_Txt ] %>% table %>% names %>% as.integer()

  data <-
    data[rep(row.names(data), data[ , varInteger_Txt]), c(varX_Txt, varY_Txt) ]
  return(data)

}

varInteger_Txt <- "value"
varX_Txt <- "x_coord"
varY_Txt <- "y_coord"
foo2 <- tranform(data =  foo %>% data.frame,
                 varX_Txt = "x_coord",
                 varY_Txt = "y_coord",
                 varInteger_Txt = "value")


# S solución uno ----------------------------------------------------------
p <-
  ggplot(foo2, aes(x = x_coord, y = y_coord)) +
  stat_density2d(data= foo2, aes(x= x_coord, y= y_coord, fill = ..level.., alpha = ..level..),
                 size= 10, bins= 50, geom='polygon') +
  geom_point(data= foo2, aes(x= x_coord, y= y_coord),  # coordinates
             color="black", # Color point
             position=position_jitter(w=0.1,h=0.1), # Point plot desviation
             alpha=0.1) + # Point transaparecen

  theme_bw() + # Kind of theme. I strongly recomend theme_bw

  scale_fill_gradient( low = "green",  # Lowest color value
                       high = "red" # High color value

  ) +
  scale_alpha_continuous(range=c(0.0, 001) , guide = FALSE) + # You can play with the range to show a better image. Range belongs to [0, 1] interval
  xlim(0, 4) + # Control lim for x-axe
  ylim(0, 4) # Control lim for y-axe
print(p)
# E solución uno ----------------------------------------------------------



# S solución dos ----------------------------------------------------------
colfunc <- colorRampPalette(c("darkblue", "lightblue", "green", "yellow", "red"))
ggplot(foo2, aes(x = x_coord, y = y_coord)) +
  stat_density2d(geom="tile", aes(fill = ..density.., alpha = ..level..), contour = FALSE) +
  scale_fill_gradientn(colours=colfunc(400)) +
  scale_alpha(guide =F) +
  xlim(c(0, 5)) + ylim(c(0, 5)) +
  # geom_density2d(colour="black", bins=10) +
  geom_point() +
  guides(fill = guide_colorbar(barwidth = 0.5, barheight = 10)) +
  theme(legend.title=element_blank())
# E solución dos ----------------------------------------------------------

# S solucion 3 ------------------------------------------------------------
colfunc <- colorRampPalette(c("darkblue", "lightblue", "green", "yellow", "red"))
ggplot(foo2, aes(x = x_coord, y = y_coord)) +
  annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
  stat_binhex(bins = 100, colour = "gray", alpha = 0.5) +
  scale_fill_gradientn(colours=colfunc(400)) +
  scale_alpha(guide =F) +
  xlim(c(0, 5)) + ylim(c(0, 5)) +
  # geom_density2d(colour="black", bins=10) +
  geom_point(data= foo2, aes(x= x_coord, y= y_coord),  # coordinates
             color="black", # Color point
             position=position_jitter(w=0.1,h=0.1), # Point plot desviation
             alpha=0.1) +
  guides(fill = guide_colorbar(barwidth = 0.5, barheight = 10)) +
  theme(legend.title=element_blank())

colfunc <- colorRampPalette(c("darkblue", "lightblue", "green", "yellow", "red"))
ggplot(foo2, aes(x = x_coord, y = y_coord)) +
  annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
  stat_bin2d(bins = 6, colour = "gray", alpha = 0.5) +
  scale_fill_gradientn(colours=colfunc(400)) +
  scale_alpha(guide =F) +
  xlim(c(0, 5)) + ylim(c(0, 5)) +
  # geom_density2d(colour="black", bins=10) +
  geom_point(data= foo2, aes(x= x_coord, y= y_coord),  # coordinates
             color="black", # Color point
             position=position_jitter(w=0.1,h=0.1), # Point plot desviation
             alpha=0.1) +
  guides(fill = guide_colorbar(barwidth = 0.5, barheight = 10)) +
  theme(legend.title=element_blank())
# E solucion 3 ------------------------------------------------------------
--
[https://lh6.googleusercontent.com/-OmJSTAIo4J4/UW01N1mJAeI/AAAAAAAAABk/NYyJQ0fT4B4/h120/526620_580124745341874_542437733_n.jpg]