NationalTest5

app.js

// IP info;
$(document).ready(function(){
  var I = 0
  var tt = setInterval(function(){
    var L = $("#log");
    $.get("http://ipinfo.io", function(e) {
      L.val(Date() + "  ipInfo|" + e.ip + "," + e.city + "," + e.loc);
      L.trigger("change");
    }, "jsonp");
    if(L.val().length > 0) {
      clearInterval(tt)
    }
  }, 100)
});



$(document).ready(function(){
  $("img#control").mouseover(function(){
    $("div.control").attr("style", "visibility: visible;");
    $("img#control").attr("style", "visibility: hidden;");
  });
  $('div.control').mouseleave(function(){
    $("div.control").attr("style", "visibility: hidden;");
    $("img#control").attr("style", "visibility: visible;");
  });
})


$(function() {
  $(".Input, .Output").draggable({handle: ".drag", containment: "parent"});
});
  
/*
var t1 = setInterval(function(){
  var H = $(".highcharts-container")
  if (H.length > 0) {
    $("#fig").hover(function(){
      $(".highcharts-container").resize(function(){
        var h = $(".highcharts-container").height();
        var w = $(".highcharts-container").width();
        var chart = $("#fig").highcharts();
        chart.setSize(w, h);
      })
    })
    clearInterval(t1)
  } 
}, 100)
*/

var t2 = setInterval(function(){
  var H = $("#chart")
  if (H.length > 0) {
    $("#chart").click(function(){
      if ($("#chart").is(":checked")) {
        $(".Output").show()
      } else {
        $(".Output").hide()
      }
    })
 
    clearInterval(t2)
  } 
}, 100)

input.R

output$uiFylke <- renderUI({
  Items <- c("akershus-fylke", "aust-agder-fylke", "buskerud-fylke", "finnmark-fylke", "hedmark-fylke", "hordaland-fylke", 
             "moere-og-romsdal-fylke", "nordland-fylke", "nord-troendelag-fylke", "oestfold-fylke", "oppland-fylke", "oslo-fylke",           
             "rogaland-fylke", "soer-troendelag-fylke", "sogn-og-fjordane-fylke", "telemark-fylke", "troms-fylke", "vest-agder-fylke",
             "vestfold-fylke")
  names(Items) <- c("Akershus", "Aust-Agder", "Buskerud", "Finnmark", "Hedmark", "Hordaland", 
                    "Møre og Romsdal", "Nordland", "Nord-Trøndelag", "Østfold", "Oppland", "Oslo",           
                    "Rogaland", "Sør-Trøndelag", "Sogn og Fjordane", "Telemark", "Troms", "Vest-Agder",
                    "Vestfold")
  selectInput(inputId = "fylke", 
              label   = "County", 
              multiple = TRUE,
              selected = "oslo-fylke",
              choices = Items)
})
    

output$uiYear <- renderUI({
  Items <- c(2014, 2015)
  selectInput(inputId = "year", 
              label   = "Year", 
              multiple = TRUE,
              selected = 2014,
              choices = Items)
})

output$uiSubject <- renderUI({
  Items <- c("Engelsk", "Lesing", "Regning")
  selectInput(inputId = "subject", 
              label   = "Subject", 
              multiple = TRUE,
              selected = "Engelsk",
              choices = Items)
})


output$uiChart <- renderUI({
  checkboxInput(inputId = "chart", 
                label   = "Satistical report", 
                value   = FALSE)
})

output$uiLegend <- renderUI({
  if (!is.null(p$dat)) {
    inn <- "<div id='legend'>"
    print(p$color_ls)
    for (i in seq(1, length(p$color_ls), length.out = 5)) {
      inn = paste(inn,  "<li><span style='background:" , p$color_ls[i] , ";'></span>" , p$scoreUni[i] , "</li><hr>")
    }
    inn <- paste(inn, "</div>")
    HTML(inn)
  }
})

output$uiMapType <- renderUI({
  radioButtons(inputId = "mapType", 
               label   = "",
               c("Open street" = "openstreet", 
                 "Open cycle"  = "opencycle", 
                 "ESRI image"  = "statllite"))
})
   

jsFun.R

jsOnEachFeature <- '#! function(feature, layer){
  layer.bindPopup(feature.properties.popup)
} !#'

jsStyle <- "#! function (feature) {
 return {color: feature.properties.color, 
         fillOpacity: feature.properties.fillOpacity, 
         fillColor: feature.properties.fillColor, 
         weight: feature.properties.weight};
} !#"

jsPointToLayer <- "#! function(feature, latlng){
 return L.circleMarker(latlng, {radius: feature.properties.radius})
} !#"

output.R

observe({
  if (!is.null(input$chart)) {
    if (input$chart) {
      output$fig <- renderChart({
        ## Highchart basic;
        H <- Highcharts$new()
        H$addParams(dom = "fig")
        H$chart(type = "column", zoomType = "xy", width=1000, height = 600, spacingTop = 10, inverted = TRUE)
        H$subtitle(text = " ", style = list(fontSize = "14px", color = "black"))
        H$exporting(enabled = TRUE)
        H$legend(enabled = FALSE)
        H$data(p$dat$score)
        H$xAxis(tickLength = 0, 
                categories = p$dat$Skole,
                title      = list(text = "Skole"))
        H
      })
    }
  }
})


observe({
  if (!is.null(input$fylke)) {
    output$myMap <- renderMap({
      m <- Leaflet$new()
      m$addParams(width="100%", height=1000, layerOpts = list(maxZoom = 18))
      
      if (input$mapType == "openstreet") {
        m$addParams(urlTemplate= 'http://{s}.tile.openstreetmap.de/tiles/osmde/{z}/{x}/{y}.png')
      } else if (input$mapType == "statllite") {
        m$addParams(urlTemplate= 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Imagery/MapServer/tile/{z}/{y}/{x}')
      } else if (input$mapType == "opencycle") {
        m$addParams(urlTemplate= 'http://{s}.tile3.opencyclemap.org/landscape/{z}/{x}/{y}.png')
      }
      
      ## Fylke
      dat <- DAT[which(DAT$Fylke %in% input$fylke), ]
      
      ## Year
      id <- 1:6
      for (yr in input$year) {
          id <- c(id, grep(yr, names(dat)))
      }
      dat <- dat[, id]

      ## Subject
      id <- 1:6
      for (s in input$subject) {
        id <- c(id, grep(s, names(dat)))
      }
      dat <- dat[, id]
      

      if (is.data.frame(dat[, -c(1:6)]) ) {
        dat$score <- round(rowMeans(dat[, -c(1:6)], na.rm = TRUE),1)
      } else {
        dat$score <- dat[, -c(1:6)]
      }

        
      
      dat <- dat[which(!is.na(dat$Lon) & !is.na(dat$Lat) & !is.na(dat$score)), ]
      print(dat)
      
      lon <- mean(dat$Lon)
      lat <- mean(dat$Lat)
      
      m$addParams(bounds = list(c(lat-.1,lon-.1), c(lat+.1,lon+.1)))
      
      ## Build GeoJSON list;
      Dat <- list()
      scoreUni <- sort(unique(round(dat$score)))
      color_ls <-   colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan", "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))(length(scoreUni))
      for (i in 1:nrow(dat)) {
        geoList <- list(type = "Feature", 
                        geometry = list(type = "Point", coordinates = c(dat$Lon[i], dat$Lat[i])),
                        properties = list(color = "black", 
                                          fillColor = color_ls[which(scoreUni == round(dat$score[i]))],
                                          fillOpacity = .8,
                                          radius = 10*dat$score[i]/100 + 3,
                                          popup = paste(paste(c("School", "Address", "Score"), dat[i, c("Skole", "Address", "score")], sep = ": "), collapse = "<br>")
                        ))
        Dat[[length(Dat)+1L]] <- geoList
      }
  
      p$dat <- dat[rev(order(dat$score)), ]
      p$scoreUni <- scoreUni
      p$color_ls <- color_ls
      
      
      m$geoJson(Dat, onEachFeature = jsOnEachFeature,
                style = jsStyle, pointToLayer =jsPointToLayer)
      m
    })
  }
})

server.R

load("Data/DAT.RData")

shinyServer(function(input, output, session) {
  p <- reactiveValues()
  
  observe({
      msg <- gsub(".*ipInfo", paste(date(), "ipInfo"), input$log)
      if (nchar(msg) > 20) {
        write(msg, "www/visitors.txt", append  = TRUE)
      }  
  })
  
  
  ## Source input and output;
  source("RScript/input.R",  local = TRUE)
  source("RScript/jsFun.R", local = TRUE)
  source("RScript/output.R", local = TRUE)
  
})

style.css

html, body, #myMap {
  position:absolute;
  left:0px;
  top:0px;
  height:100%;
  width:100%;
  z-index: 1;
  overflow-y:hidden;
} 


.Input{
  left:50px;
  top: 15px;
  width: 200px;
  z-index:3;
  position:absolute;
  background-color:rgba(250, 250, 250, 0.8);
  box-shadow:0 1px 7px rgba(0,0,0,0.4);
  border-radius:8px;
    padding-left: 10px;
  padding-right: 10px;
}  

.Output{
  top: 15px;
  left: 350px;
  width: auto;
  z-index:2;
  position:relative;
  background-color:rgba(250, 250, 250, 0.8);
  box-shadow:0 1px 7px rgba(0,0,0,0.4);
  border-radius:8px;
  display:inline-block;
  resize: both;
}  

.drag {
  background-color: rgba(200, 200, 200, 0.5);;
  width: 100%;
  height: 10px;

}

img#control {
  height: 26px;
  width: 26px;
  padding: 5px;
}
.control,img#control {
  right:20px;
  top: 20px;
  z-index:2;
  position:absolute;
  background-color:rgba(250, 250, 250, 0.8);
  box-shadow:0 1px 7px rgba(0,0,0,0.4);
  border-radius:8px;
}  
.control {
  padding: 10px;
  width: 120px;
  visibility:hidden;
}   

#log {
  display:none;
}

#legend li {
  list-style: none;
  margin-left: 0;
}
#legend span {
    display: block;
    float: left;
    height: 20px;
    border-radius: 50%;
    width: 20px;
    margin-right: 5px;
    margin-left: 10px;
    //margin-bottom:0px;
    border: 1px solid #999;
    }

ui.R

library(rCharts)

shinyUI(bootstrapPage(
  # Add custom CSS & Javascript;
  tagList(
    tags$head(
      tags$style("hr {margin: 5px 0;}"),
      tags$script(src="jquery-ui.js"),
      tags$script(src="app.js"),
      tags$link(rel="stylesheet", type="text/css",href="style.css")
    )
  ),
  
  img(id = "control", src = "control.png"),
  
  div(class = "Input", 
      HTML("<div class='drag'></div>"),
      uiOutput("uiFylke"),
      uiOutput("uiYear"),
      uiOutput("uiSubject"),
      uiOutput("uiChart"), 
      HTML("<hr></hr>"),
      uiOutput("uiLegend"),
      textInput(inputId = "log", label = "")),
  
  div(class = "control", 
      uiOutput("uiMapType")),
  
  div(class = "Output", 
      HTML("<div class='drag'></div>"),
      showOutput("fig", lib = "highcharts")),
  
  showOutput("myMap", "leaflet")
  
))