Фильтрация и кластеризация SpatialPointDataFrame в реактиве Shiny не работают - PullRequest
Новая
       25

Фильтрация и кластеризация SpatialPointDataFrame в реактиве Shiny не работают

0 голосов
/ 27 апреля 2018

Этот воспроизводимый код основан на наборе данных meuse из пакета gstat.

Я бы хотел иметь возможность фильтровать набор данных по границам x и y и впоследствии кластеризовать данные. Однако - у меня есть несколько проблем:

  • Первая ошибка, похоже, связана с получением моих координат в правильном формате: не может получить координаты из нечисловой матрицы
  • Вторая сложность заключается в том, как на самом деле назначить кластеризацию на основе входных параметров.

Есть ли лучший способ кластеризации точек из пространственных точек?

КОД: 

library(tidyverse)
library(sp)
library(rgdal)
library(scales)
library(ggthemes)
library(ggalt)

data(meuse)
meuseLL <- spTransform(
  sp::SpatialPointsDataFrame(dplyr::select(meuse, y, x),
                             data = dplyr::select(meuse, -y, -x),
                             proj4string = CRS("+proj=utm +zone=19 ellps=WGS84 +south")),
  CRS("+proj=longlat +ellps=WGS84 +datum=WGS84")
)

# Convert from Eastings and Northings to Latitude and Longitude and rename columns
colnames(meuseLL@coords)[colnames(meuseLL@coords) == "x"] <- "Long"
colnames(meuseLL@coords)[colnames(meuseLL@coords) == "y"] <- "Lat"

meuseLL_df <- as.data.frame(meuseLL)

ui <- fluidPage(  
  titlePanel("Custer Mapper"),
  sidebarLayout(
    sidebarPanel(width = 3,
                 numericInput("x1", label = h5("longitude bottom left (d.deg.)"), value = -87.79302),
                 numericInput("y1", label = h5("latitude bottom left (d.deg.)"), value = -112.92162),
                 numericInput("x2", label = h5("longitude top right (d.deg.)"), value = -87.81127),
                 numericInput("y2", label = h5("latitude top right (d.deg.)"), value = -111.89575),
                 numericInput("cdist", label = h5("Distance (km):"), value = .1),
                 numericInput("dclustn", label = h5("min points in dist cluster"), value = 3)
                 ),
    mainPanel(
      plotOutput("plot1", width="700px",height="700px"))
  ))

    # Define server logic required to draw a histogram
server <- function(input, output, session) {
  F_df <- reactive({
    filter(meuseLL_df, Lat > input$y1 &
                 Lat < input$y2 &
                 Long > input$x1 &
                 Long < input$x2)
      })
  sp_df <- reactive({
    # Convert the data to the right projected coordinate system.
    x <- spTransform(
      sp::SpatialPointsDataFrame(dplyr::select(F_df(), Lat, Long),
                                 data = dplyr::select(F_df(), -Lat, -Long),
                                 proj4string = CRS("+proj=longlat +ellps=WGS84 +datum=WGS84")),
      CRS("+proj=utm +zone=19 ellps=WGS84 +south")
    )
    list(spdata = x@data,  xcoords = coordinates(x)[,1], ycoords = coordinates(x)[,2])

    })
  xy_df <- reactive({
    data.frame(sp_df()$spdata,
               Clust=hclust(dist(data.frame(rownames=rownames(sp_df()$spdata),
                                            x=sp_df()$xcoords,
                                            y=sp_df()$ycoords)),
                            method="single") %>%
                 cutree(input$cdist))
  })

  xy_df_filt <- reactive({
    xy_df() %>% 
      group_by(Clust) %>% 
      mutate(n=n()) %>% 
      filter(n>(input$dclustn-1)) %>% 
      droplevels()
  })

  output$plot1 <- renderPlot({
    p1 <- xy_df_filt() %>%
      dplyr::select(Copper, Long,Lat, Clust) %>% 
      ggplot() + 
      geom_point(aes(x=Long, y=Lat, colour = Clust), size=2) +
      guides(colour=FALSE) +
      coord_fixed() +
      theme_hc()
    p1
  })

  }

# Run the application 
shinyApp(ui = ui, server = server)
...