Skip to content

Commit d4d55ab

Browse files
GuyliannEngelsGuyliannEngels
committed
add several shinyapps
1 parent 54b4b34 commit d4d55ab

File tree

6 files changed

+315
-19
lines changed

6 files changed

+315
-19
lines changed

‎inst/shiny/B04Sa_micmen/app.R‎

Lines changed: 1 addition & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
learndown::learndownShinyVersion("0.0.9000")
1+
learndown::learndownShinyVersion("1.0.0")
22
conf <- BioDataScience::config()
33

44
library(shiny)
@@ -27,23 +27,18 @@ ui <- fluidPage(
2727
value = 1, min = 0, max = 10, step = 0.5),
2828
sliderInput("k", label = "K",
2929
value = 1, min = 0, max = 10, step = 0.5),
30-
3130
hr(),
32-
3331
submitQuitButtons()
3432
),
3533

3634
mainPanel(
3735
plotOutput("model_plot"),
38-
3936
hr(),
40-
4137
withMathJax(),
4238
fluidRow(
4339
column(width = 6,
4440
p("Modèle paramétré :"),
4541
uiOutput("model_equation")),
46-
4742
column(width = 6,
4843
p("Somme des carrés des résidus (valeur à minimiser) :"),
4944
uiOutput("model_resid"))

‎inst/shiny/B04Sb_exponent/app.R‎

Lines changed: 8 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
learndown::learndownShinyVersion("0.0.9000")
1+
learndown::learndownShinyVersion("1.0.1")
22
conf <- BioDataScience::config()
33

44
library(shiny)
@@ -13,34 +13,34 @@ set.seed(42)
1313
exponent <- function(x, y0, k)
1414
y0 * exp(k * x)
1515

16+
model_data <- tibble::tibble(
17+
x = seq(0, 20, by = 0.5),
18+
y = exponent(x, y0 = y0_init, k = k_init) +
19+
rnorm(n = length(x), sd = error_sd))
20+
1621
ui <- fluidPage(
1722
learndownShiny("Ajustement manuel d'un modèle : courbe exponentielle"),
1823

1924
sidebarLayout(
2025
sidebarPanel(
2126
withMathJax(),
2227
p("$$y(x) = y_0 \\ e^{k \\ x}$$"),
23-
2428
sliderInput("y0", label = "y0",
2529
value = 1, min = -5, max = 5, step = 0.5),
2630
sliderInput("k", label = "k",
2731
value = 0.025, min = -0.20, max = 0.20, step = 0.025),
28-
2932
hr(),
3033
submitQuitButtons()
3134
),
3235

3336
mainPanel(
3437
plotOutput("model_plot"),
35-
3638
hr(),
37-
3839
withMathJax(),
3940
fluidRow(
4041
column(width = 6,
4142
p("Modèle paramétré :"),
4243
uiOutput("model_equation")),
43-
4444
column(width = 6,
4545
p("Somme des carrés des résidus (valeur à minimiser) :"),
4646
uiOutput("model_resid"))
@@ -53,11 +53,6 @@ ui <- fluidPage(
5353
server <- function(input, output, session) {
5454

5555

56-
model_data <- tibble::tibble(
57-
x = seq(0, 20, by = 0.5),
58-
y = exponent(x, y0 = y0_init, k = k_init) +
59-
rnorm(n = length(x), sd = error_sd))
60-
6156
model_predict <- reactive({
6257
dplyr::mutate(model_data,
6358
y_predit = exponent(x, y0 = input$y0, k = input$k),
@@ -67,7 +62,8 @@ server <- function(input, output, session) {
6762

6863
output$model_equation <- renderUI({
6964
withMathJax(
70-
sprintf("$$y(x) \\ = %.02f \\ e^{%.02f \\ x}$$", input$vm, input$k))
65+
sprintf("$$y(x) = %.02f \\ e^{ %.02f \\ x}$$", input$y0, input$k)
66+
)
7167
})
7268

7369
output$model_resid <- renderUI({

‎inst/shiny/B04Sc_logis/app.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
learndown::learndownShinyVersion("0.0.9000")
1+
learndown::learndownShinyVersion("1.0.0")
22
conf <- BioDataScience::config()
33

44
library(shiny)

‎inst/shiny/B04Sd_gen_logis/app.R‎

Lines changed: 103 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,103 @@
1+
learndown::learndownShinyVersion("1.0.0")
2+
conf <- BioDataScience::config()
3+
4+
library(shiny)
5+
library(learndown)
6+
library(BioDataScience2)
7+
8+
b_init <- 8
9+
a_init <- 2
10+
xmid_init <- 4
11+
scal_init <- 0.5
12+
error_sd <- 0.1
13+
set.seed(42)
14+
15+
16+
model_data <- tibble::tibble(
17+
x = seq(0, 8, by = 0.1),
18+
y = SSfpl(x, A = a_init, B = b_init, xmid = xmid_init, scal = scal_init) +
19+
rnorm(n = length(x), sd = error_sd))
20+
21+
ui <- fluidPage(
22+
learndownShiny("Ajustement manuel d'un modèle : modèle logistique généralisé"),
23+
24+
sidebarLayout(
25+
sidebarPanel(
26+
withMathJax(),
27+
p("$$y(x) = \\frac{A + (B-A) }{1 + e^{\\frac{xmid - x}{scal}}}$$"),
28+
29+
sliderInput("a", label = "A : Asymptote horizontale basse",
30+
value = 1.00, min = 0.50, max = 10.00, step = 0.5),
31+
sliderInput("b", label = "B : Asymptote horizontale Haute",
32+
value = 1.00, min = 0.50, max = 10.00, step = 0.5),
33+
sliderInput("xmid", label = "Xmid",
34+
value = 1.00, min = 0.25, max = 10.00, step = 0.25),
35+
sliderInput("scal", label = "Scal",
36+
value = 1.00, min = 0.25, max = 10.00, step = 0.25),
37+
hr(),
38+
submitQuitButtons()
39+
),
40+
41+
mainPanel(
42+
plotOutput("model_plot"),
43+
44+
hr(),
45+
46+
withMathJax(),
47+
fluidRow(
48+
column(width = 6,
49+
p("Modèle paramétré :"),
50+
uiOutput("model_equation")),
51+
52+
column(width = 6,
53+
p("Somme des carrés des résidus (valeur à minimiser) :"),
54+
uiOutput("model_resid"))
55+
)
56+
)
57+
)
58+
)
59+
60+
61+
server <- function(input, output, session) {
62+
63+
model_predict <- reactive({
64+
dplyr::mutate(model_data,
65+
y_predit = SSfpl(x, A = input$a, B = input$b,
66+
xmid = input$xmid, scal = input$scal),
67+
distance2 = (y_predit - y)^2
68+
)
69+
})
70+
71+
output$model_equation <- renderUI({
72+
withMathJax(
73+
#sprintf("$$y(x) = \\frac{%.02f}{1 + e^{\\frac{%.02f - x}{%.02f}}}$$", input$asym, input$xmid, input$scal)
74+
sprintf("$$y(x) = \\frac{ %.02f + (%.02f - %.02f) }{1 + e^{\\frac{%.02f - x}{%.02f}}}$$", input$a, input$b, input$a,input$xmid, input$scal)
75+
)
76+
})
77+
78+
output$model_resid <- renderUI({
79+
data <- model_predict()
80+
withMathJax(sprintf("$$ \\ %.02f \\ $$", sum(data$distance2)))
81+
})
82+
83+
output$model_plot <- renderPlot({
84+
data <- model_predict()
85+
86+
chart::chart(data, y ~ x) +
87+
ggplot2::geom_point() +
88+
ggplot2::geom_line(chart::f_aes(y_predit ~ x), color = "red") +
89+
ggplot2::xlab("x") +
90+
ggplot2::ylab("y")
91+
})
92+
93+
trackEvents(session, input, output,
94+
sign_in.fun = BioDataScience::sign_in, config = conf)
95+
trackSubmit(session, input, output, max_score = 4, solution =
96+
list(b = b_init, a = a_init, xmid = xmid_init, scal = scal_init),
97+
comment = "y(x) = (A+(B-A))/(1+e^((xmid-x)/scal))",
98+
message.success = "Correct, c'est le meilleur modèle.",
99+
message.error = "Incorrect, un modèle mieux ajusté existe.")
100+
trackQuit(session, input, output, delay = 20)
101+
}
102+
103+
shinyApp(ui, server)

‎inst/shiny/B04Se_gompertz/app.R‎

Lines changed: 98 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,98 @@
1+
learndown::learndownShinyVersion("1.0.0")
2+
conf <- BioDataScience::config()
3+
4+
library(shiny)
5+
library(learndown)
6+
library(BioDataScience2)
7+
8+
asym_init <- 1
9+
b2_init <- 5
10+
b3_init <- 0.5
11+
error_sd <- 0.05
12+
set.seed(42)
13+
14+
15+
model_data <- tibble::tibble(
16+
x = seq(0, 10, by = 0.1),
17+
y = SSgompertz(x, Asym = asym_init, b2 = b2_init, b3 = b3_init) +
18+
rnorm(n = length(x), sd = error_sd))
19+
20+
ui <- fluidPage(
21+
learndownShiny("Ajustement manuel d'un modèle : modèle de Gompertz"),
22+
23+
sidebarLayout(
24+
sidebarPanel(
25+
withMathJax(),
26+
p("$$y(x) = Asym * e^{- b_{2} * b_{3}^x}$$"),
27+
28+
sliderInput("asym", label = "Asym",
29+
value = 0.00, min = -5.00, max = 5.00, step = 0.5),
30+
sliderInput("b2", label = "b2",
31+
value = 1.00, min = 0, max = 10.00, step = 0.5),
32+
sliderInput("b3", label = "b3",
33+
value = 1.00, min = -2.00, max = 2.00, step = 0.25),
34+
hr(),
35+
submitQuitButtons()
36+
),
37+
38+
mainPanel(
39+
plotOutput("model_plot"),
40+
41+
hr(),
42+
43+
withMathJax(),
44+
fluidRow(
45+
column(width = 6,
46+
p("Modèle paramétré :"),
47+
uiOutput("model_equation")),
48+
49+
column(width = 6,
50+
p("Somme des carrés des résidus (valeur à minimiser) :"),
51+
uiOutput("model_resid"))
52+
)
53+
)
54+
)
55+
)
56+
57+
58+
server <- function(input, output, session) {
59+
60+
model_predict <- reactive({
61+
dplyr::mutate(model_data,
62+
y_predit = SSgompertz(x, Asym = input$asym, b2 = input$b2, b3 = input$b3),
63+
distance2 = (y_predit - y)^2
64+
)
65+
})
66+
67+
output$model_equation <- renderUI({
68+
withMathJax(
69+
sprintf("$$y(x) = %.02f * e^{- %.02f * %.02f^x}$$", input$asym, input$b2, input$b3)
70+
)
71+
})
72+
73+
output$model_resid <- renderUI({
74+
data <- model_predict()
75+
withMathJax(sprintf("$$ \\ %.02f \\ $$", sum(data$distance2)))
76+
})
77+
78+
output$model_plot <- renderPlot({
79+
data <- model_predict()
80+
81+
chart::chart(data, y ~ x) +
82+
ggplot2::geom_point() +
83+
ggplot2::geom_line(chart::f_aes(y_predit ~ x), color = "red") +
84+
ggplot2::xlab("x") +
85+
ggplot2::ylab("y")
86+
})
87+
88+
trackEvents(session, input, output,
89+
sign_in.fun = BioDataScience::sign_in, config = conf)
90+
trackSubmit(session, input, output, max_score = 3, solution =
91+
list(asym = asym_init, b2 = b2_init, b3 = b3_init),
92+
comment = "y(x) = Asym * e^(- b2 * b3^x)",
93+
message.success = "Correct, c'est le meilleur modèle.",
94+
message.error = "Incorrect, un modèle mieux ajusté existe.")
95+
trackQuit(session, input, output, delay = 20)
96+
}
97+
98+
shinyApp(ui, server)

0 commit comments

Comments
 (0)