aitech-wizualizacja/05.ipynb

{
 "cells": [
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "![Logo 1](https://git.wmi.amu.edu.pl/AITech/Szablon/raw/branch/master/Logotyp_AITech1.jpg)\n",
    "<div class=\"alert alert-block alert-info\">\n",
    "<h1> Wizualizacja danych </h1>\n",
    "<h2> 12-15. <i>Biblioteka shiny</i> [laboratoria]</h2>\n",
    "<h3>Tomasz Górecki (2021)</h3>\n",
    "</div>\n",
    "\n",
    "![Logo 2](https://git.wmi.amu.edu.pl/AITech/Szablon/raw/branch/master/Logotyp_AITech2.jpg)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 3,
   "metadata": {},
   "outputs": [],
   "source": [
    "library(repr) # To resize plots in Jupyter\n",
    "options(repr.plot.width = 16, repr.plot.height = 9)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 2,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "Warning message:\n",
      "“package ‘ggplot2’ was built under R version 3.6.2”\n",
      "Warning message:\n",
      "“package ‘dplyr’ was built under R version 3.6.2”\n",
      "\n",
      "Attaching package: ‘dplyr’\n",
      "\n",
      "\n",
      "The following objects are masked from ‘package:stats’:\n",
      "\n",
      "    filter, lag\n",
      "\n",
      "\n",
      "The following objects are masked from ‘package:base’:\n",
      "\n",
      "    intersect, setdiff, setequal, union\n",
      "\n",
      "\n"
     ]
    }
   ],
   "source": [
    "library(shiny) # Main library\n",
    "library(ggplot2) # Plots\n",
    "library(dplyr) # Data manipulate\n",
    "library(babynames) # Data set"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "# shiny"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "[*shiny*](https://shiny.rstudio.com/) to pakiet R, który ułatwia tworzenie wysoce interaktywnych aplikacji internetowych bezpośrednio w R. Korzystając z *shiny*, analitycy danych mogą tworzyć interaktywne aplikacje internetowe, które umożliwiają zespołowi zanurzenie się i eksplorowanie danych w postaci pulpitów nawigacyjnych (dashboard) lub wizualizacji."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Podstawowa budowa aplikacji *shiny*\n",
    "\n",
    "library(shiny) # Load shiny library\n",
    "\n",
    "ui <- fluidPage() # Create the UI with a HTML\n",
    "\n",
    "server <- function(input, output, session) {} # Define a custom function to create the server\n",
    "\n",
    "shinyApp(ui = ui, server = server) # Run the app\n",
    "\n",
    "- Add inputs (UI)\n",
    "- Add outputs (UI/Server) \n",
    "- Update layout (UI)\n",
    "- Update outputs (Server)\n",
    "\n",
    "\n",
    "*shiny* zapewnia szeroką gamę danych wejściowych, które pozwalają użytkownikom zapewnić następujące dane:\n",
    "\n",
    "- tekst (*textInput, selectInput*), \n",
    "- liczby (*numericInput, sliderInput*), \n",
    "- wartośći logiczne (*checkBoxInput, radioInput*), \n",
    "- daty (*dateInput, dateRangeInput*).\n",
    "\n",
    "\n",
    "Wyjście:\n",
    "\n",
    "- *textOutput, renderText*, \n",
    "- *tableOutput, renderTable*,\n",
    "- *imageOutput, renderImage*,\n",
    "- *plotOutput, renderPlot*,\n",
    "- *DT::DTOutput(), DT::renderDT()* - interaktywne tabele."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 4,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n"
     ]
    }
   ],
   "source": [
    "ui <- fluidPage(\n",
    "  textInput('name', 'What is your name?'), # Input \n",
    "  textOutput('greeting') # Output\n",
    ")\n",
    "\n",
    "server <- function(input, output) {\n",
    "  output$greeting <- renderText({ \n",
    "    paste('Hello', input$name)\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui = ui, server = server)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 6,
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "<table>\n",
       "<caption>A tibble: 6 × 5</caption>\n",
       "<thead>\n",
       "\t<tr><th scope=col>year</th><th scope=col>sex</th><th scope=col>name</th><th scope=col>n</th><th scope=col>prop</th></tr>\n",
       "\t<tr><th scope=col>&lt;dbl&gt;</th><th scope=col>&lt;chr&gt;</th><th scope=col>&lt;chr&gt;</th><th scope=col>&lt;int&gt;</th><th scope=col>&lt;dbl&gt;</th></tr>\n",
       "</thead>\n",
       "<tbody>\n",
       "\t<tr><td>1880</td><td>F</td><td>Mary     </td><td>7065</td><td>0.07238</td></tr>\n",
       "\t<tr><td>1880</td><td>F</td><td>Anna     </td><td>2604</td><td>0.02668</td></tr>\n",
       "\t<tr><td>1880</td><td>F</td><td>Emma     </td><td>2003</td><td>0.02052</td></tr>\n",
       "\t<tr><td>1880</td><td>F</td><td>Elizabeth</td><td>1939</td><td>0.01987</td></tr>\n",
       "\t<tr><td>1880</td><td>F</td><td>Minnie   </td><td>1746</td><td>0.01789</td></tr>\n",
       "\t<tr><td>1880</td><td>F</td><td>Margaret </td><td>1578</td><td>0.01617</td></tr>\n",
       "</tbody>\n",
       "</table>\n"
      ],
      "text/latex": [
       "A tibble: 6 × 5\n",
       "\\begin{tabular}{lllll}\n",
       " year & sex & name & n & prop\\\\\n",
       " <dbl> & <chr> & <chr> & <int> & <dbl>\\\\\n",
       "\\hline\n",
       "\t 1880 & F & Mary      & 7065 & 0.07238\\\\\n",
       "\t 1880 & F & Anna      & 2604 & 0.02668\\\\\n",
       "\t 1880 & F & Emma      & 2003 & 0.02052\\\\\n",
       "\t 1880 & F & Elizabeth & 1939 & 0.01987\\\\\n",
       "\t 1880 & F & Minnie    & 1746 & 0.01789\\\\\n",
       "\t 1880 & F & Margaret  & 1578 & 0.01617\\\\\n",
       "\\end{tabular}\n"
      ],
      "text/markdown": [
       "\n",
       "A tibble: 6 × 5\n",
       "\n",
       "| year &lt;dbl&gt; | sex &lt;chr&gt; | name &lt;chr&gt; | n &lt;int&gt; | prop &lt;dbl&gt; |\n",
       "|---|---|---|---|---|\n",
       "| 1880 | F | Mary      | 7065 | 0.07238 |\n",
       "| 1880 | F | Anna      | 2604 | 0.02668 |\n",
       "| 1880 | F | Emma      | 2003 | 0.02052 |\n",
       "| 1880 | F | Elizabeth | 1939 | 0.01987 |\n",
       "| 1880 | F | Minnie    | 1746 | 0.01789 |\n",
       "| 1880 | F | Margaret  | 1578 | 0.01617 |\n",
       "\n"
      ],
      "text/plain": [
       "  year sex name      n    prop   \n",
       "1 1880 F   Mary      7065 0.07238\n",
       "2 1880 F   Anna      2604 0.02668\n",
       "3 1880 F   Emma      2003 0.02052\n",
       "4 1880 F   Elizabeth 1939 0.01987\n",
       "5 1880 F   Minnie    1746 0.01789\n",
       "6 1880 F   Margaret  1578 0.01617"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "head(babynames)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 6,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n"
     ]
    }
   ],
   "source": [
    "ui <- fluidPage(\n",
    "  titlePanel('Baby Name Explorer'),\n",
    "  textInput('name', 'Enter Name', 'Tomas'),\n",
    "  plotOutput('trend')\n",
    ")\n",
    "\n",
    "server <- function(input, output, session) {\n",
    "  output$trend <- renderPlot({\n",
    "    babynames %>%\n",
    "      filter(name == input$name) %>%\n",
    "      ggplot(aes(x = year, y = prop, color = sex)) + \n",
    "      geom_line()\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui = ui, server = server)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 7,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n"
     ]
    }
   ],
   "source": [
    "ui <- fluidPage(\n",
    "  titlePanel(\"What's in a Name?\"),\n",
    "  selectInput('sex', \n",
    "              'Select sex', \n",
    "              selected = 'F',\n",
    "              choices = c('F', 'M')),\n",
    "  sliderInput('year', \n",
    "              'Select year',\n",
    "              value = 1900, \n",
    "              min = 1880, \n",
    "              max = 2017),\n",
    "  plotOutput('PlotTopNames')\n",
    ")\n",
    "\n",
    "server <- function(input, output, session){\n",
    "  output$PlotTopNames <- renderPlot({\n",
    "    babynames %>% \n",
    "      filter(sex == input$sex, year == input$year) %>% \n",
    "      top_n(10, prop) %>% \n",
    "      ggplot(aes(x = name, y = prop)) +\n",
    "      geom_col(fill = 'navy')\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui = ui, server = server)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 8,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n"
     ]
    }
   ],
   "source": [
    "ui <- fluidPage(\n",
    "  titlePanel(\"What's in a Name?\"),\n",
    "  selectInput('sex', \n",
    "              'Select sex', \n",
    "              selected = 'F',\n",
    "              choices = c('M', 'F')),\n",
    "  sliderInput('year', \n",
    "              'Select year', \n",
    "              min = 1880, \n",
    "              max = 2017, \n",
    "              value = 1900),\n",
    "  DT::dataTableOutput('tableNames')\n",
    ")\n",
    "\n",
    "server <- function(input, output, session){\n",
    "  output$tableNames <- DT::renderDataTable({\n",
    "    babynames %>% \n",
    "      filter(sex == input$sex) %>% \n",
    "      filter(year == input$year) %>% \n",
    "      DT::datatable()\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui = ui, server = server)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Layouty i szablony\n",
    "\n",
    "1. **Layout**. Layout functions allow inputs and outputs to be visually arranged in the UI. A well-chosen layout makes a *shiny* app aesthetically more appealing, and also improves the user experience.\n",
    "\n",
    "2. **Theme**. *shiny* makes it easy to customize the theme of an app. The UI functions in *shiny* make use of [**Twitter Bootstrap**](https://getbootstrap.com/), a popular framework for building web applications. There are a lot of built-in themes in *shinythemes* library, and if none of them suit your fancy, you can learn how to further customize your app with custom CSS.\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 9,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n"
     ]
    }
   ],
   "source": [
    "# Layout\n",
    "\n",
    "ui <- fluidPage(\n",
    "  titlePanel(\"What's in a Name?\"),\n",
    "  sidebarLayout(\n",
    "    sidebarPanel(\n",
    "      selectInput('sex', \n",
    "                  'Select sex', \n",
    "                  selected = 'F',\n",
    "                  choices = c('M', 'F')),\n",
    "      sliderInput('year', \n",
    "                  'Select year', \n",
    "                  min = 1880, \n",
    "                  max = 2017, \n",
    "                  value = 1900)\n",
    "    ),\n",
    "    mainPanel(\n",
    "      tabsetPanel(tabPanel('Table',\n",
    "                           DT::dataTableOutput('tableNames')), \n",
    "                  tabPanel('Plot',\n",
    "                           plotOutput('PlotTopNames'))\n",
    "      )\n",
    "    )\n",
    "  )\n",
    ")\n",
    "\n",
    "server <- function(input, output, session){\n",
    "  output$tableNames <- DT::renderDataTable({\n",
    "    babynames %>% \n",
    "      filter(sex == input$sex) %>% \n",
    "      filter(year == input$year) %>% \n",
    "      DT::datatable()\n",
    "  })\n",
    "  \n",
    "  output$PlotTopNames <- renderPlot({\n",
    "    babynames %>% \n",
    "      filter(sex == input$sex, year == input$year) %>% \n",
    "      top_n(10, prop) %>% \n",
    "      ggplot(aes(x = name, y = prop)) +\n",
    "      geom_col(fill = 'navy')\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui = ui, server = server)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 10,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n"
     ]
    }
   ],
   "source": [
    "# Themes\n",
    "\n",
    "ui <- fluidPage(\n",
    "  shinythemes::themeSelector(),\n",
    "  theme = shinythemes::shinytheme('flatly'),\n",
    "  titlePanel(\"What's in a Name?\"),\n",
    "  selectInput('sex', \n",
    "              'Select sex', \n",
    "              selected = 'F',\n",
    "              choices = c('M', 'F')),\n",
    "  sliderInput('year', \n",
    "              'Select year', \n",
    "              min = 1880, \n",
    "              max = 2017, \n",
    "              value = 1900),\n",
    "  DT::dataTableOutput('tableNames')\n",
    ")\n",
    "\n",
    "server <- function(input, output, session){\n",
    "  output$tableNames <- DT::renderDataTable({\n",
    "    babynames %>% \n",
    "      filter(sex == input$sex) %>% \n",
    "      filter(year == input$year) %>% \n",
    "      DT::datatable()\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui = ui, server = server)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Reactive\n",
    "The magic behind Shiny is driven by *reactivity*. There are three types of reactive components in a Shiny app. \n",
    "1. Reactive source: User input that comes through a browser interface, typically.\n",
    "2. Reactive conductor: Reactive component between a source and an endpoint, typically used to encapsulate slow computations.\n",
    "3. Reactive endpoint: Something that appears in the user's browser window, such as a plot or a table of values.\n",
    "\n",
    "Reactive expressions are *lazy* (evaluated only when it is called) and *cached* (evaluated only when the value of one of its underlying dependencies changes).\t\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 11,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n"
     ]
    }
   ],
   "source": [
    "ui <- fluidPage(\n",
    "  titlePanel('BMI Calculator'),\n",
    "  sidebarLayout(\n",
    "    sidebarPanel(\n",
    "      numericInput('height', 'Enter your height in meters', 1.7, 1, 2.2),\n",
    "      numericInput('weight', 'Enter your weight in Kilograms', 70, 35, 200)\n",
    "    ),\n",
    "    mainPanel(\n",
    "      textOutput('bmi'),\n",
    "      textOutput('bmiRange')\n",
    "    )\n",
    "  )\n",
    ")\n",
    "\n",
    "server <- function(input, output, session) {\n",
    "  rvalBMI <- reactive({\n",
    "    input$weight / (input$height^2)\n",
    "  })\n",
    "  \n",
    "  output$bmi <- renderText({\n",
    "    bmi <- rvalBMI() # First call\n",
    "    paste('Your BMI is', round(bmi, 1))\n",
    "  })\n",
    "  \n",
    "  output$bmiRange <- renderText({\n",
    "    bmi <- rvalBMI() # Second call (we used cached data)\n",
    "    bmiStatus <- cut(bmi, \n",
    "                     breaks = c(0, 18.5, 24.9, 29.9, 100),\n",
    "                     labels = c('underweight', 'healthy', 'overweight', 'obese')\n",
    "    )\n",
    "    paste('You are', bmiStatus)\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui = ui, server = server)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Observers\n",
    "An *observer* is used for side effects, like displaying a plot, table, or text in the browser. By default an observer triggers an action, whenever one of its underlying dependencies change. As we are triggering an action using an observer, we do not need to use a *render***()* function or assign the results to an output."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 12,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n"
     ]
    }
   ],
   "source": [
    "ui <- fluidPage(\n",
    "  textInput('name', 'Enter your name')\n",
    ")\n",
    "\n",
    "server <- function(input, output, session) {\n",
    "  observe({\n",
    "    showNotification(\n",
    "      paste('You entered the name', input$name)\n",
    "    ) \n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui = ui, server = server)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Observers vs. reactives\n",
    "\n",
    "1. Role\n",
    "    - *reactive()* is for calculating values, without side effects.\n",
    "    - *observe()* is for performing actions, with side effects.\t\n",
    "2. Differences\n",
    "    - Reactive expressions return values, but observers don't.\n",
    "    - Observers eagerly respond to changes in their dependencies, while reactive expressions are lazy.\n",
    "    - Observers are primarily useful for their side effects, whereas, reactive expressions must not have side effects."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Stop, delay, trigger\n",
    "### Stop\n",
    "The *isolate()* function allows an expression to read a reactive value without triggering re-execution when its value changes.\t\n",
    "### Delay\n",
    "The function *eventReactive()* is used to compute a reactive value that only updates in response to a specific event.\n",
    "### Trigger\n",
    "There are times when you want to perform an action in response to an event. The *observeEvent()* function allows you to achieve this.\t"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 13,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n"
     ]
    }
   ],
   "source": [
    "# Isolate\n",
    "ui <- fluidPage(\n",
    "  titlePanel('BMI Calculator'),\n",
    "  sidebarLayout(\n",
    "    sidebarPanel(\n",
    "      textInput('name', 'Enter your name'),\n",
    "      numericInput('height', 'Enter your height in meters', 1.7, 1, 2.2),\n",
    "      numericInput('weight', 'Enter your weight in Kilograms', 70, 35, 200)\n",
    "    ),\n",
    "    mainPanel(\n",
    "      textOutput('bmi')\n",
    "    )\n",
    "  )\n",
    ")\n",
    "\n",
    "server <- function(input, output, session) {\n",
    "  rvalBMI <- reactive({\n",
    "    input$weight / (input$height^2)\n",
    "  })\n",
    "  \n",
    "  output$bmi <- renderText({\n",
    "    bmi <- rvalBMI()\n",
    "    paste('Hi', isolate({input$name}), '. Your BMI is', round(bmi, 1))\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui = ui, server = server)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 14,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n"
     ]
    }
   ],
   "source": [
    "# eventReactive\n",
    "ui <- fluidPage(\n",
    "  titlePanel('BMI Calculator'),\n",
    "  sidebarLayout(\n",
    "    sidebarPanel(\n",
    "      textInput('name', 'Enter your name'),\n",
    "      numericInput('height', 'Enter your height in meters', 1.7, 1, 2.2),\n",
    "      numericInput('weight', 'Enter your weight in Kilograms', 70, 35, 200),\n",
    "      actionButton('showBMI', 'Show BMI')\n",
    "    ),\n",
    "    mainPanel(\n",
    "      textOutput('bmi')\n",
    "    )\n",
    "  )\n",
    ")\n",
    "\n",
    "server <- function(input, output, session) {\n",
    "  # Delay the calculation until the user clicks on the showBMI button (Show BMI)\n",
    "  rvalBMI <- eventReactive(input$showBMI, {\n",
    "    input$weight/(input$height^2)\n",
    "  })\n",
    "  \n",
    "  output$bmi <- renderText({\n",
    "    bmi <- rvalBMI()\n",
    "    paste(\"Hi\", input$name, \". Your BMI is\", round(bmi, 1))\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui = ui, server = server)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 15,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n"
     ]
    }
   ],
   "source": [
    "# observeEvent\n",
    "bmiHelpText <- \"Body Mass Index is a simple calculation using a person's height and weight. The formula is BMI = kg/m2 where kg is a person's weight in kilograms and m2 is their height in metres squared. A BMI of 25.0 or more is overweight, while the healthy range is 18.5 to 24.9.\"\n",
    "\n",
    "ui <- fluidPage(\n",
    "  titlePanel('BMI Calculator'),\n",
    "  sidebarLayout(\n",
    "    sidebarPanel(\n",
    "      textInput('name', 'Enter your name'),\n",
    "      numericInput('height', 'Enter your height in meters', 1.7, 1, 2.2),\n",
    "      numericInput('weight', 'Enter your weight in Kilograms', 70, 35, 200),\n",
    "      actionButton('showBMI', 'Show BMI'),\n",
    "      actionButton('showHelp', 'Help')\n",
    "    ),\n",
    "    mainPanel(\n",
    "      textOutput('bmi')\n",
    "    )\n",
    "  )\n",
    ")\n",
    "\n",
    "server <- function(input, output, session) {\n",
    "  # The help text is displayed when a user clicks on the Help button.\n",
    "  observeEvent(input$showHelp, {\n",
    "    showModal(modalDialog(bmiHelpText))\n",
    "  })\n",
    "  \n",
    "  rvalBMI <- eventReactive(input$showBMI, {\n",
    "    input$weight / (input$height^2)\n",
    "  })\n",
    "  \n",
    "  output$bmi <- renderText({\n",
    "    bmi <- rvalBMI()\n",
    "    paste('Hi', input$name, '. Your BMI is', round(bmi, 1))\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui = ui, server = server)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## [Karta pomocy](https://shiny.rstudio.com/images/shiny-cheatsheet.pdf)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "# Zadania"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "1. Zaprojektowano aplikację, która pozwala użytkownikowi wybrać liczbę pomiędzy 1 a 50 i wyświetlić wynik iloczynu tej liczby i 5."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "\n",
      "Listening on http://127.0.0.1:3182\n",
      "\n",
      "Warning message:\n",
      "“Error in renderText: nie znaleziono obiektu 'x'”\n"
     ]
    }
   ],
   "source": [
    "ui <- fluidPage(\n",
    "  sliderInput(\"x\", label = \"If x is\", min = 1, max = 50, value = 30),\n",
    "  \"then x times 5 is\",\n",
    "  textOutput(\"product\")\n",
    ")\n",
    "\n",
    "server <- function(input, output, session) {\n",
    "  output$product <- renderText({ \n",
    "    x * 5\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui, server)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Niestety nie działa:\n",
    "\n",
    "<img src=\"figs/ex5_1.png\" width=\"600\">\n",
    "\n",
    "Popraw aplikację tak aby działała."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "2. Rozbuduj aplikację z poprzedniego ćwiczenia tak, aby pozwala użytkownikowi ustawić wartość mnożnika.\n",
    "\n",
    "<img src=\"figs/ex5_2.png\" width=\"600\">"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "3. Kolejna aplikacja dodaje kolejne funkcjonalności. Popraw ją tak (zredukuj ilość zduplikowanego kodu), aby wykorzystać funkcje reaktywne."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "ui <- fluidPage(\n",
    "  sliderInput(\"x\", \"If x is\", min = 1, max = 50, value = 30),\n",
    "  sliderInput(\"y\", \"and y is\", min = 1, max = 50, value = 5),\n",
    "  \"then, (x * y) is\", textOutput(\"product\"),\n",
    "  \"and, (x * y) + 5 is\", textOutput(\"product_plus5\"),\n",
    "  \"and (x * y) + 10 is\", textOutput(\"product_plus10\")\n",
    ")\n",
    "\n",
    "server <- function(input, output, session) {\n",
    "  output$product <- renderText({ \n",
    "    product <- input$x * input$y\n",
    "    product\n",
    "  })\n",
    "  output$product_plus5 <- renderText({ \n",
    "    product <- input$x * input$y\n",
    "    product + 5\n",
    "  })\n",
    "  output$product_plus10 <- renderText({ \n",
    "    product <- input$x * input$y\n",
    "    product + 10\n",
    "  })\n",
    "}\n",
    "\n",
    "shinyApp(ui, server)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "4. Poniższa aplikacja pozwala wybrać zbiór danych z pakietu *ggplot2*, a następnie wyświetla podsumowanie danych i rysuje wykresy. Są w niej jednak trzy błędy. Wskaż je i popraw."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "datasets <- c(\"economics\", \"faithfuld\", \"seals\")\n",
    "\n",
    "ui <- fluidPage(\n",
    "  selectInput(\"dataset\", \"Dataset\", choices = datasets),\n",
    "  verbatimTextOutput(\"summary\"),\n",
    "  tableOutput(\"plot\")\n",
    ")\n",
    "\n",
    "server <- function(input, output, session) {\n",
    "  dataset <- reactive({\n",
    "    get(input$dataset, \"package:ggplot2\")\n",
    "  })\n",
    "  output$summmry <- renderPrint({\n",
    "    summary(dataset())\n",
    "  })\n",
    "  output$plot <- renderPlot({\n",
    "    plot(dataset)\n",
    "  }, res = 96)\n",
    "}\n",
    "\n",
    "shinyApp(ui, server)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "5. Zbuduj aplikację *shiny*, która pozwala wpisać swoje imię i nazwisko oraz wybrać powitanie (Hello/Bonjour) i zwraca „Hello, Tomasz”, gdy użytkownikiem jest Tomasz. Twoja ostateczna aplikacja powinna wizualnie przypominać zrzut ekranu poniżej.\n",
    "\n",
    "<img src=\"figs/ex5_5.png\" width=\"300\">"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "6. Dla zbioru danych *gapminder* z biblioteki *gapminder* zbuduj aplikację *shiny*, która wizualnie powinna przypominać zrzut ekranu poniżej. Powinna istnieć możliwość wyboru kontynentu i roku. Dla wybranych wartości należy przygotować wykres i tabelę na osobnych zakładkach.\n",
    "\n",
    "<img src=\"figs/ex5_6.png\" width=\"800\">"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "7. Narodowe Centrum Raportowania UFO (NUFORC) zbierało dane o zdarzeniach UFO w ciągu ostatniego stulecia (zbiór danych: usaUFOsightings.csv). Zbuduj aplikację, która pozwoli użytkownikom wybrać stan USA i okres, w którym miały miejsce zdarzenia. Wykres powinien pokazywać liczbę zdarzeń dla wybranego stanu i okresu. Tabela powinna pokazywać, dla wybranego stanu i okresu czasu, liczbę zaobserwowanych obserwacji oraz średnią, medianę, minimalny i maksymalny czas trwania (w sekundach) wydarzenia. Twoja ostateczna aplikacja powinna wizualnie przypominać zrzutu ekranu poniżej.\n",
    "\n",
    "<img src=\"figs/ex5_7.png\" width=\"800\">\n",
    "\n",
    "8. Zbuduj aplikację do wizualizacji Centralnego Twierdzenia Granicznego. Próbki powinny być losowane z rozkładu jednostajnego na odcinku $[0, 1]$. Użytkownik powinien móc zmienić liczbę próbek (od 1 do 100, domyślnie 2) oraz liczbę słupków w histogramie (od 5 do 50, domślnie 20). Liczba doświadczeń (liczenia średnich) powinna być ustalona na stałe (10 000). Ustaw szablon na *darkly*. Zabezpiecz aplikację przed wpisaniem ujemnych wartości dla liczby próbek i liczby słupków (biblioteka *shinyFeedback*). Dopasuj wylgąd aplikacji do zrzutu ekranu poniżej.\n",
    "\n",
    "<img src=\"figs/ex5_8.png\" width=\"800\">"
   ]
  }
 ],
 "metadata": {
  "kernelspec": {
   "display_name": "R",
   "language": "R",
   "name": "ir"
  },
  "language_info": {
   "codemirror_mode": "r",
   "file_extension": ".r",
   "mimetype": "text/x-r-source",
   "name": "R",
   "pygments_lexer": "r",
   "version": "4.1.1"
  },
  "metadata": {
   "author": "Tomasz Górecki",
   "email": "tomasz.gorecki@amu.edu.pl",
   "lang": "pl",
   "subtitle": "12-15. Biblioteka shiny [laboratoria]",
   "title": "Wizualizacja danych",
   "year": "2021"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 4
}