add shiny app 04d_logistique_gen

Author: GuyliannEngels

inst/shiny/04d_logistique_gen/server.R

@@ -0,0 +1,85 @@
+#
+# This is the server logic of a Shiny web application. You can run the
+# application by clicking 'Run App' above.
+#
+# Find out more about building applications with Shiny here:
+#
+#    http://shiny.rstudio.com/
+#
+
+library(shiny)
+SciViews::R()
+
+# Define server logic required to draw a histogram
+shinyServer(function(input, output) {
+
+    output$logis_gen_plot <- renderPlot({
+
+        set.seed(42)
+
+        logis_gen_exo <- tibble(
+            time = seq(0, 8, by = 0.1),
+            popu = SSfpl(time, A = 2, B = 8, xmid = 4, scal = 0.5) + rnorm(
+                n = length(time), sd = 0.1),
+            popu_predit = SSfpl(time, A = input$a_ui, B = input$b_ui,
+                                  xmid = input$xmid_ui, scal = input$scal_ui)
+        )
+
+        chart::chart(logis_gen_exo, popu ~ time) +
+            ggplot2::geom_point() +
+            geom_line(f_aes(popu_predit ~ time), color = "red") +
+            xlab("Temps") +
+            ylab("Population")
+    })
+
+    output$logis_gen_model <- renderUI({
+        withMathJax(
+            sprintf(
+                "Ton modèle  :
+                  $$population = \\frac{%.02f + (%.02f - %.02f) }{1 + e^{\\frac{%.02f - temps}{%.02f}}}$$",
+                input$a_ui, input$b_ui, input$a_ui,
+                input$xmid_ui, input$scal_ui))
+    })
+
+
+    output$logis_gen_resid <- renderUI({
+
+        set.seed(42)
+
+        logis_gen_exo <- tibble(
+            time = seq(0, 8, by = 0.1),
+            popu = SSfpl(time, A = 2, B = 8, xmid = 4, scal = 0.5) + rnorm(
+                n = length(time), sd = 0.1),
+            popu_predit = SSfpl(time, A = input$a_ui, B = input$b_ui,
+                                xmid = input$xmid_ui, scal = input$scal_ui),
+            distance2 = (popu_predit - popu)^2
+        )
+
+        value <- sum(logis_gen_exo$distance2)
+
+        withMathJax(
+            sprintf("La valeur de la somme des résidus au carré de ton modèle : $$%.05f$$",
+                    value))
+    })
+
+
+    output$logis_gen_theo <- renderPlot({
+
+        fpl_data <- tibble(
+            t = seq(0, 10, by = 0.1),
+            y = SSfpl(t, A = 0.15, B = 0.95, xmid = 5, scal = 1)
+        )
+        chart(data = fpl_data, y ~ t) +
+            geom_line() +
+            geom_vline(xintercept = 0, col = "darkgray") +
+            geom_hline(yintercept = c(0.15, 0.8/2 + 0.15, 0.95), col = "gray",
+                       linetype = "dashed") +
+            geom_vline(xintercept = 5, col = "gray", linetype = "dashed") +
+            annotate("text", label = "A", x = -0.4, y = 0.15) +
+            annotate("text", label = "B", x = -0.4, y = 0.95) +
+            annotate("text", label = "xmid", x = 5.4, y = 0.13) +
+            annotate("text", label = "point d'inflexion", x = 6.1, y = 0.53) +
+            labs(x = "input")
+    })
+
+})

inst/shiny/04d_logistique_gen/ui.R

@@ -0,0 +1,86 @@
+library(shiny)
+
+titlePanel_h4 <- function(title, windowTitle = title) {
+  tagList(tags$head(tags$title(windowTitle)), h4(title))
+}
+
+# Define UI for application that draws a histogram
+shinyUI(
+  navbarPage(
+    title = titlePanel_h4("Modèle logistique généralisé"),
+    tabPanel(
+      "Un peu de théorie",
+      sidebarLayout(
+        sidebarPanel(
+          withMathJax(),
+          h4("Le Contexte"),
+          p("Le modèle logistique généralisé est une version généralisée du
+              modèle logistique qui admet 4 paramètres. Il est possible avec ce
+              modèle de faire varier les deux asymptotes."),
+          h4("L'équation mathématique :"),
+          p("$$\\frac{A + (B-A)}{1 + e^{\\frac{xmid - input}{scal}}}$$"),
+          h4("Eléments importants :"),
+          p("- une croissance exponentielle"),
+          p("- deux asymptotes horizontales variables"),
+          hr(),
+          h4("La fonction dans R : "),
+          p("$$SSfpl(input, A, B, xmid, scal)$$"),
+          h5("Arguments de la fonction : "),
+          p("input: est un vecteur de nombre représentant le temps."),
+          p("A : est la valeur minimale de y représenté par un asymptote
+              horizontale."),
+          p("B : est la valeur maximale de y représenté par un asymptote
+              horizontale."),
+          p("xmid : est la valeur de input pour y = (B+A)/2"),
+          p("scal: exprime la vitesse de croissance. une valeur faible de scal
+              indique une vitesse lente et un faible valeur de scal indique une
+               vitesse élevé"),
+          width = 5
+        ),
+        mainPanel(
+          p("Le graphique ci-dessous représente une courbe logistique généralisé avec
+             A = 0.15, B = 0.95, xmid = 5, scal = 1"),
+          plotOutput("logis_gen_theo"),
+          width = 7
+        )
+      )
+    ),
+    tabPanel(
+      title = "A toi de jouer !",
+      sidebarLayout(
+        sidebarPanel(
+          withMathJax(),
+          p("La courbe logistique généralisée permet de modéliser des
+             croissances exponentielles avec la présence de deux asymptotes
+            horizontales variables"),
+          p("L'équation mathématique de la fonction est la
+              suivante: $$y = \\frac{A + (B-A) }{1 + e^{\\frac{xmid - input}{scal}}}$$"),
+          numericInput(inputId = "a_ui", label = "Valeur de A (asymptote horizontale basse)",
+                   value = 0.50, min = 0.250, max = 10.00, step = 0.25),
+          p("Valeur par défaut : 0.50"),
+          numericInput(inputId = "b_ui", label = "Valeur de B (asymptote horizontale haute)",
+                       value = 1.00, min = 0.25, max = 10.00, step = 0.25),
+          p("Valeur par défaut : 1"),
+          numericInput(inputId = "xmid_ui", label = "Valeur de xmid",
+                   value = 1.00, min = 0.25, max = 10.00, step = 0.25),
+          p("Valeur par défaut : 1"),
+          numericInput(inputId = "scal_ui", label = "Valeur de scal",
+                       value = 1.00, min = 0.25, max = 10.00, step = 0.25),
+          p("Valeur par défaut : 1")
+        ),
+        mainPanel(
+          h4("Ajustez le meilleur modèle logistique"),
+          p("Vous devez ajuster votre modèle en faisant varier les
+              paramètres du modèle."),
+          plotOutput("logis_gen_plot"),
+          hr(),
+          withMathJax(),
+          uiOutput("logis_gen_model"),
+          hr(),
+          uiOutput("logis_gen_resid"),
+          hr()
+        )
+      )
+    )
+  )
+)