shiny app 04C_logistique

Author: GuyliannEngels

inst/shiny/04c_logistique/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_plot <- renderPlot({
+
+        set.seed(42)
+
+        logis_exo <- tibble(
+            time = seq(0, 8, by = 0.1),
+            popu = SSlogis(time, Asym = 5, xmid = 4, scal = 0.5) + rnorm(
+                n = length(time), sd = 0.1),
+            popu_predit = SSlogis(time, Asym = input$asym_ui,
+                                  xmid = input$xmid_ui, scal = input$k_ui)
+        )
+
+        chart::chart(logis_exo, popu ~ time) +
+            ggplot2::geom_point() +
+            geom_line(f_aes(popu_predit ~ time), color = "red") +
+            xlab("Temps") +
+            ylab("Population")
+    })
+
+    output$logis_model <- renderUI({
+        withMathJax(
+            sprintf(
+                "Ton modèle  :
+                  $$population = \\frac{%.02f}{1 + e^{\\frac{%.02f - temps}{%.02f}}}$$",
+                    Asym = input$asym_ui,
+                    xmid = input$xmid_ui, scal = input$k_ui))
+    })
+
+
+    output$logis_resid <- renderUI({
+
+        set.seed(42)
+
+        logis_exo <- tibble(
+            time = seq(0, 8, by = 0.1),
+            popu = SSlogis(time, Asym = 5, xmid = 4, scal = 0.5) + rnorm(
+                n = length(time), sd = 0.1),
+            popu_predit = SSlogis(time, Asym = input$asym_ui,
+                                  xmid = input$xmid_ui, scal = input$k_ui),
+            distance2 = (popu_predit - popu)^2
+        )
+
+        value <- sum(logis_exo$distance2)
+
+        withMathJax(
+            sprintf("La valeur de la somme des résidus au carré de ton modèle : $$%.05f$$",
+                    value))
+    })
+
+
+    output$logis_theo <- renderPlot({
+
+        logis_data <- tibble(
+            t = seq(0, 10, by = 0.1),
+            y = SSlogis(t, Asym = 0.95, xmid = 5, scal = 0.95)
+        )
+
+        chart(data = logis_data, y ~ t) +
+            geom_line() +
+            geom_vline(xintercept = 0, col = "darkgray") +
+            geom_hline(yintercept = c(0, 0.95/2, 0.95), col = "gray", linetype = "dashed") +
+            geom_vline(xintercept = 5, col = "gray", linetype = "dashed") +
+            annotate("text", label = "Asym", x = -0.4, y = 0.95) +
+            annotate("text", label = "Asym/2", x = -0.5, y = 0.95/2) +
+            annotate("text", label = "xmid", x = 5.4, y = 0.03) +
+            annotate("text", label = "point d'inflexion", x = 6, y = 0.45) +
+            labs(x = "input")
+    })
+
+})

inst/shiny/04c_logistique/ui.R

@@ -0,0 +1,82 @@
+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("Courbe logistique"),
+    tabPanel(
+      "Un peu de théorie",
+      sidebarLayout(
+        sidebarPanel(
+          withMathJax(),
+          h4("Le Contexte"),
+          p("Le modèle exponentiel qui décrit une croissance infinie sans
+              aucunes contraintes n’est pas une hypothèse réaliste. En pratique,
+              la croissance est limitée par les ressources disponibles.
+              Verhulst (1838) propose un modèle qui tient compte d'une limite
+              théorique des ressources disponibles."),
+          h4("L'équation mathématique :"),
+          p("$$\\frac{Asym}{1 + e^{\\frac{xmid - input}{scal}}}$$"),
+          h4("Eléments importants :"),
+          p("- une croissance exponentielle"),
+          p("- deux asymptotes horizontales en 0 et en Asym"),
+          hr(),
+          h4("La fonction dans R : "),
+          p("$$SSlogis(input, Asym, xmid, scal)$$"),
+          h5("Arguments de la fonction : "),
+          p("input: est un vecteur de nombre représentant le temps."),
+          p("Asym : est la valeur maximale de y représenté par un asymptote
+              horizontale."),
+          p("xmid : est la valeur de input pour y = Asym/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 avec
+             Asym = 0.95, xmid = 5, scal = 0.95"),
+          plotOutput("logis_theo"),
+          width = 7
+        )
+      )
+    ),
+    tabPanel(
+      title = "A toi de jouer !",
+      sidebarLayout(
+        sidebarPanel(
+          withMathJax(),
+          p("La courbe logistique permet de modéliser des croissances
+             exponentielles avec la présence de deux asymptotes horizontales"),
+          p("L'équation mathématique de la fonction est la
+              suivante: $$y = \\frac{Asym}{1 + e^{\\frac{xmid - input}{scal}}}$$"),
+          numericInput(inputId = "asym_ui", label = "Valeur de Asym (asymptote horizontale)",
+                   value = 1.00, min = 0.50, max = 10.00, step = 0.5),
+          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 = "k_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_plot"),
+          hr(),
+          withMathJax(),
+          uiOutput("logis_model"),
+          hr(),
+          uiOutput("logis_resid"),
+          hr()
+        )
+      )
+    )
+  )
+)