Skip to content

Instantly share code, notes, and snippets.

@psychemedia
Last active June 12, 2021 18:45
Show Gist options
  • Star 7 You must be signed in to star a gist
  • Fork 6 You must be signed in to fork a gist
  • Save psychemedia/9690079 to your computer and use it in GitHub Desktop.
Save psychemedia/9690079 to your computer and use it in GitHub Desktop.
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
Copy link

great

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment