Commit 05df8063 authored by peguerin's avatar peguerin
Browse files

first server working fine

parent d9759190
......@@ -9,47 +9,13 @@ library(rgdal)
library(rgeos)
###############################################################################
# functions
## from center of square coordinate (h,k) and length L return corner coordinates
corners_of_square <- function(cells,L) {
corners=data.frame(
lng1=cells$x-L/2,
lat1=cells$y+L/2,
lng2=cells$x+L/2,
lat2=cells$y-L/2
)
return(corners)
}
## from (x,y) meters coordinates project to google map
change_projection_xy <- function(xy) {
colnames(xy) = c("x","y")
if(length(which(xy$y > 7300200 )) > 0) { xy$y[which(xy$y > 7300200)] = 7300100 }
if(length(which(xy$y < -7300200 )) > 0) { xy$y[which(xy$y < -7300200)] = -7300100 }
if(length(which(xy$x > 17084470 )) > 0) { xy$x[which(xy$x > 17084470)] = 17074470 }
if(length(which(xy$x < -17084470 )) > 0) { xy$x[which(xy$x < -17084470)] = -17074470 }
coordinates(xy) = c("x", "y")
proj4string(xy) = CRS("+proj=cea +lon_0=0 +lat_ts=30 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs +ellps=WGS84 +towgs84=0,0,0")
xy = spTransform(xy,CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"))
xy_table=data.frame(x=as.double(xy@coords[,1]), y=as.double(xy@coords[,2]))
return(xy_table)
}
###############################################################################
# LOAD DATA
marine = read.table("donnees/figure_3a_underlying_data.tsv",header=T)
marineCorners=corners_of_square(data.frame(x=marine$x,y=marine$y),194000)
rect_1=change_projection_xy(data.frame(x=marineCorners$lng1,y=marineCorners$lat1))
rect_2=change_projection_xy(data.frame(x=marineCorners$lng2,y=marineCorners$lat2))
rect=cbind(rect_1,rect_2)
colnames(rect)=c("lng1","lat1","lng2","lat2")
marineRect=cbind(marine,rect)
source("prepare_data.R")
###############################################################################
# AESTETHICS
gradiant_col_palette=c("#3333A2","#3333FF","#33CBFF","#33FFFF","#FFDF33","#FFA333","#FF3333")
bin_col_palette=c("#FFCCCC","#FF6666","#FF0000","#990000")
###############################################################################
......@@ -60,29 +26,55 @@ names(r_colors) <- colors()
server <- function(input, output, session) {
points <- eventReactive(input$recalc, {
cbind(rnorm(40) * 2 + 13, rnorm(40) + 48)
}, ignoreNULL = FALSE)
#selected_data= marineRect %>% dplyr::select(input$cell_datatype)
output$mymap <- output$map <- renderLeaflet({
selected_wt= cellsDat %>% filter(watertype == input$watertype)
selected_data=selected_wt %>% select(input$cell_datatype) %>% pull()
if(input$cell_datatype=="number_of_species") {
maFillColor=colorBin(bin_col_palette, selected_data, bins=c(2,4,5,10, max(selected_data)) )(selected_data)
selected_interval_data=c(2,4,5,10, max(selected_data))
conpal=colorBin(bin_col_palette, selected_data, bins=c(2,4,5,10, max(selected_data)) )
} else if(input$cell_datatype =="mean_genetic_diversity") {
maFillColor= colorQuantile(gradiant_col_palette, selected_data,n=7 )(selected_data)
selected_interval_data=c(min(selected_data),max(selected_data))
conpal = colorQuantile(palette = gradiant_col_palette, domain = selected_interval_data,n=7)
} else if(input$cell_datatype =="temperature") {
maFillColor= colorNumeric(gradiant_col_palette, selected_data )(selected_data)
selected_interval_data=c(min(selected_data),max(selected_data))
conpal = colorNumeric(palette = gradiant_col_palette, domain = selected_interval_data)
} else {
## number of sequences by species
maFillColor=colorBin(bin_col_palette, selected_data, bins=c(2,5,10,20,30, max(selected_data)) )(selected_data)
selected_interval_data=c(2,5,10,20,30, max(selected_data))
conpal=colorBin(bin_col_palette,selected_data, bins=c(2,5,10,20,30, max(selected_data)) )
}
leaflet() %>%
addProviderTiles(providers$Hydda.Base,
options = providerTileOptions(minZoom = 2, maxZoom = 400)) %>%
clearBounds() %>%
setView(lng = 20, lat = 0, zoom = 2) %>%
addTiles() %>%
addRectangles(
lng1=marineRect$lng1, lat1=marineRect$lat1,
lng2=marineRect$lng2, lat2=marineRect$lat2,
lng1=selected_wt$lng1, lat1=selected_wt$lat1,
lng2=selected_wt$lng2, lat2=selected_wt$lat2,
color="#ffffff",
weight = 1, smoothFactor = 0.55,
opacity = 1.0, fillOpacity = 0.45,
fillColor = colorQuantile(gradiant_col_palette, marineRect$mean_genetic_diversity)(marineRect$mean_genetic_diversity)
)
fillColor = maFillColor
) %>%
addLegend(conpal,
selected_interval_data,
opacity = 1,
title = input$cell_datatype,
position = "bottomright")
})
}
......@@ -2,15 +2,66 @@
# load libraries
library(shiny)
library(leaflet)
library(htmltools)
library(htmlwidgets)
library(sf)
library(tidyverse)
library(shinythemes)
library(DT)
library(shinydashboard)
library(shinycssloaders)
###############################################################################
# DATA
choices_datatype=list("Genetic diversity" = "mean_genetic_diversity",
" Surface temperature" = "temperature",
"Number of species" = "number_of_species",
"Mean number of individual sequences per species" = "number_of_sequences")
choices_watertype=c("marine","freshwater")
###############################################################################
# UI
ui <- dashboardPage(
dashboardHeader(title = "Worldmap of Fish Genetic Diversity",titleWidth=480),
dashboardSidebar(width=480,
fluidRow(
column(width=12,
align="center",
# Select freshwater or marine fishes
selectInput("watertype",
label = "freshwater/marine species",
choices = choices_watertype,
selected = "marine"),
# Select data type
selectInput("cell_datatype",
label = "Cell data you want to display",
choices = choices_datatype,
selected = "mean_genetic_diversity"),
ui <- fluidPage(
leafletOutput("mymap",height=640,width=960),
p(),
actionButton("recalc", "New points")
hr(),
# Link for source code
tags$a("Source code repository", href="https://github.com/Grelot/global_fish_genetic_diversity", target="_blank"),
# Explanation
tags$footer(tags$p("Developped by Pierre-Edouard GUERIN")),
# Link for paper
tags$a("Manel et al. 'Global patterns of fish genetic diversity' published in Nature Communication", href="", target="_blank"),
hr(),
# Update info
tags$footer(tags$p("Last updated in February 2020", class = "credit"))
)
)
),
dashboardBody(
fluidRow(
leafletOutput("mymap",height=640,width=960)
)
)
)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment