Demo MonetDBLite/Shiny

60minsdemo-monetdblite-shiny.R

# updated 2018-01-31, hm

library(MonetDBLite)
library(reshape2)
library(shiny)
library(leaflet)
library(ggplot2)
library(ggthemes)
library(DBI)

options(monetdb.debug.query=T)
options(shiny.port=4242)

theme <- theme_few(base_size = 24)
con <- dbConnect(MonetDBLite::MonetDBLite(), "/tmp/monetdblite-dbfarm")

# create database if not exists
if (!dbExistsTable(con, "stations")) {
  dbExecute(con, "CREATE TABLE stations (stationid INTEGER NOT NULL, long DECIMAL(5,2), lat DECIMAL(5,2), altitude SMALLINT, name VARCHAR(128))")

  dbExecute(con, "CREATE TABLE measurements (stationid INTEGER NOT NULL, date DATE NOT NULL, ddvec INTEGER, fg DECIMAL(4,1), fhx DECIMAL(4,1), fhn DECIMAL(4,1), fx DECIMAL(4,1), tg DECIMAL(4,1), tn DECIMAL(4,1), tx DECIMAL(4,1), t10n DECIMAL(4,1), sq DECIMAL(4,1), sp TINYINT, q SMALLINT, dr DECIMAL(5,1), rh DECIMAL(4,1), pg DECIMAL(5,1), pgx DECIMAL(5,1), pgn DECIMAL(5,1), vvn TINYINT, vvx TINYINT, ng TINYINT, ug TINYINT, ux TINYINT, un TINYINT, ev24 TINYINT)")
  stations_file <- tempfile()
  records_file <- tempfile()
  download.file("https://homepages.cwi.nl/~hannes/knmi/stations", stations_file)
  download.file("https://homepages.cwi.nl/~hannes/knmi/records", records_file)

  dbExecute(con, sprintf("COPY INTO stations FROM '%s'", stations_file))
  dbExecute(con, sprintf("COPY INTO measurements FROM '%s'", records_file))
}


stations <- dbGetQuery(con, "SELECT stationid as id, cast (long as float) as longitude, cast (lat as float) as latitude, name from stations")
ui <- fixedPage(fixedRow(column(8, h1("MonetDBLite + R + Shiny 60 Minute Demo")), column(4, img(src="http://homepages.cwi.nl/~hannes/logos.png", width="300px"))),
fixedRow(column(6, leafletOutput("mymap")), column(6, plotOutput("myplot"))),
fixedRow(column(12, p("Data from KNMI"))))

server <- function(input, output, session) {
 observe({
  click<-input$mymap_marker_click
  if(is.null(click)) return()

  sdata <- dbGetQuery(con, paste0("select min(name) as name, min(date) as date, cast (avg(tg) as float) as avgtg, cast (min(tn) as float) as mintn, cast (max(tx) as float) as maxtx from (select name, cast(date as string) as date, extract (year from date) as yr,extract(month from date) as mn, extract(day from date) as dy,tg,tn,tx from measurements join stations using(stationid) where long=",click$lng," and lat=",click$lat," and tg is not null and tn is not null and tx is not null) as r group by yr order by yr"))

  print(head(sdata))

  sdata$date <- as.Date(sdata$date)
  sdatam <- melt(sdata, id=c("date"))
  output$myplot <- renderPlot(print(ggplot(sdata, aes(x=date), environment=environment()) + geom_ribbon(aes(ymin=mintn, ymax=maxtx), alpha=.4, fill="blue")  +  geom_smooth(aes(y=avgtg), method='lm', size=4, alpha=.5) + geom_line(aes(y=avgtg), color="black", size=1.5) + ggtitle(paste0("Station ", sdata$name[[1]])) + xlab("Year") + ylab("Avg. Temp. and Range") + theme))
  })

output$mymap <- renderLeaflet({
  leaflet() %>% addProviderTiles("Stamen.TonerLite", options = providerTileOptions(noWrap = TRUE)) %>% addMarkers(lng=stations$longitude, lat=stations$latitude, popup=stations$name)
  })
}

shinyApp(ui, server)