Проблемы с использованием gcIntermediate в R Shiny?

Я работал над приложением, используя R Shiny, и все работает, кроме одной маленькой части, где я вызываю gcIntermediate на сервере Shiny. Мне было интересно, если это типичная проблема или я просто делаю что-то ужасно неправильно, к чему я, к сожалению, не обращаю внимания. У меня есть набор из примерно 30000 городов, их стран, координат, почтовых индексов и т. Д. В рамках этого приложения я хотел бы обозначить буквой R большие круги, соединяющие точки A и B на карте мира. Тем не менее, я был неудачным из-за неопределенного значения для draw_line когда бегать в блестящей среде. Это работает просто отлично, если я передаю значения и запускаю их за пределами Shiny. Следовательно, я застрял.

Вот пользовательский интерфейс

#GC Plot Test UI

shinyUI(pageWithSidebar(

  headerPanel("Great Circles on a Map"),

  sidebarPanel(

    h3("Select Origin Codes"),

    uiOutput("choose_origin_code1"),

    uiOutput("choose_origin_code2"),

    h3("Select Destination Codes"),

    uiOutput("choose_destination_code1"),

    uiOutput("choose_destination_code2"),

    br()
  ),


  mainPanel(
    #tableOutput("MapPlot")

    plotOutput("MapPlot")

  )
))

Вот сервер:

#GC Plot Test Server

library(shiny)
library(RColorBrewer)
library(ggplot2)
library(maps)
library(mapdata)
library(geosphere)
library(sp)

#Some random cities and locations from my larger data set
city_name <- c("Tunceli", "Udomlya", "Moscow", "Kaunas")
country_code <- c("TR", "RU", "RU", "LT")
city_code <- c(62, 17, 10, 44)
latitude <- c(39.108, 57.879, 55.752, 54.90)
longitude <- c(39.547, 34.993, 37.616, 23.90)
df <- data.frame(city_name, country_code, city_code, latitude, longitude)

map.dat <- map_data("world")

shinyServer(function(input, output) {

  output$choose_origin_code1 <- renderUI({
    selectInput("origin.code1", "Country of Origin", unique(as.character(df$country_code)))
  })

  output$choose_origin_code2 <- renderUI({
    #If missing input, return to avoid error later in function
    if(is.null(input$origin.code1))
      return()

    origin.code2.list1 <- df[grep(as.character(input$origin.code1), as.character(df$country_code)),]
    origin.code2.list2 <- unique(as.character(origin.code2.list1$city_code))

    #Create the checkboxes and deselect them all by default
    selectInput("origin.code2", "Source Location Code", origin.code2.list2)

  })


  output$choose_destination_code1 <- renderUI({
    #Check ship.from.code1 and ship.from.code2 input value
    if(is.null(input$origin.code1) | is.null(input$origin.code2))
      return()

    selectInput("dest.code1", "Destination Country", unique(as.character(df$country_code)))   

  })

  #Destination Location Input
  output$choose_destination_code2 <- renderUI({
    #Check ship.from.code1 and ship.from.code2 input value
    if(is.null(input$dest.code1))
      return()

    dest.code2.list1 <- df[grep(as.character(input$dest.code1), as.character(df$country_code)),]
    dest.code2.list2 <- unique(as.character(dest.code2.list1$city_code))

    selectInput("dest.code2", "Destination Location Code 2", dest.code2.list2)

  })

  #Map the routes
  output$MapPlot <- renderPlot({
    # If missing input, return to avoid error later in function
    if(is.null(input$origin.code1) | is.null(input$origin.code1) | is.null(input$dest.code1) | is.null(input$dest.code2))
      return()

    #Find the row with starting point information
    Origin_Row <- which(df$country_code == input$origin.code1 
                        & df$city_code == input$origin.code2)

    #Find the row with the destination information
    Dest_Row <- which(df$country_code == input$dest.code1
                      & df$city_code == input$dest.code2)

    #Make coordinate data for origin and destination explicit
    Origin_lat <- df$latitude[Origin_Row]
    Origin_lon <- df$longitude[Origin_Row]
    Dest_lat <- df$latitude[Dest_Row]
    Dest_lon <- df$longitude[Dest_Row]

    coords <- data.frame( c(Origin_lon, Dest_lon), c(Origin_lat, Dest_lat))
    colnames(coords) <- c("Lon", "Lat")

    draw_line <- gcIntermediate(coords[1,], coords[2,], n = 100, addStartEnd = TRUE)

    Map_center <- c(mean(coords[(1:2),1]), mean(coords[(1:2),2]), 0) #Centered on Zurich, CH

    p <- ggplot() 
    p <- p + geom_polygon(aes(long,lat, group=group), fill="grey65", data = map.dat) + theme_bw() + theme(axis.text = element_blank(), axis.title = element_blank()) 
    p <- p + geom_line(aes(x = draw_line[,1],
                           y = draw_line[,2]),
                       color = 'red')
    p <- p + coord_map("ortho", orientation = c(Map_center))
    p

  })

})

Ошибка всегда происходит в draw_line раздел, где я звоню gcIntermediate(), Я попытался решить несколько проблем, но все, что я придумал, это то, что gcIntermediate() Функция не работает в сочетании с Shiny. Если это так, кто-нибудь знает, как это исправить или возможного обходного пути?

Бонус: я хотел бы, чтобы мой график увеличивал маршрут, когда он отображается, но я получаю искажение карты, когда я делаю это, поэтому я придерживался представления о мире. Кто-нибудь знает, как этого добиться?

1 ответ

Я обнаружил, что проблема не заключалась в выводе gcIntermediate в кадр данных и переопределение данных в geom_line() слой.

 draw_line <- data.frame(gcIntermediate(coords[1,], coords[2,], n = 100, addStartEnd = TRUE))

      p <- ggplot() 
      p <- p + geom_polygon(aes(long,lat, group=group), fill="grey65", data = map.dat) + theme_bw() + theme(axis.text = element_blank(), axis.title = element_blank()) 
      p <- p + geom_line(data = draw_line, aes(x = draw_line[,1], y = draw_line[,2], color = 'red'))
      p <- p + coord_map("ortho", orientation = c(Map_center))
      p
Другие вопросы по тегам