確定點擊柵格中點擊的位置，在R

我正在使用shinydashboard在R leaflet地圖上繪製一個大的lat-lon NetCDF raster。當我點擊地圖時，會彈出一個窗口，顯示點擊柵格點的行，列，經緯度位置和值。（請參見下面的可重複代碼）確定點擊柵格中點擊的位置，在R

問題是，如果柵格足夠大，我正在經歷光柵位移。例如，在這裏我點擊了一個應該有一個值的點，但結果是確定的點是上面的點。

我相信這是與事實，通過leaflet使用的光柵投影，而我用它來識別點的原始數據是緯度，經度，因爲單擊點返回爲緯度做 - leaflet。我不能使用投影文件（depth），因爲它的單位是米，而不是度！即使我試圖將這些米重新投射到度數，我也得到了一個轉變。

下面是代碼的基本運行的例子：

#Libraries 
library(leaflet) 
library(raster) 
library(shinydashboard) 
library(shiny) 

#Input data 
download.file("https://www.dropbox.com/s/y9ekjod2pt09rvv/test.nc?dl=0", destfile="test.nc") 
inputFile = "test.nc" 
inputVarName = "Depth" 
lldepth <- raster(inputFile, varname=inputVarName) 
lldepth[Which(lldepth<=0, cells=T)] <- NA #Set all cells <=0 to NA 
ext <- extent(lldepth) 
resol <- res(lldepth) 
projection(lldepth) <- "+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0" 

#Project for leaflet 
depth <- projectRasterForLeaflet(lldepth) 

#Prepare UI 
sbwidth=200 
sidebar <- dashboardSidebar(width=sbwidth) 
body <- dashboardBody(
      box(#https://stackoverflow.com/questions/31278938/how-can-i-make-my-shiny-leafletoutput-have-height-100-while-inside-a-navbarpa 
      div(class="outer",width = NULL, solidHeader = TRUE, tags$style(type = "text/css", paste0(".outer {position: fixed; top: 50px; left: ", sbwidth, "px; right: 0; bottom: 0px; overflow: hidden; padding: 0}")), 
      leafletOutput("map", width = "100%", height = "100%") 
      ) 
     ) 
     ) 
ui <- dashboardPage(
    dashboardHeader(title = "A title"), 
    sidebar, 
    body 
) 
# 
#Server instance 
server <- function(input, output, session) { 
    output$map <- renderLeaflet({#Set extent 
    leaflet() %>% 
     fitBounds(ext[1], ext[3], ext[2], ext[4]) 
    }) 

    observe({#Observer to show Popups on click 
    click <- input$map_click 
    if (!is.null(click)) { 
     showpos(x=click$lng, y=click$lat) 
    } 
    }) 

    showpos <- function(x=NULL, y=NULL) {#Show popup on clicks 
    #Translate Lat-Lon to cell number using the unprojected raster 
    #This is because the projected raster is not in degrees, we cannot use it! 
    cell <- cellFromXY(lldepth, c(x, y)) 
    if (!is.na(cell)) {#If the click is inside the raster... 
     xy <- xyFromCell(lldepth, cell) #Get the center of the cell 
     x <- xy[1] 
     y <- xy[2] 
     #Get row and column, to print later 
     rc <- rowColFromCell(lldepth, cell) 
     #Get value of the given cell 
     val = depth[cell] 
     content <- paste0("X=",rc[2], 
         "; Y=",rc[1], 
         "; Lon=", round(x, 5), 
         "; Lat=", round(y, 5), 
         "; Depth=", round(val, 1), " m") 
     proxy <- leafletProxy("map") 
     #add Popup 
     proxy %>% clearPopups() %>% addPopups(x, y, popup = content) 
     #add rectangles for testing 
     proxy %>% clearShapes() %>% addRectangles(x-resol[1]/2, y-resol[2]/2, x+resol[1]/2, y+resol[2]/2) 
    } 
    } 

    #Plot the raster 
    leafletProxy("map") %>% 
    addRasterImage(depth, opacity=0.8, project=FALSE, group="Example", layerId="Example", colors=colorNumeric(terrain.colors(10), values(depth), na.color = "black")) 
} 


print(shinyApp(ui, server))

我如何能正確識別點，如果光柵是大？

編輯：我也想提供一些額外的鏈接（可能）的相關文檔或問題：

來源

2016-05-30 AF7

啊！我想我通過重新投影點擊數據來實現它的工作。我會試驗然後發表一個答案。 – AF7

我已經發現我可以反駁input$map_click給出的X-Y（lon-lat）位置。在這種情況下，我假設輸入投影是Lon-Lat，但我認爲它不一定非要。它只需要有Lat-Lon單位。

#Set projections 
inputProj <- "+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0" 
leafletProj <- "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +a=6378137 +b=6378137 +towgs84=0,0,0,0,0,0,0 +units=m [email protected] +wktext +no_defs" 
#Note that for some reason "[email protected] +wktext" is very important 
    #as hinted to by other questions and answers linked in my question. 
xy <- SpatialPoints(data.frame(x,y)) 
proj4string(xy) <- inputProj 
xy <- as.data.frame(spTransform(xy, leafletProj)) 
#Get the cell number from the newly transformed metric X and Y. 
cell <- cellFromXY(depth, c(xy$x, xy$y)) 

#At this point, you can also retrace back the center of the cell in 
    #leaflet coordinates, starting from the cell number! 
xy <- SpatialPoints(xyFromCell(depth, cell)) 
proj4string(xy) <- leafletProj 
xy <- as.data.frame(spTransform(xy, inputProj)) 
#Here XY will again be in lat-lon, if you projection says so, 
    #indicating the center of the clicked cell

來源

2016-05-31 18:54:21 AF7

確定點擊柵格中點擊的位置，在R

回答

相關問題