{ "cells": [ { "cell_type": "markdown", "metadata": {}, "source": [ "# Wizualizacja danych (Lab 5)" ] }, { "cell_type": "code", "execution_count": 1, "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.\n", "\n", "" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "" ] }, { "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": null, "metadata": {}, "outputs": [], "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": 3, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
A tibble: 6 × 5
yearsexnamenprop
<dbl><chr><chr><int><dbl>
1880FMary 70650.07238
1880FAnna 26040.02668
1880FEmma 20030.02052
1880FElizabeth19390.01987
1880FMinnie 17460.01789
1880FMargaret 15780.01617
\n" ], "text/latex": [ "A tibble: 6 × 5\n", "\\begin{tabular}{lllll}\n", " year & sex & name & n & prop\\\\\n", " & & & & \\\\\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 <dbl> | sex <chr> | name <chr> | n <int> | prop <dbl> |\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": null, "metadata": {}, "outputs": [], "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": null, "metadata": {}, "outputs": [], "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": null, "metadata": {}, "outputs": [], "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": [ "### Layputy 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": null, "metadata": {}, "outputs": [], "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": null, "metadata": {}, "outputs": [], "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": null, "metadata": {}, "outputs": [], "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": null, "metadata": {}, "outputs": [], "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": null, "metadata": {}, "outputs": [], "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": null, "metadata": {}, "outputs": [], "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": null, "metadata": {}, "outputs": [], "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": [], "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", "\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", "" ] }, { "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", "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", "" ] }, { "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", "" ] }, { "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ć zrzut ekranu poniżej.\n", "\n", "" ] } ], "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": "3.6.1" } }, "nbformat": 4, "nbformat_minor": 4 }