Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
SimAquaLife
GR3D
Commits
2a286d03
Commit
2a286d03
authored
Apr 22, 2021
by
patrick.lambert
Browse files
move functions in new file
parent
93f51dda
Changes
2
Hide whitespace changes
Inline
Side-by-side
exploration/GR3D_Rdescription/GR3Dmetapopulation.R
0 → 100644
View file @
2a286d03
#=============================================================================================================
# metapopulation identification
# =============================================================================================================
computeAutochtonousRate
=
function
(
data
){
data
%>%
filter
(
migrationBasin
==
originBasin
)
%>%
select
(
-
originBasin
)
%>%
inner_join
(
data
%>%
group_by
(
year
,
migrationBasin
)
%>%
summarise
(
totalRun
=
sum
(
effective
),
.groups
=
'drop'
),
by
=
c
(
'migrationBasin'
,
'year'
))
%>%
mutate
(
autochtonousRate
=
effective
/
totalRun
)
%>%
select
(
year
,
migrationBasin
,
autochtonousRate
)
}
computeHomingRate
=
function
(
data
){
data
%>%
filter
(
migrationBasin
==
originBasin
)
%>%
select
(
-
migrationBasin
)
%>%
inner_join
(
data
%>%
group_by
(
year
,
originBasin
)
%>%
summarise
(
production
=
sum
(
effective
),
.groups
=
'drop'
),
by
=
c
(
'originBasin'
,
'year'
))
%>%
mutate
(
homingRate
=
effective
/
production
)
%>%
select
(
year
,
originBasin
,
homingRate
)
}
# comparison between autochtonous rate and homing rate
# computeAutochtonousRate(exchangesData) %>%
# inner_join(computeHomingRate(data = exchangesData), by = c('migrationBasin' = 'originBasin', 'year'))
identyMetapopulation
=
function
(
exchangesData
,
threshold
=
.95
,
verbose
=
FALSE
)
{
# exchangesData {year, migrationBasin, originBasin)}
exchangesDataUpdated
=
exchangesData
# initialise the connection table between basin and metapopulation
metapopulation
=
exchangesDataUpdated
%>%
distinct
(
year
,
basin
=
migrationBasin
)
%>%
mutate
(
metapop
=
basin
)
iteration
=
1
# find the basin with the minimum autochtonous rate for the first time,
basinWithMinAutochtonousRate
=
computeAutochtonousRate
(
data
=
exchangesDataUpdated
)
%>%
group_by
(
year
)
%>%
slice
(
which.min
(
autochtonousRate
))
# loop while autochtonousRate is still < 0.95
while
(
basinWithMinAutochtonousRate
$
autochtonousRate
<
threshold
)
{
# while (iteration <= 4 ) {
if
(
verbose
)
cat
(
iteration
,
": "
,
basinWithMinAutochtonousRate
$
autochtonousRate
,
'\n'
)
# basinWithMinAutochtonousRate will be merged with origin basin sending the maximum number of fish in this basin
metapopsToBeMerged
<-
exchangesDataUpdated
%>%
inner_join
(
basinWithMinAutochtonousRate
%>%
select
(
-
autochtonousRate
),
by
=
c
(
'year'
,
'migrationBasin'
))
%>%
filter
(
migrationBasin
!=
originBasin
)
%>%
# to avoid self merging
group_by
(
year
)
%>%
slice
(
which.max
(
effective
))
%>%
ungroup
()
%>%
select
(
year
,
migrationBasin
,
originBasin
)
# update the connection table between basin and metapopulation by merging metapopulation
for
(
i
in
1
:
nrow
(
metapopsToBeMerged
))
{
mergedName
=
paste0
(
"M"
,
iteration
,
'_'
,
i
)
metapopsToBeMerged_i
<-
metapopsToBeMerged
%>%
slice
(
i
)
if
(
verbose
)
cat
(
"\t"
,
metapopsToBeMerged_i
$
migrationBasin
,
' + '
,
metapopsToBeMerged_i
$
originBasin
,
' = '
,
mergedName
,
"\n"
)
metapopulation
<-
metapopulation
%>%
mutate
(
metapop
=
if_else
(
year
==
metapopsToBeMerged_i
$
year
&
metapop
%in%
(
metapopsToBeMerged_i
%>%
select
(
ends_with
(
"Basin"
))
%>%
unlist
(
use.names
=
FALSE
)),
mergedName
,
metapop
))
}
# sum by migration and origin basins according to updated metapopulations
# computed with initial exchangesData
exchangesDataUpdated
<-
exchangesData
%>%
#sum up on migration basins
inner_join
(
metapopulation
,
by
=
c
(
'year'
,
'migrationBasin'
=
'basin'
))
%>%
group_by
(
year
,
metapop
,
originBasin
)
%>%
summarise
(
effective
=
sum
(
effective
),
.groups
=
'drop'
)
%>%
rename
(
migrationBasin
=
metapop
)
%>%
# sum on origine basins
inner_join
(
metapopulation
,
by
=
c
(
'year'
,
'originBasin'
=
'basin'
))
%>%
group_by
(
year
,
metapop
,
migrationBasin
)
%>%
summarise
(
effective
=
sum
(
effective
),
.groups
=
'drop'
)
%>%
rename
(
originBasin
=
metapop
)
# minimum of autochtonous rate
basinWithMinAutochtonousRate
=
computeAutochtonousRate
(
data
=
exchangesDataUpdated
)
%>%
group_by
(
year
)
%>%
slice
(
which.min
(
autochtonousRate
))
iteration
=
iteration
+
1
}
return
(
list
(
metapopulation
=
metapopulation
,
exchangesData
=
exchangesDataUpdated
))
}
exploration/NEA_sensitivity_analysis/metapopulationIdentification.R
View file @
2a286d03
library
(
tidyverse
)
computeAutochtonousRate
=
function
(
data
){
data
%>%
filter
(
migrationBasin
==
originBasin
)
%>%
select
(
-
originBasin
)
%>%
inner_join
(
data
%>%
group_by
(
year
,
migrationBasin
)
%>%
summarise
(
totalRun
=
sum
(
effective
),
.groups
=
'drop'
),
by
=
c
(
'migrationBasin'
,
'year'
))
%>%
mutate
(
autochtonousRate
=
effective
/
totalRun
)
%>%
select
(
year
,
migrationBasin
,
autochtonousRate
)
}
computeHomingRate
=
function
(
data
){
data
%>%
filter
(
migrationBasin
==
originBasin
)
%>%
select
(
-
migrationBasin
)
%>%
inner_join
(
data
%>%
group_by
(
year
,
originBasin
)
%>%
summarise
(
production
=
sum
(
effective
),
.groups
=
'drop'
),
by
=
c
(
'originBasin'
,
'year'
))
%>%
mutate
(
homingRate
=
effective
/
production
)
%>%
select
(
year
,
originBasin
,
homingRate
)
}
# comparison between autochtonous rate and homing rate
# computeAutochtonousRate(exchangesData) %>%
# inner_join(computeHomingRate(data = exchangesData), by = c('migrationBasin' = 'originBasin', 'year'))
identyMetapopulation
=
function
(
exchangesData
,
threshold
=
.95
,
verbose
=
FALSE
)
{
exchangesDataUpdated
=
exchangesData
# initialise the connection table between basin and metapopulation
metapopulation
=
exchangesDataUpdated
%>%
distinct
(
year
,
basin
=
migrationBasin
)
%>%
mutate
(
metapop
=
basin
)
iteration
=
1
# find the basin with the minimum autochtonous rate for the first time,
basinWithMinAutochtonousRate
=
computeAutochtonousRate
(
data
=
exchangesDataUpdated
)
%>%
group_by
(
year
)
%>%
slice
(
which.min
(
autochtonousRate
))
# loop while autochtonousRate is still < 0.95
while
(
basinWithMinAutochtonousRate
$
autochtonousRate
<
threshold
)
{
# while (iteration <= 4 ) {
if
(
verbose
)
cat
(
iteration
,
": "
,
basinWithMinAutochtonousRate
$
autochtonousRate
,
'\n'
)
# basinWithMinAutochtonousRate will be merged with origin basin sending the maximum number of fish in this basin
metapopsToBeMerged
<-
exchangesDataUpdated
%>%
inner_join
(
basinWithMinAutochtonousRate
%>%
select
(
-
autochtonousRate
),
by
=
c
(
'year'
,
'migrationBasin'
))
%>%
filter
(
migrationBasin
!=
originBasin
)
%>%
# to avoid self merging
group_by
(
year
)
%>%
slice
(
which.max
(
effective
))
%>%
ungroup
()
%>%
select
(
year
,
migrationBasin
,
originBasin
)
# update the connection table between basin and metapopulation by merging metapopulation
for
(
i
in
1
:
nrow
(
metapopsToBeMerged
))
{
mergedName
=
paste0
(
"M"
,
iteration
,
'_'
,
i
)
metapopsToBeMerged_i
<-
metapopsToBeMerged
%>%
slice
(
i
)
if
(
verbose
)
cat
(
"\t"
,
metapopsToBeMerged_i
$
migrationBasin
,
' + '
,
metapopsToBeMerged_i
$
originBasin
,
' = '
,
mergedName
,
"\n"
)
metapopulation
<-
metapopulation
%>%
mutate
(
metapop
=
if_else
(
year
==
metapopsToBeMerged_i
$
year
&
metapop
%in%
(
metapopsToBeMerged_i
%>%
select
(
ends_with
(
"Basin"
))
%>%
unlist
(
use.names
=
FALSE
)),
mergedName
,
metapop
))
}
# sum by migration and origin basins according to updated metapopulations
# computed with initial exchangesData
exchangesDataUpdated
<-
exchangesData
%>%
#sum up on migration basins
inner_join
(
metapopulation
,
by
=
c
(
'year'
,
'migrationBasin'
=
'basin'
))
%>%
group_by
(
year
,
metapop
,
originBasin
)
%>%
summarise
(
effective
=
sum
(
effective
),
.groups
=
'drop'
)
%>%
rename
(
migrationBasin
=
metapop
)
%>%
# sum on origine basins
inner_join
(
metapopulation
,
by
=
c
(
'year'
,
'originBasin'
=
'basin'
))
%>%
group_by
(
year
,
metapop
,
migrationBasin
)
%>%
summarise
(
effective
=
sum
(
effective
),
.groups
=
'drop'
)
%>%
rename
(
originBasin
=
metapop
)
# minimum of autochtonous rate
basinWithMinAutochtonousRate
=
computeAutochtonousRate
(
data
=
exchangesDataUpdated
)
%>%
group_by
(
year
)
%>%
slice
(
which.min
(
autochtonousRate
))
iteration
=
iteration
+
1
}
return
(
list
(
metapopulation
=
metapopulation
,
exchangesData
=
exchangesDataUpdated
))
}
require
(
tidyverse
)
source
(
GR3Dmetapopulation
)
# upload data =====
# longer table of effective of different origin basins in each migration basin
exchangesData
<-
read_csv
(
"../../data/output/northeastamerica/effectiveFluxes_1-observed.csv"
)
exchangesData
%>%
group_by
(
year
,
basin
=
originBasin
)
%>%
summarise
(
production
=
sum
(
effective
),
.groups
=
'drop'
)
%>%
inner_join
(
exchangesData
%>%
group_by
(
year
,
basin
=
migrationBasin
)
%>%
...
...
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