Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
reservebenefit
webapp_marine_worldmap_BOLD
Commits
05df8063
Commit
05df8063
authored
Jan 14, 2020
by
peguerin
Browse files
first server working fine
parent
d9759190
Changes
2
Hide whitespace changes
Inline
Side-by-side
server.R
View file @
05df8063
...
...
@@ -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
=
marineRec
t
$
lng1
,
lat1
=
marineRec
t
$
lat1
,
lng2
=
marineRec
t
$
lng2
,
lat2
=
marineRec
t
$
lat2
,
lng1
=
selected_w
t
$
lng1
,
lat1
=
selected_w
t
$
lat1
,
lng2
=
selected_w
t
$
lng2
,
lat2
=
selected_w
t
$
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"
)
})
}
ui.R
View file @
05df8063
...
...
@@ -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
)
)
)
)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment