Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Example shiny app for loading in CSV file containing two location columns and an amount column and plotting great circle lines between each pair or points with line thickness related to amount. About: http://blog.ouseful.info/2014/03/24/experimenting-with-r-point-to-point-mapping-with-great-circles/

Download and install:

  1. R
  2. RStudio

Download the dummy csv file from this gist ( https://gist.github.com/psychemedia/9690079 )

In RStudio run:

install.packages("shiny")

then

library(shiny)

followed by

runGist(9690079)

An app should launch.

Load the downloaded dummy CSV file in (or another file of your own), choose the from, to, amount columns, then hit the Get Geodata button.

You should get a map with great circles connecting the points

TO DO - lots

  • make the code R idiiomatic
  • how to cope with missing amount column (?radio button to select amount Yes/No?) - DONE
  • how to save map [DONE-ish - though it's clunky and not working way I wanted?]
  • how to zoom map or limit display to particular area
  • maybe allow support for different coloured lines? [Added different line views]
  • directed lines/arrows?
  • other geocoders (currently using Google)?
  • other maps?
  • etc etc
We can make this file beautiful and searchable if this error is corrected: It looks like row 2 should actually have 3 columns, instead of 2. in line 1.
fromble,toble,amountify
"London, UK","Cambridge,UK"
"Cambridge,UK","Paris, France",17
"Paris,France","New York,US",24
"Sydney, Australia","Cape Town, South Africa",12
#This should detect and install missing packages before loading them - hopefully!
list.of.packages <- c("shiny", "ggmap","maps","geosphere")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
if(length(new.packages)) install.packages(new.packages)
lapply(list.of.packages,function(x){library(x,character.only=TRUE)})
#server.R
shinyServer(function(input, output) {
filedata <- reactive({
infile <- input$datafile
if (is.null(infile)) {
# User has not uploaded a file yet
return(NULL)
}
read.csv(infile$datapath)
})
geodata <- reactive({
if (input$getgeo == 0) return(NULL)
df=filedata()
if (is.null(df)) return(NULL)
isolate({
dummy=filedata()
fr=input$from
to=input$to
locs=data.frame(place=unique(c(as.vector(dummy[[fr]]),as.vector(dummy[[to]]))),stringsAsFactors=F)
cbind(locs, t(sapply(locs$place,geocode, USE.NAMES=F)))
})
})
output$toCol <- renderUI({
df <-filedata()
if (is.null(df)) return(NULL)
items=names(df)
names(items)=items
selectInput("to", "To:",items)
})
output$amountflag <- renderUI({
df <-filedata()
if (is.null(df)) return(NULL)
checkboxInput("amountflag", "Use values?", FALSE)
})
output$fromCol <- renderUI({
df <-filedata()
if (is.null(df)) return(NULL)
items=names(df)
names(items)=items
selectInput("from", "From:",items)
})
output$amountCol <- renderUI({
df <-filedata()
if (is.null(df)) return(NULL)
#Let's only show numeric columns
nums <- sapply(df, is.numeric)
items=names(nums[nums])
names(items)=items
selectInput("amount", "Amount:",items)
})
output$lineSelector <- renderUI({
radioButtons("lineselector", "Line type:",
c("Uniform" = "uniform",
"Thickness proportional" = "thickprop",
"Colour proportional" = "colprop"))
})
output$filetable <- renderTable({
filedata()
})
geodata2 <- reactive({
if (input$getgeo == 0) return(NULL)
df=filedata()
if (input$amountflag != 0) {
maxval=max(df[input$amount],na.rm=T)
minval=min(df[input$amount],na.rm=T)
df$b8g43bds=10*df[input$amount]/maxval
}
gf=geodata()
df=merge(df,gf,by.x=input$from,by.y='place')
merge(df,gf,by.x=input$to,by.y='place')
})
output$geotable <- renderTable({
if (input$getgeo == 0) return(NULL)
geodata2()
})
plotter = reactive({
if (input$getgeo == 0) return(map("world"))
#Method pinched from: http://flowingdata.com/2011/05/11/how-to-map-connections-with-great-circles/
map("world")
df=geodata2()
pal <- colorRampPalette(c("blue", "red"))
colors <- pal(100)
for (j in 1:nrow(df)){
inter <- gcIntermediate(c(df[j,]$lon.x[[1]], df[j,]$lat.x[[1]]), c(df[j,]$lon.y[[1]], df[j,]$lat.y[[1]]), n=100, addStartEnd=TRUE)
if (input$amountflag == 0) lines(inter, col="red", lwd=0.8)
else {
if (input$lineselector == 'colprop') {
colindex <- round( (df[j,]$b8g43bds[[1]]/10) * length(colors) )
lines(inter, col=colors[colindex], lwd=0.8)
} else if (input$lineselector == 'thickprop') {
lines(inter, col="red", lwd=df[j,]$b8g43bds[[1]])
} else lines(inter, col="red", lwd=0.8)
}
}
})
output$geoplot<- renderPlot({
if (input$getgeo == 0) return(map("world"))
plotter()
})
#Not sure what's going on here; works fine with code inline but not if called as function?
output$downloadPlot <- downloadHandler(
filename = function() {paste('data-', Sys.Date(), '.png', sep='')},
content = function(file) {
png(file)
if (input$getgeo == 0) return(map("world"))
#Method pinched from: http://flowingdata.com/2011/05/11/how-to-map-connections-with-great-circles/
map("world")
df=geodata2()
pal <- colorRampPalette(c("blue", "red"))
colors <- pal(100)
for (j in 1:nrow(df)){
inter <- gcIntermediate(c(df[j,]$lon.x[[1]], df[j,]$lat.x[[1]]), c(df[j,]$lon.y[[1]], df[j,]$lat.y[[1]]), n=100, addStartEnd=TRUE)
if (input$amountflag == 0) lines(inter, col="red", lwd=0.8)
else {
if (input$lineselector == 'colprop') {
colindex <- round( (df[j,]$b8g43bds[[1]]/10) * length(colors) )
lines(inter, col=colors[colindex], lwd=0.8)
} else if (input$lineselector == 'thickprop') {
lines(inter, col="red", lwd=df[j,]$b8g43bds[[1]])
} else lines(inter, col="red", lwd=0.8)
}
}
dev.off()
},
contentType = 'image/png'
)
})
#ui.R
shinyUI(pageWithSidebar(
headerPanel("Great Circle Map demo"),
sidebarPanel(
fileInput('datafile', 'Choose CSV file',
accept=c('text/csv', 'text/comma-separated-values,text/plain')),
uiOutput("fromCol"),
uiOutput("toCol"),
uiOutput("amountflag"),
conditionalPanel(
condition="input.amountflag==true",
uiOutput("amountCol")
),
conditionalPanel(
condition="input.amountflag==true",
uiOutput("lineSelector")
),
actionButton("getgeo", "Get geodata"),
downloadButton("downloadPlot", "Save map file")
),
mainPanel(
tableOutput("filetable"),
tableOutput("geotable"),
plotOutput("geoplot")
)
))
@harcherole

This comment has been minimized.

Copy link

harcherole commented Oct 15, 2017

great

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.