Учитывая номер координаты в тепловой карте - PullRequest
Новая
       11

Учитывая номер координаты в тепловой карте

1 голос
/ 21 октября 2019

Я пытаюсь создать тепловую карту, учитывая значение точки (переменная 'x'). Но когда я запускаю свой код, у меня есть только тепловая карта, учитывающая точки, а не ее значения.

Вот мой код: 

head(dengue)

 lat     long    x
1 7791000 598157.0  156
2 7790677 598520.0  307
3 7790795 598520.0  153
4 7790153 598808.0  135
5 7790935 598813.0 1888
6 7790765 598881.7 1169

library(ggplot2)
library(ggsn)

hmap <- ggplot(dengue, aes(x=long, y=lat)) + 
          stat_density2d(aes(fill = ..level..), alpha=0.8, geom="polygon") +
          geom_point(colour="red") +
          geom_path(data=map.df,aes(x=long, y=lat,group=group), colour="grey50") +
          scale_fill_gradientn(colours=rev(brewer.pal(5,"Spectral"))) +
          coord_fixed() + 
          scalebar(location="bottomright",y.min=7781600.0, y.max=7812898.0, 
                                          x.min=597998.4, x.max=619721.2, 
                                          dist=2,  transform = F,                    
                                          st.dist=.04,dist_unit="km") + 
         blank() + 
         guides(fill=guide_legend(title=""))

north2(hmap, x=.7, y=.9, symbol=16)

А вот карта, которую яполучил:

enter image description here

Любой намек на то, как я могу создать тепловую карту, учитывая значения точек (переменная 'x'), а не только их координаты

1 Ответ

1 голос
/ 22 октября 2019

Был пост здесь , который описывает адаптацию функции kde2d пакета MASS для учета веса точек. 

library(MASS)

kde2d.weighted <- function (x, y, w, h, n = 25, lims = c(range(x), range(y))) {
  nx <- length(x)
  if (length(y) != nx) 
    stop("data vectors must be the same length")
  gx <- seq(lims[1], lims[2], length = n) # gridpoints x
  gy <- seq(lims[3], lims[4], length = n) # gridpoints y
  if (missing(h)) 
    h <- c(bandwidth.nrd(x), bandwidth.nrd(y));
  if (missing(w)) 
    w <- numeric(nx)+1;
  h <- h/4
  ax <- outer(gx, x, "-")/h[1] # distance of each point to each grid point in x-direction
  ay <- outer(gy, y, "-")/h[2] # distance of each point to each grid point in y-direction
  z <- (matrix(rep(w,n), nrow=n, ncol=nx, byrow=TRUE)*matrix(dnorm(ax), n, nx)) %*% t(matrix(dnorm(ay), n, nx))/(sum(w) * h[1] * h[2]) # z is the density
  return(list(x = gx, y = gy, z = z))
}

Это не встроено в ggplot2 какНасколько я знаю, но вы можете предварительно обработать ваши данные вне ggplot, чтобы получить данные, которые вы можете поместить в stat_contour: 

# Reading in your example data
zz <- " lat     long    x
1 7791000 598157.0  156
2 7790677 598520.0  307
3 7790795 598520.0  153
4 7790153 598808.0  135
5 7790935 598813.0 1888
6 7790765 598881.7 1169"
df <- read.table(text = zz)

# Doing the weighted 2d kde
wdf <- kde2d.weighted(df$lat, df$long, df$x)
wdf <- data.frame(lat = wdf$x[row(wdf$z)],
                  long = wdf$y[col(wdf$z)],
                  value = wdf$z[T])


# Plotting the result:
ggplot(df, aes(lat, long)) +
  stat_contour(data = wdf, aes(z =  value, fill = stat(level)), geom = "polygon") +
  geom_text(aes(label = x)) # to show the weights

enter image description here

Как видите, контуры немного обрезаны в уродливых точках, но я полагаю, что это можно исправить, поиграв с аргументом lims kde2d.weighted().

...