Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
ShinyApps
briskaRShinyApp
Commits
96513f57
Commit
96513f57
authored
Sep 18, 2020
by
Virgile Baudrot
Browse files
add options for damage IT and SD models
parent
4f459005
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
R/mod_tabItemDamage.R
View file @
96513f57
...
...
@@ -60,7 +60,7 @@ mod_tabItemDamage_ui <- function(id){
For the parameters provided by default, exposure is in squarred meter
so we convert LC50 in square meter (451*10000)."
),
withMathJax
(
helpText
(
'$$\\Damage(x) = \\frac{1}{1 + (x/LC_{50})^\text{slope}}$$'
)
helpText
(
'$$\\
text{
Damage
}
(x) = \\frac{1}{1 + (x/LC_{50})^
{
\text{slope}}
}
$$'
)
),
numericInput
(
inputId
=
ns
(
"LC50DR"
),
label
=
"LC50"
,
...
...
@@ -70,18 +70,86 @@ mod_tabItemDamage_ui <- function(id){
value
=
-1.76
)
),
tabPanel
(
title
=
"
GUTS
model
- SD
"
,
tabPanel
(
title
=
"
TKTD
model"
,
value
=
"GUTSsurvDAMAGE"
,
################
# CSV FILE BEGIN
################
#Selector for file upload
fileInput
(
ns
(
'GUTSsurvDAMAGE'
),
'Choose CSV file - GUTS'
,
accept
=
c
(
'text/csv'
,
'text/comma-separated-values,text/plain'
))
##############
# CSV FILE END
##############
p
(
"For each parameter, you can either upload a single value or upload a vector."
),
p
(
"For more information about TKTD model, please see the
Scientific Opinion on the state of the art of Toxicokinetic/Toxicodynamic (TKTD) :"
,
a
(
href
=
""
,
"https://www.efsa.europa.eu/fr/efsajournal/pub/5377"
)),
tabsetPanel
(
id
=
ns
(
"tabsetDAMAGEsurv_GUTS"
),
tabPanel
(
title
=
"Stochastic Death"
,
value
=
"GUTSsurvDAMAGE_SD"
,
h4
(
tags
$
b
(
"Toxicokinetic - TK"
)),
withMathJax
(
helpText
(
'$$\\frac{D_{int}}{dt} = k_d (C_{ext} - D_{int})$$'
)
),
numericInput
(
inputId
=
ns
(
"kdSD"
),
label
=
"TK parameter - kd"
,
value
=
0.3
),
fileInput
(
ns
(
'kdSDvector'
),
'Choose CSV file - kd'
,
accept
=
c
(
'text/csv'
,
'text/comma-separated-values,text/plain'
)),
h4
(
tags
$
b
(
"Toxicodynamic - TD"
)),
withMathJax
(
helpText
(
'$$S(t) = \\exp \\left( - \\int_0^t h_b + k_k \\max( D_{int}(\tau) -z) d \\tau \\right)$$'
)
),
numericInput
(
inputId
=
ns
(
"hbSD"
),
label
=
"Back ground mortality - hb"
,
value
=
0
),
fileInput
(
ns
(
'hbSDvector'
),
'Choose CSV file - hb'
,
accept
=
c
(
'text/csv'
,
'text/comma-separated-values,text/plain'
)),
numericInput
(
inputId
=
ns
(
"zSD"
),
label
=
"Threshold - z"
,
value
=
200
),
fileInput
(
ns
(
'zSDvector'
),
'Choose CSV file - z'
,
accept
=
c
(
'text/csv'
,
'text/comma-separated-values,text/plain'
)),
numericInput
(
inputId
=
ns
(
"kkSD"
),
label
=
"Killing rate - kk"
,
value
=
0.02
),
fileInput
(
ns
(
'kkSDvector'
),
'Choose CSV file - kk'
,
accept
=
c
(
'text/csv'
,
'text/comma-separated-values,text/plain'
))
),
tabPanel
(
title
=
"Individual Tolerance"
,
value
=
"GUTSsurvDAMAGE_IT"
,
h4
(
tags
$
b
(
"Toxicokinetic - TK"
)),
withMathJax
(
helpText
(
'$$\\frac{D_{int}}{dt} = k_d (C_{ext} - D_{int})$$'
)
),
numericInput
(
inputId
=
ns
(
"kdIT"
),
label
=
"TK parameter - kd"
,
value
=
0.3
),
fileInput
(
ns
(
'kdITvector'
),
'Choose CSV file - kd'
,
accept
=
c
(
'text/csv'
,
'text/comma-separated-values,text/plain'
)),
h4
(
tags
$
b
(
"Toxicodynamic - TD"
)),
withMathJax
(
helpText
(
'$$S(t) = h_b + \\frac{1}{1 + (\\max(D_{int}(\tau))/\\alpha)^{\text{\\beta}}}$$'
)
),
numericInput
(
inputId
=
ns
(
"hbIT"
),
label
=
"Back ground mortality - hb"
,
value
=
0
),
fileInput
(
ns
(
'hbITvector'
),
'Choose CSV file - hb'
,
accept
=
c
(
'text/csv'
,
'text/comma-separated-values,text/plain'
)),
numericInput
(
inputId
=
ns
(
"alphaIT"
),
label
=
"Threshold - alpha"
,
value
=
200
),
fileInput
(
ns
(
'alphaITvector'
),
'Choose CSV file - beta'
,
accept
=
c
(
'text/csv'
,
'text/comma-separated-values,text/plain'
)),
numericInput
(
inputId
=
ns
(
"betaIT"
),
label
=
"Killing rate - kk"
,
value
=
0.02
),
fileInput
(
ns
(
'betaITvector'
),
'Choose CSV file - kk'
,
accept
=
c
(
'text/csv'
,
'text/comma-separated-values,text/plain'
))
)
)
),
selected
=
"DRsurvDAMAGE"
),
...
...
@@ -207,7 +275,39 @@ mod_tabItemDamage_server <- function(input, output, session, r){
}
if
(
input
$
tabsetDAMAGEsurv
==
"GUTSsurvDAMAGE"
){
library
(
deSolve
)
if
(
input
$
tabsetDAMAGEsurv_GUTS
==
"GUTSsurvDAMAGE_SD"
){
model_typeSelect
=
"SD"
parameterSelect
=
list
(
kk
=
input
$
kkSD
,
kd
=
input
$
kdSD
,
z
=
input
$
zSD
,
hb
=
input
$
hbSD
)
}
if
(
input
$
tabsetDAMAGEsurv_GUTS
==
"GUTSsurvDAMAGE_IT"
){
model_typeSelect
=
"IT"
parameterSelect
=
list
(
alpha
=
input
$
alphaIT
,
kd
=
input
$
kdIT
,
hb
=
input
$
hbIT
,
beta
=
input
$
betaSD
)
}
# COMPUTE DAMAGE
damageINDIVIDUAL
=
r
$
exposureINDIVIDUAL
TimeLine
=
sort
(
unique
(
tidyr
::
unnest
(
r
$
exposureINDIVIDUAL
,
c
(
Date
,
EXPOSURE
))[[
"Date"
]]))
damageINDIVIDUAL
$
TIME
=
lapply
(
1
:
nrow
(
r
$
exposureINDIVIDUAL
),
function
(
i
){
match
(
Date
,
TimeLine
)
})
damageINDIVIDUAL
$
DAMAGE
=
lapply
(
1
:
nrow
(
damageINDIVIDUAL
),
function
(
i
){
pSurvODE
(
damageINDIVIDUAL
$
EXPOSURE
[[
i
]],
damageINDIVIDUAL
$
TIME
[[
i
]],
model_typeSelect
,
parameterSelect
)
})
# model
modelSD
<-
function
(
t
,
State
,
parms
,
input
)
{
with
(
as.list
(
c
(
parms
,
State
)),
{
...
...
@@ -218,25 +318,32 @@ mod_tabItemDamage_server <- function(input, output, session, r){
list
(
res
,
hb
=
hb
,
signal
=
signal
)
})
}
modelIT
<-
function
(
t
,
State
,
parms
,
input
)
{
with
(
as.list
(
c
(
parms
,
State
)),
{
signal
=
input
(
t
)
# exposure
dD
<-
kd
*
(
signal
-
D
)
# internal concentration
dH
<-
kk
*
pmax
(
D
-
z
,
0
)
+
hb
# risk function
res
<-
c
(
dD
,
dH
)
list
(
res
,
hb
=
hb
,
signal
=
signal
)
})
}
# -----------------------------
#
# /!\ real time (date) has to be convert in indice time but should start at 0, that is 0:(length-1) !!!
#
pSurvODE
<-
function
(
exposure
,
time
,
model_type
=
"SD"
,
parameter
=
list
(
kk
,
kd
,
z
,
hb
)
){
model_type
=
model_typeSelect
,
parameter
=
parameterSelect
){
## external signal with several rectangle impulses
signal
<-
data.frame
(
times
=
time
,
import
=
exposure
)
sigimp
<-
stats
::
approxfun
(
signal
$
times
,
signal
$
import
,
method
=
"linear"
,
rule
=
2
)
times
=
time
## The parameters
if
(
model_type
==
"SD"
){
parms
<-
list
(
kk
,
kd
,
z
,
hb
)
modelFUN
=
modelSD
}
if
(
model_type
==
"IT"
){
parms
<-
list
(
beta
,
kd
,
alpha
,
hb
)
modelFUN
=
modelIT
}
## Start values for steady state
...
...
@@ -245,11 +352,17 @@ mod_tabItemDamage_server <- function(input, output, session, r){
out
<-
ode
(
y
=
xstart
,
times
=
times
,
func
=
modelFUN
,
parms
,
parms
=
parameter
,
input
=
sigimp
)
df
=
as.data.frame
(
out
)
df
$
pSurv0
=
exp
(
-
df
$
hb
*
df
$
time
)
df
$
pSurv
=
exp
(
-
out
[,
grep
(
"H"
,
colnames
(
out
))]
)
if
(
model_type
==
"SD"
){
df
$
pSurv0
=
exp
(
-
df
$
hb
*
df
$
time
)
df
$
pSurv
=
exp
(
-
out
[,
grep
(
"H"
,
colnames
(
out
))]
)
}
if
(
model_type
==
"IT"
){
df
$
pSurv0
=
exp
(
-
df
$
hb
*
df
$
time
)
#df$pSurv = exp(- out[, grep("H", colnames(out))] )
}
return
(
df
)
}
...
...
R/mod_tabItemLandscape.R
View file @
96513f57
...
...
@@ -140,6 +140,7 @@ mod_tabItemLandscape_ui <- function(id){
style
=
"color: #fff; background-color: #33595f; border-color: #052327"
)
),
column
(
width
=
6
,
p
(
"Select ID only if you upload your own Emission profile after."
),
selectizeInput
(
ns
(
"ctrlIDsource"
),
label
=
"Choose ID column"
,
choices
=
NULL
,
...
...
@@ -316,7 +317,7 @@ mod_tabItemLandscape_server <- function(input, output, session, r){
r
$
IDsource
=
"IDsource"
r
$
landscapeSOURCE
=
r
$
landscapeSOURCE
%>%
dplyr
::
mutate
(
IDsource
=
1
:
n
())
}
}
if
(
input
$
ctrlEPSGsource
!=
"initial"
){
r
$
landscapeSOURCE
<-
st_transform
(
r
$
landscapeSOURCE
,
crs
=
as.numeric
(
input
$
ctrlEPSGsource
))
}
...
...
Write
Preview
Supports
Markdown
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