├── .gitignore ├── 00-welcome ├── 00-welcome.key ├── 00-welcome.pdf └── packages.R ├── 01-md-compose-prose ├── 01-md-compose-prose.key ├── 01-md-compose-prose.pdf ├── analyze-share-repro-soln.Rmd ├── analyze-share-repro.Rmd └── analyze-share-repro.html ├── 02-R-in-Markdown ├── 02-R-in-Markdown.key ├── 02-R-in-Markdown.pdf └── Chunk_basics.Rmd ├── 03-up-your-rmd-game ├── 03-up-your-rmd-game.key ├── 03-up-your-rmd-game.pdf ├── 03B-interactivity-on-the-cheap.key ├── 03B-interactivity-on-the-cheap.pdf ├── Dashboard-soln.Rmd ├── Dashboard.Rmd ├── Economist.Rmd ├── Storyboard.Rmd ├── bibliography.bib ├── images │ └── 20180120_FNC577_0.png └── kaplan-consulting.docx ├── 04-shiny-getting-started ├── 04-shiny-getting-started.key ├── 04-shiny-getting-started.pdf └── apps │ ├── goog-index │ ├── DESCRIPTION │ ├── README.md │ ├── app.R │ └── data │ │ ├── trend_data.csv │ │ └── trend_description.csv │ └── movies │ ├── movies.Rdata │ ├── movies_01.R │ ├── movies_02.R │ ├── movies_03.R │ ├── movies_04.R │ └── movies_05.R ├── 05-understand-reactivity ├── 05-understand-reactivity.key ├── 05-understand-reactivity.pdf └── apps │ └── movies │ ├── movies.Rdata │ ├── movies_05.R │ ├── movies_06.R │ ├── movies_07.R │ ├── movies_08.R │ ├── movies_09.R │ ├── movies_10.R │ └── movies_11.R ├── 06-design-ui ├── 06-design-ui.key ├── 06-design-ui.pdf └── apps │ ├── big_mac_index │ └── prototype.Rmd │ └── movies │ ├── movies.Rdata │ ├── movies_11-soln.R │ └── movies_11.R ├── 07-dashboards ├── 07-dashboards.key ├── 07-dashboards.pdf └── apps │ └── dashboard │ ├── flexdashboard_01.Rmd │ ├── flexdashboard_01.html │ ├── flexdashboard_02.Rmd │ └── movies.Rdata ├── 08-more-react ├── 08-more-react.key ├── 08-more-react.pdf ├── movies.Rdata ├── movies_11.R ├── movies_12.R ├── movies_13.R └── movies_14.R ├── 09-wrap-up ├── 09-wrap-up.key └── 09-wrap-up.pdf ├── README.md ├── cond └── app.R ├── data ├── AAPL.csv └── big-mac-index.csv └── shinymark.Rproj /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | .DS_Store 6 | -------------------------------------------------------------------------------- /00-welcome/00-welcome.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/00-welcome/00-welcome.key -------------------------------------------------------------------------------- /00-welcome/00-welcome.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/00-welcome/00-welcome.pdf -------------------------------------------------------------------------------- /00-welcome/packages.R: -------------------------------------------------------------------------------- 1 | # Install packages that will be used in the workshop 2 | from_cran <- c("shiny", "rmarkdown", 3 | "DT", "devtools", "flexdashboard", "gapminder", 4 | "rticles", "shinydashboard", "shinythemes", 5 | "tidyverse", "tufte", "xaringan") 6 | 7 | install.packages(from_cran, repos = "http://cran.rstudio.com") 8 | 9 | # Load packages 10 | 11 | library(shiny) 12 | library(rmarkdown) 13 | library(DT) 14 | library(devtools) 15 | library(flexdashboard) 16 | library(gapminder) 17 | library(rticles) 18 | library(shinydashboard) 19 | library(shinythemes) 20 | library(tidyverse) 21 | library(tufte) 22 | library(xaringan) 23 | -------------------------------------------------------------------------------- /01-md-compose-prose/01-md-compose-prose.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/01-md-compose-prose/01-md-compose-prose.key -------------------------------------------------------------------------------- /01-md-compose-prose/01-md-compose-prose.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/01-md-compose-prose/01-md-compose-prose.pdf -------------------------------------------------------------------------------- /01-md-compose-prose/analyze-share-repro-soln.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | html_document: 4 | theme: cosmo 5 | --- 6 | 7 | 8 | 9 | # Analyze. Share. Reproduce. 10 | 11 | ## and do it all 12 | 13 | ### with R Markdown 14 | 15 | Your data tells a ~~joke~~ story. Tell it with `R` Markdown. Turn your analyses into **high quality** documents, reports, presentations and dashboards -- and don't forget to drink some H~2~0 while you do that.[^1] 16 | 17 | R Markdown documents are fully reproducible. Use a productive [notebook interface](http://rmarkdown.rstudio.com/r_notebooks.html)[^2] to weave together narrative text and code to produce *elegantly formatted* output. Use multiple languages including 18 | 19 | - R 20 | - Python 21 | 22 | and 23 | 24 | - SQL 25 | 26 | Do you need still need convincing to use R Markdown? See what a friend once said: 27 | 28 | > I used to use Sweave, and get terrible headaches. Now I use R Markdown, 29 | > and life is much more pleasant. 30 | 31 | [^1]: Or coffee, whatever floats your boat. 32 | [^2]: This link should point to http://rmarkdown.rstudio.com/r_notebooks.html. 33 | -------------------------------------------------------------------------------- /01-md-compose-prose/analyze-share-repro.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: html_document 3 | --- 4 | 5 | Analyze. Share. Reproduce. and do it all with R Markdown. Your data tells a story. Tell it with R Markdown. Turn your analyses into high[^fred] quality[^2] documents, reports, presentations and dashboards - and don't forget to drink some H20 while you do that. R Markdown documents are fully reproducible. Use a productive notebook interface to weave together narrative text and code to produce elegantly formatted output. Use multiple languages including R, Python, and SQL. Do you need still need convincing to use R Markdown? See what a friend once said: I used to use Sweave, and get terrible headaches. Now I use R Markdown, and life is much more pleasant. Or coffee, whatever floats your boat. This link should point to http://rmarkdown.rstudio.com/r_notebooks.html. 6 | 7 | [^fred]: my footnote 8 | [^2]: another footnote 9 | -------------------------------------------------------------------------------- /02-R-in-Markdown/02-R-in-Markdown.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/02-R-in-Markdown/02-R-in-Markdown.key -------------------------------------------------------------------------------- /02-R-in-Markdown/02-R-in-Markdown.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/02-R-in-Markdown/02-R-in-Markdown.pdf -------------------------------------------------------------------------------- /02-R-in-Markdown/Chunk_basics.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "R in Markdown" 3 | author: "Danny Kaplan" 4 | date: "January 15, 2019" 5 | output: 6 | html_document: 7 | highlight: pygments 8 | theme: cosmo 9 | --- 10 | 11 | ```{r load-packages} 12 | library(tidyverse) 13 | library(shiny) 14 | ``` 15 | 16 | ## Preliminary tasks 17 | 18 | 1. It's a good practice to load the major packages for a document in a "setup" or "load packages" chunk. But the output from that chunk is a poor way for a reader to start off with a document. 19 | * Add a chunk option to `load-packages` to suppress the output. (Hint: the option begins with `i`.) 20 | 2. Add an inline R chunk to your document so that the current date/time show up here: XXXX. Try to put the date in italics. 21 | 22 | ### Add a plot chunk 23 | 24 | 3. Make chunk producing a simple plot using the `mtcars` data frame built into R. 25 | 4. Add a label to the chunk in (3) and to each unlabelled chunk. 26 | 5. Change the chunk options (echo, eval, include, message, warning) to explore what changes in the output. Then, decide on an appropriate option for each of the chunks. Compare your choices to your neighbors’. 27 | 6. Turn the following into a proper chunk for R evaluation rather than just display of code. 28 | 29 | ``` 30 | names(mtcars) 31 | mtcars %>% 32 | summarize_all(median) 33 | ``` 34 | 35 | 7. Returning to the chunk you made in (6), what does the option collapse (set to TRUE or FALSE) do? What is the default setting for this option? 36 | 37 | ## Inline code 38 | 39 | Typical uses of inline code ... 40 | 41 | 1. Avoiding hard-coding of numbers. (They become out of date.) 42 | - Bad: Our analysis involved 51 cars. 43 | - Better: Our analysis involved `r nrow(mtcars)` cars. 44 | 45 | 46 | ```{r car_t_test, echo = FALSE} 47 | mod <- lm(mpg ~ disp + cyl, data = mtcars) 48 | ``` 49 | 50 | 2. Reporting of results calculated elsewhere. 51 | - Bad: Keeping displacement constant, an additional cylinder is associated with a loss of about 1.6 miles-per-gallon. 52 | - Better: ...with a `r ifelse(coef(mod)["cyl"] > 0, "gain", "loss")` of about `r round(abs(coef(mod)["cyl"]), 1)` miles-per-gallon. 53 | 54 | **Stretch goal**: Update the date field in the YAML so that the date at the time of knitting the document is printed. (Hint: You can put YAML strings in quotation marks.) 55 | 56 | 57 | ## Add a table chunk 58 | 59 | 5. Display the first 5 rows of the `mtcars` data frame. 60 | 61 | 62 | ```{r} 63 | "Your command goes here." 64 | ``` 65 | 66 | 67 | **Stretch goal**: Modify the chunk with the table to prettify the display. There are many possibilities but try `knitr::kable()`. 68 | 69 | 70 | 71 | ## When your code goes wrong 72 | 73 | A chunk with an error ... 74 | 75 | ```{r eval = FALSE} 76 | log(-10) 77 | ``` 78 | 79 | ... and another such chunk. 80 | 81 | ```{r eval = FALSE} 82 | sqrt(-5) 83 | ``` 84 | -------------------------------------------------------------------------------- /03-up-your-rmd-game/03-up-your-rmd-game.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/03-up-your-rmd-game/03-up-your-rmd-game.key -------------------------------------------------------------------------------- /03-up-your-rmd-game/03-up-your-rmd-game.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/03-up-your-rmd-game/03-up-your-rmd-game.pdf -------------------------------------------------------------------------------- /03-up-your-rmd-game/03B-interactivity-on-the-cheap.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/03-up-your-rmd-game/03B-interactivity-on-the-cheap.key -------------------------------------------------------------------------------- /03-up-your-rmd-game/03B-interactivity-on-the-cheap.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/03-up-your-rmd-game/03B-interactivity-on-the-cheap.pdf -------------------------------------------------------------------------------- /03-up-your-rmd-game/Dashboard-soln.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "A Dashboard" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: columns 6 | vertical_layout: scroll 7 | --- 8 | 9 | ```{r setup, include=FALSE} 10 | library(flexdashboard) 11 | library(tidyverse) 12 | library(xts) 13 | ``` 14 | 15 | Narrative {.sidebar} 16 | --------------------------------- 17 | 18 | ### What's this about? 19 | 20 | Add in a video playing 21 | 22 | Hints: 23 | 24 | * No R code needed! 25 | * In your browser, navigate to the video 26 | * Under "Share" select "embed" 27 | * Copy the HTML iframe code 28 | 29 | 30 | 31 | ### For dashboard 32 | 33 | Move this to YAML, replacing `html_document` 34 | 35 | ``` 36 | flexdashboard::flex_dashboard: 37 | orientation: columns 38 | vertical_layout: fill 39 | ``` 40 | 41 | 42 | Column {.tabset} 43 | ----------------------------------------------------------------------- 44 | 45 | ### Map 46 | 47 | Put a map of Austin, TX here. 48 | 49 | Hint: 50 | 51 | * Use `leaflet` package to generate the widget 52 | * Latitude/Longitude of Austin: 30.27° N, 97.75° W 53 | * Functions to use: `leaflet::leaflet()`, `setView()`, `addTiles()` 54 | * alternative to `setView()`: use `addMarkers()` and let the server figure out the initial scale. 55 | 56 | ```{r drawAustin} 57 | library(leaflet) 58 | map <- leaflet() %>% 59 | setView(-97.75, 30.27, zoom = 16) %>% 60 | addTiles() 61 | map 62 | ``` 63 | 64 | ### Big Mac Index 65 | 66 | Hints: 67 | 68 | * Use `plotly` library. 69 | * Create a ggplot2 graphic like the one below. 70 | * call `ggplotly()` with the graphic as an argument 71 | 72 | ```{r echo = FALSE} 73 | Big_mac <- read_csv("../data/big-mac-index.csv") 74 | countries <- c("Sweden", "Norway", "Russia", "United States", "Korea", "Japan", "Malaysia", "India", "China", "Pakistan", "Taiwan", "Britain", "Ecuador", "Argentina") 75 | Just_my_countries <- 76 | Big_mac %>% 77 | filter(name %in% countries) %>% 78 | mutate(year = lubridate::year(date), month = lubridate::month(date)) %>% 79 | filter(year == 2017) %>% 80 | select(name, month, dollar_price) %>% 81 | tidyr::spread(key = month, value = dollar_price) %>% 82 | mutate(name = reorder(name, `7`, I) ) 83 | My_graphic <- 84 | ggplot(data = Just_my_countries, aes(y = name)) + 85 | geom_segment(aes(x = `1`, xend = `7`, y = name, yend = name)) + 86 | geom_point(aes(x = `1`), color = "red", size = 5) + 87 | geom_point(aes(x = `7`), color = "blue", size = 5) + 88 | labs(x = "Price in USD") 89 | My_graphic 90 | ``` 91 | 92 | ### Time Series 93 | 94 | ```{r time_series} 95 | library(dygraphs) 96 | Apple <- read_csv("../data/AAPL.csv") 97 | Apple <- Apple %>% as.xts(order.by = Apple$Date) 98 | dygraph(Apple[ , c("Low", "High", "Close")], "Apple stock price") %>% 99 | dySeries() %>% 100 | dyRangeSelector(height = 20) 101 | ``` 102 | -------------------------------------------------------------------------------- /03-up-your-rmd-game/Dashboard.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Not Yet a Dashboard" 3 | output: 4 | html_document: 5 | theme: journal 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | # library(flexdashboard) 10 | library(tidyverse) 11 | library(xts) 12 | ``` 13 | 14 | 15 | ### What's this about? 16 | 17 | Add in a video playing 18 | 19 | Hints: 20 | 21 | * No R code needed! 22 | * In your browser, navigate to the video 23 | * Under "Share" select "embed" 24 | * Copy the HTML iframe code 25 | 26 | ### For dashboard 27 | 28 | IGNORE this section until we come to the "As a Dashboard" activity 29 | 30 | 1. Uncomment `library(flexdashboard)` above. 31 | 2. Move this to the YAML section, replacing `html_document` 32 | 33 | ``` 34 | flexdashboard::flex_dashboard: 35 | orientation: columns 36 | vertical_layout: scroll 37 | ``` 38 | 39 | ### Map 40 | 41 | Put a map of Austin, TX here. 42 | 43 | Hint: 44 | 45 | * Use `leaflet` package to generate the widget 46 | * Latitude/Longitude of Austin: 30.27° N, 97.75° W 47 | * Functions to use: `leaflet::leaflet()`, `setView()`, `addTiles()` 48 | * alternative to `setView()`: use `addMarkers()` and let the server figure out the initial scale. 49 | 50 | ```{r drawAustin} 51 | library(leaflet) 52 | # Your commands go here 53 | ``` 54 | 55 | ### Big Mac Index 56 | 57 | Hints: 58 | 59 | * Use `plotly` library. 60 | * Create a ggplot2 graphic like the one below. 61 | * call `ggplotly()` with the graphic as an argument 62 | 63 | ```{r echo = FALSE} 64 | Big_mac <- read_csv("../data/big-mac-index.csv") 65 | countries <- c("Sweden", "Norway", "Russia", "United States", "Korea", "Japan", "Malaysia", "India", "China", "Pakistan", "Taiwan", "Britain", "Ecuador", "Argentina") 66 | Just_my_countries <- 67 | Big_mac %>% 68 | filter(name %in% countries) %>% 69 | mutate(year = lubridate::year(date), month = lubridate::month(date)) %>% 70 | filter(year == 2017) %>% 71 | select(name, month, dollar_price) %>% 72 | tidyr::spread(key = month, value = dollar_price) %>% 73 | mutate(name = reorder(name, `7`, I) ) 74 | My_graphic <- 75 | ggplot(data = Just_my_countries, aes(y = name)) + 76 | geom_segment(aes(x = `1`, xend = `7`, y = name, yend = name)) + 77 | geom_point(aes(x = `1`), color = "red", size = 5) + 78 | geom_point(aes(x = `7`), color = "blue", size = 5) + 79 | labs(x = "Price in USD") 80 | # Add a line here to display My_graphic 81 | ``` 82 | 83 | ### Time Series 84 | 85 | ```{r time_series} 86 | # A demo 87 | library(dygraphs) 88 | Apple <- read_csv("../data/AAPL.csv") 89 | Apple <- Apple %>% as.xts(order.by = Apple$Date) 90 | dygraph(Apple[ , c("Low", "High", "Close")], "Apple stock price") %>% 91 | dySeries() %>% 92 | dyRangeSelector(height = 20) 93 | ``` 94 | -------------------------------------------------------------------------------- /03-up-your-rmd-game/Economist.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "The Big Mac exchange-rate index" 3 | author: "Danny Kaplan" 4 | date: "`r Sys.Date()`" 5 | output: 6 | html_document: 7 | fig_caption: yes 8 | highlight: pygments 9 | theme: cosmo 10 | word_document: 11 | fig_caption: yes 12 | reference_docx: kaplan-consulting.docx 13 | bibliography: bibliography.bib 14 | params: 15 | year: 2018 16 | countries: [Canada, Denmark, Hungary, Japan, Russia] 17 | --- 18 | 19 | ```{r load-packages, message=FALSE} 20 | library(tidyverse) 21 | ``` 22 | 23 | ## Background 24 | 25 | The *[Economist](https://www.economist.com/)* has a quick visualization of currency exchange rates based on "purchasing power parity." The visualization is based on just one item: the [Big Mac](https://www.mcdonalds.com/us/en-us/product/big-mac.html) sandwich at McDonalds. The index is therefore called the Big Mac index, and is described [here](https://www.economist.com/news/2018/07/11/the-big-mac-index). Figure 1 shows an example of how *The Economist* presents the data, from WE WILL PUT A REFERENCE HERE. 26 | 27 | ```{r economist-graphic, echo = FALSE, fig.cap = "Figure 1: *The Economist*'s presentation of the Big Mac Index" } 28 | knitr::include_graphics("images/20180120_FNC577_0.png") 29 | ``` 30 | 31 | 32 | 33 | Data behind the Big Mac Index is published [here on GitHub](https://github.com/TheEconomist/big-mac-data). For convenience, it's available in `data/big-mac-index.csv`. 34 | 35 | ```{r load-data, message=FALSE, warning=FALSE} 36 | Big_mac <- read_csv("../data/big-mac-index.csv") 37 | ``` 38 | 39 | Year is `r params$year` and the countries are `r paste(params$countries, collapse = ", ")` 40 | 41 | 42 | ## Showing the data 43 | 44 | Let's look at year 2018 and just the basic variables 45 | 46 | ```{r select-year} 47 | Mac_2018 <- Big_mac %>% 48 | filter(lubridate::year(date) == params$year) %>% 49 | select(date, name, local_price, dollar_ex, dollar_price) 50 | ``` 51 | 52 | Below is some standard table output: 53 | 54 | ```{r standard-table} 55 | Mac_2018 %>% 56 | arrange(desc(dollar_price)) 57 | ``` 58 | 59 | And the same output with `kable`: 60 | 61 | ```{r kable} 62 | Mac_2018 %>% 63 | arrange(desc(dollar_price)) %>% 64 | knitr::kable() 65 | ``` 66 | 67 | Another useful package is `DT`, especially for displaying tables of with large number of rows: 68 | 69 | ```{r datatable} 70 | Mac_2018 %>% 71 | DT::datatable(editable = TRUE) 72 | ``` 73 | 74 | -------------------------------------------------------------------------------- /03-up-your-rmd-game/Storyboard.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Shiny the Friendly Unicorn" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | storyboard: true 6 | runtime: shiny 7 | --- 8 | 9 | ```{r setup, include=FALSE} 10 | library(flexdashboard) 11 | library(tidyverse) 12 | library(plotly) 13 | library(shiny) 14 | ``` 15 | 16 | ### Once upon a time ... 17 | 18 | ```{r} 19 | ``` 20 | 21 | Once upon a time, in a land far, far away. There lived a dragon. 22 | 23 | ![A fire-breathing dragon](https://vignette.wikia.nocookie.net/emporea/images/d/d9/Black_dragon_preloader.jpg/revision/latest/scale-to-width-down/430?cb=20160216171424) 24 | 25 | *** 26 | 27 | #### Comments 28 | 29 | * Dragons are not real animals. 30 | - There are electric eels, but I don't know about any fire-breathing animals. 31 | * We need to be more specific about the year. Once-upon-a-time is too vague. 32 | - Suggestion 1: 1280 AD 33 | - Suggestion 2: Roman Era. But did they have dragons? 34 | - But not a lava-filled pre-historic time. 35 | 36 | ### The Princess 37 | 38 | The princess loved unicorns, but not princes. 39 | 40 | ![A unicorn](https://i.pinimg.com/originals/00/20/8a/00208aa103b9f215e87ad0ba4e221746.png) 41 | 42 | *** 43 | 44 | #### Marketing rationale 45 | 46 | Loving unicorns is actually pretty common. I've known little girls who loved unicorns. This should be excellent market placement for our story. 47 | 48 | #### Comments/Questions 49 | 50 | * Are we being too heteronormative to make this about princesses and princes. 51 | * Will the sex police read too much into the unicorn? Maybe a pony would be better. 52 | * The water-color ~~dragon~~ unicorn with a rainbow really removes this from any historical context. 53 | - We need a unicorn in a genuine historical setting. 54 | * Get a landscape unicorn picture. This one hides the narrative. 55 | 56 | ----- 57 | 58 | Note that the caption is being displayed at the bottom. Do we want this? 59 | 60 | ### ... and she loved to eat ... 61 | 62 | ![](https://cdn.instructables.com/FYJ/GFKS/J7RS7L2O/FYJGFKSJ7RS7L2O.LARGE.jpg?auto=webp&width=827) 63 | 64 | *** 65 | 66 | Big Macs. But in order to be able to feed the ~~dragon~~ unicorn, they need to be cheap. So where to set this drama? 67 | 68 | ```{r, out.width = "90%"} 69 | Big_mac <- read_csv("../data/big-mac-index.csv") 70 | countries <- c("Sweden", "Norway", "Russia", "United States", "Korea", "Japan", "Malaysia", "India", "China", "Pakistan", "Taiwan", "Britain", "Ecuador", "Argentina") 71 | Just_my_countries <- 72 | Big_mac %>% 73 | filter(name %in% countries) %>% 74 | mutate(year = lubridate::year(date), month = lubridate::month(date)) %>% 75 | filter(year == 2017) %>% 76 | select(name, month, dollar_price) %>% 77 | tidyr::spread(key = month, value = dollar_price) %>% 78 | mutate(name = reorder(name, `7`, I) ) 79 | My_graphic <- 80 | ggplot(data = Just_my_countries, aes(y = name)) + 81 | geom_segment(aes(x = `1`, xend = `7`, y = name, yend = name)) + 82 | geom_point(aes(x = `1`), color = "red", size = 5) + 83 | geom_point(aes(x = `7`), color = "blue", size = 5) + 84 | labs(x = "Price in USD") 85 | My_graphic 86 | ``` 87 | 88 | #### Comments 89 | 90 | * This will encourage the readers to become data scientists. 91 | * Make sure cross-marketing deal is in place with McD.....lds 92 | 93 | ### To control the unicorn, the princess used Shiny. 94 | 95 | ```{r} 96 | radioButtons("food", "Feed the unicorn", c("hay", "corn", "kibble", "Big Mac")) 97 | sliderInput("amount_of_food", "How much? (handfuls)", min = 0, max = 20, value = 10) 98 | ``` 99 | 100 | *** 101 | 102 | Continue the story by adding your own shiny controls! 103 | 104 | See the [Shiny Cheatsheet](https://shiny.rstudio.com/images/shiny-cheatsheet.pdf) for more controls. 105 | -------------------------------------------------------------------------------- /03-up-your-rmd-game/bibliography.bib: -------------------------------------------------------------------------------- 1 | @article{BigMac2018, 2 | title = {Our Big Mac index shows fundamentals now matter more in currency markets}, 3 | journal = {The Economist}, 4 | year = {2018}, 5 | volume = {January 20}, 6 | url = {https://www.economist.com/finance-and-economics/2018/01/20/our-big-mac-index-shows-fundamentals-now-matter-more-in-currency-markets} 7 | } 8 | 9 | @article{Kaggle18, 10 | title={Burritos in San Diego}, 11 | author={Cole, Scott}, 12 | year={2018}, 13 | URL={https://www.kaggle.com/srcole/burritos-in-san-diego'} 14 | } -------------------------------------------------------------------------------- /03-up-your-rmd-game/images/20180120_FNC577_0.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/03-up-your-rmd-game/images/20180120_FNC577_0.png -------------------------------------------------------------------------------- /03-up-your-rmd-game/kaplan-consulting.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/03-up-your-rmd-game/kaplan-consulting.docx -------------------------------------------------------------------------------- /04-shiny-getting-started/04-shiny-getting-started.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/04-shiny-getting-started/04-shiny-getting-started.key -------------------------------------------------------------------------------- /04-shiny-getting-started/04-shiny-getting-started.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/04-shiny-getting-started/04-shiny-getting-started.pdf -------------------------------------------------------------------------------- /04-shiny-getting-started/apps/goog-index/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Type: Shiny 2 | Title: Google Trend Index 3 | License: MIT 4 | Author: Mine Cetinkaya-Rundel 5 | AuthorUrl: http://www.rstudio.com/ 6 | Tags: getting-started 7 | -------------------------------------------------------------------------------- /04-shiny-getting-started/apps/goog-index/README.md: -------------------------------------------------------------------------------- 1 | A simple Shiny app that displays data for the Google Trend Index app. Featured on the front page of the [Shiny Dev Center](http://shiny.rstudio.com). 2 | -------------------------------------------------------------------------------- /04-shiny-getting-started/apps/goog-index/app.R: -------------------------------------------------------------------------------- 1 | # Load packages ----------------------------------------------------- 2 | library(shiny) 3 | library(shinythemes) 4 | library(dplyr) 5 | library(readr) 6 | 7 | # Load data --------------------------------------------------------- 8 | trend_data <- read_csv("data/trend_data.csv") 9 | trend_description <- read_csv("data/trend_description.csv") 10 | 11 | # Define UI --------------------------------------------------------- 12 | ui <- fluidPage(theme = shinytheme("lumen"), 13 | titlePanel("Google Trend Index"), 14 | sidebarLayout( 15 | sidebarPanel( 16 | 17 | # Select type of trend to plot 18 | selectInput(inputId = "type", label = strong("Trend index"), 19 | choices = unique(trend_data$type), 20 | selected = "Travel"), 21 | 22 | # Select date range to be plotted 23 | dateRangeInput("date", strong("Date range"), 24 | start = "2007-01-01", end = "2017-07-31", 25 | min = "2007-01-01", max = "2017-07-31"), 26 | 27 | # Select whether to overlay smooth trend line 28 | checkboxInput(inputId = "smoother", 29 | label = strong("Overlay smooth trend line"), 30 | value = FALSE), 31 | 32 | # Display only if the smoother is checked 33 | conditionalPanel(condition = "input.smoother == true", 34 | sliderInput(inputId = "f", label = "Smoother span:", 35 | min = 0.01, max = 1, value = 0.67, step = 0.01, 36 | animate = animationOptions(interval = 100)), 37 | HTML("Higher values give more smoothness.") 38 | ) 39 | ), 40 | 41 | # Output: Description, lineplot, and reference 42 | mainPanel( 43 | plotOutput(outputId = "lineplot", height = "300px"), 44 | textOutput(outputId = "desc"), 45 | tags$a(href = "https://www.google.com/finance/domestic_trends", "Source: Google Domestic Trends", target = "_blank") 46 | ) 47 | ) 48 | ) 49 | 50 | # Define server function -------------------------------------------- 51 | server <- function(input, output) { 52 | 53 | # Subset data 54 | selected_trends <- reactive({ 55 | req(input$date) 56 | validate(need(!is.na(input$date[1]) & !is.na(input$date[2]), "Error: Please provide both a start and an end date.")) 57 | validate(need(input$date[1] < input$date[2], "Error: Start date should be earlier than end date.")) 58 | trend_data %>% 59 | filter( 60 | type == input$type, 61 | date > as.POSIXct(input$date[1]) & date < as.POSIXct(input$date[2] 62 | )) 63 | }) 64 | 65 | 66 | # Create scatterplot object the plotOutput function is expecting 67 | output$lineplot <- renderPlot({ 68 | color = "#434343" 69 | par(mar = c(4, 4, 1, 1)) 70 | plot(x = selected_trends()$date, y = selected_trends()$close, type = "l", 71 | xlab = "Date", ylab = "Trend index", col = color, fg = color, col.lab = color, col.axis = color) 72 | # Display only if smoother is checked 73 | if(input$smoother){ 74 | smooth_curve <- lowess(x = as.numeric(selected_trends()$date), y = selected_trends()$close, f = input$f) 75 | lines(smooth_curve, col = "#E6553A", lwd = 3) 76 | } 77 | }) 78 | 79 | # Pull in description of trend 80 | output$desc <- renderText({ 81 | trend_text <- filter(trend_description, type == input$type) %>% pull(text) 82 | paste(trend_text, "The index is set to 1.0 on January 1, 2004 and is calculated only for US search traffic.") 83 | }) 84 | } 85 | 86 | # Create the Shiny app object --------------------------------------- 87 | shinyApp(ui = ui, server = server) 88 | -------------------------------------------------------------------------------- /04-shiny-getting-started/apps/goog-index/data/trend_description.csv: -------------------------------------------------------------------------------- 1 | type,text 2 | Advertising & marketing,"The Google Advertising & Marketing Index tracks queries related to marketing, advertising, ads, adsense, constant contact, public relations, etc." 3 | Education,"The Google Education Index tracks queries related to college, education, test, academy, barnes and noble, harvard, etc." 4 | Small business,"The Google Small Business Index tracks queries related to small business, make money, franchise, work from home, chamber or commerce, etc." 5 | Travel,"The Google Travel Index tracks queries related to airlines, hotels, beach, southwest, las vegas, flights, etc." 6 | Unemployment,"The Google Unemployment Index tracks queries related to unemployment, food stamps, social security, edd, disability, etc." 7 | -------------------------------------------------------------------------------- /04-shiny-getting-started/apps/movies/movies.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/04-shiny-getting-started/apps/movies/movies.Rdata -------------------------------------------------------------------------------- /04-shiny-getting-started/apps/movies/movies_01.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(tidyverse) 3 | load("movies.Rdata") 4 | 5 | # Define UI for application that plots features of movies ----------- 6 | ui <- fluidPage( 7 | 8 | # Sidebar layout with a input and output definitions -------------- 9 | sidebarLayout( 10 | 11 | # Inputs: Select variables to plot ------------------------------ 12 | sidebarPanel( 13 | 14 | # Select variable for y-axis ---------------------------------- 15 | selectInput(inputId = "y", 16 | label = "Y-axis:", 17 | choices = c("imdb_rating", "imdb_num_votes", "critics_score", "audience_score", "runtime"), 18 | selected = "audience_score"), 19 | 20 | # Select variable for x-axis ---------------------------------- 21 | selectInput(inputId = "x", 22 | label = "X-axis:", 23 | choices = c("imdb_rating", "imdb_num_votes", "critics_score", "audience_score", "runtime"), 24 | selected = "critics_score") 25 | ), 26 | 27 | # Output: Show scatterplot -------------------------------------- 28 | mainPanel( 29 | plotOutput(outputId = "scatterplot") 30 | ) 31 | ) 32 | ) 33 | 34 | # Define server function required to create the scatterplot --------- 35 | server <- function(input, output) { 36 | 37 | # Create scatterplot object the plotOutput function is expecting -- 38 | output$scatterplot <- renderPlot({ 39 | ggplot(data = movies, aes_string(x = input$x, y = input$y)) + 40 | geom_point() 41 | }) 42 | } 43 | 44 | # Create the Shiny app object --------------------------------------- 45 | shinyApp(ui = ui, server = server) 46 | -------------------------------------------------------------------------------- /04-shiny-getting-started/apps/movies/movies_02.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(tidyverse) 3 | load("movies.Rdata") 4 | 5 | # Define UI for application that plots features of movies ----------- 6 | ui <- fluidPage( 7 | 8 | # Sidebar layout with a input and output definitions -------------- 9 | sidebarLayout( 10 | 11 | # Inputs: Select variables to plot ------------------------------ 12 | sidebarPanel( 13 | 14 | # Select variable for y-axis ---------------------------------- 15 | selectInput(inputId = "y", 16 | label = "Y-axis:", 17 | choices = c("imdb_rating", "imdb_num_votes", "critics_score", "audience_score", "runtime"), 18 | selected = "audience_score"), 19 | 20 | # Select variable for x-axis ---------------------------------- 21 | selectInput(inputId = "x", 22 | label = "X-axis:", 23 | choices = c("imdb_rating", "imdb_num_votes", "critics_score", "audience_score", "runtime"), 24 | selected = "critics_score"), 25 | 26 | # Select variable for color ----------------------------------- 27 | selectInput(inputId = "z", 28 | label = "Color by:", 29 | choices = c("title_type", "genre", "mpaa_rating", "critics_rating", "audience_rating"), 30 | selected = "mpaa_rating") 31 | ), 32 | 33 | # Output: Show scatterplot -------------------------------------- 34 | mainPanel( 35 | plotOutput(outputId = "scatterplot") 36 | ) 37 | ) 38 | ) 39 | 40 | # Define server function required to create the scatterplot --------- 41 | server <- function(input, output) { 42 | 43 | # Create scatterplot object the plotOutput function is expecting -- 44 | output$scatterplot <- renderPlot({ 45 | ggplot(data = movies, aes_string(x = input$x, y = input$y, 46 | color = input$z)) + 47 | geom_point() 48 | }) 49 | } 50 | 51 | # Create the Shiny app object --------------------------------------- 52 | shinyApp(ui = ui, server = server) 53 | -------------------------------------------------------------------------------- /04-shiny-getting-started/apps/movies/movies_03.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(tidyverse) 3 | load("movies.Rdata") 4 | 5 | # Define UI for application that plots features of movies ----------- 6 | ui <- fluidPage( 7 | 8 | # Sidebar layout with a input and output definitions -------------- 9 | sidebarLayout( 10 | 11 | # Inputs: Select variables to plot ------------------------------ 12 | sidebarPanel( 13 | 14 | # Select variable for y-axis ---------------------------------- 15 | selectInput(inputId = "y", 16 | label = "Y-axis:", 17 | choices = c("imdb_rating", "imdb_num_votes", "critics_score", "audience_score", "runtime"), 18 | selected = "audience_score"), 19 | 20 | # Select variable for x-axis ---------------------------------- 21 | selectInput(inputId = "x", 22 | label = "X-axis:", 23 | choices = c("imdb_rating", "imdb_num_votes", "critics_score", "audience_score", "runtime"), 24 | selected = "critics_score"), 25 | 26 | # Select variable for color ----------------------------------- 27 | selectInput(inputId = "z", 28 | label = "Color by:", 29 | choices = c("title_type", "genre", "mpaa_rating", "critics_rating", "audience_rating"), 30 | selected = "mpaa_rating"), 31 | 32 | # Set alpha level --------------------------------------------- 33 | sliderInput(inputId = "alpha", 34 | label = "Alpha:", 35 | min = 0, max = 1, 36 | value = 0.5) 37 | ), 38 | 39 | # Output: Show scatterplot -------------------------------------- 40 | mainPanel( 41 | plotOutput(outputId = "scatterplot") 42 | ) 43 | ) 44 | ) 45 | 46 | # Define server function required to create the scatterplot --------- 47 | server <- function(input, output) { 48 | 49 | # Create scatterplot object the plotOutput function is expecting -- 50 | output$scatterplot <- renderPlot({ 51 | ggplot(data = movies, aes_string(x = input$x, y = input$y, 52 | color = input$z)) + 53 | geom_point(alpha = input$alpha) 54 | }) 55 | } 56 | 57 | # Create the Shiny app object --------------------------------------- 58 | shinyApp(ui = ui, server = server) 59 | -------------------------------------------------------------------------------- /04-shiny-getting-started/apps/movies/movies_04.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(tidyverse) 3 | load("movies.Rdata") 4 | 5 | # Define UI for application that plots features of movies ----------- 6 | ui <- fluidPage( 7 | 8 | # Sidebar layout with a input and output definitions -------------- 9 | sidebarLayout( 10 | 11 | # Inputs: Select variables to plot ------------------------------ 12 | sidebarPanel( 13 | 14 | # Select variable for y-axis ---------------------------------- 15 | selectInput(inputId = "y", 16 | label = "Y-axis:", 17 | choices = c("imdb_rating", "imdb_num_votes", "critics_score", "audience_score", "runtime"), 18 | selected = "audience_score"), 19 | 20 | # Select variable for x-axis ---------------------------------- 21 | selectInput(inputId = "x", 22 | label = "X-axis:", 23 | choices = c("imdb_rating", "imdb_num_votes", "critics_score", "audience_score", "runtime"), 24 | selected = "critics_score"), 25 | 26 | # Select variable for color ----------------------------------- 27 | selectInput(inputId = "z", 28 | label = "Color by:", 29 | choices = c("title_type", "genre", "mpaa_rating", "critics_rating", "audience_rating"), 30 | selected = "mpaa_rating"), 31 | 32 | # Set alpha level --------------------------------------------- 33 | sliderInput(inputId = "alpha", 34 | label = "Alpha:", 35 | min = 0, max = 1, 36 | value = 0.5), 37 | 38 | # Add checkbox 39 | checkboxInput(inputId = "showdata", 40 | label = "Show data table", 41 | value = TRUE) 42 | ), 43 | 44 | # Output: -------------------------------------------------------- 45 | mainPanel( 46 | plotOutput(outputId = "scatterplot"), 47 | DT::dataTableOutput(outputId = "moviestable") 48 | ) 49 | ) 50 | ) 51 | 52 | # Define server function required to create the scatterplot --------- 53 | server <- function(input, output) { 54 | 55 | # Create scatterplot object the plotOutput function is expecting -- 56 | output$scatterplot <- renderPlot({ 57 | ggplot(data = movies, aes_string(x = input$x, y = input$y, 58 | color = input$z)) + 59 | geom_point(alpha = input$alpha) 60 | }) 61 | 62 | # Print data table if checked ------------------------------------- 63 | output$moviestable <- DT::renderDataTable({ 64 | DT::datatable(data = movies[, 1:7], 65 | options = list(pageLength = 10, rownames = FALSE) 66 | ) 67 | }) 68 | 69 | } 70 | 71 | # Run the application ----------------------------------------------- 72 | shinyApp(ui = ui, server = server) 73 | 74 | -------------------------------------------------------------------------------- /04-shiny-getting-started/apps/movies/movies_05.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(tidyverse) 3 | library(DT) 4 | library(stringr) 5 | library(tools) 6 | load("movies.Rdata") 7 | 8 | # Define UI for application that plots features of movies ----------- 9 | ui <- fluidPage( 10 | 11 | # Application title ----------------------------------------------- 12 | titlePanel("Movie browser"), 13 | 14 | # Sidebar layout with a input and output definitions -------------- 15 | sidebarLayout( 16 | 17 | # Inputs: Select variables to plot ------------------------------ 18 | sidebarPanel( 19 | 20 | # Select variable for y-axis ---------------------------------- 21 | selectInput(inputId = "y", 22 | label = "Y-axis:", 23 | choices = c("IMDB rating" = "imdb_rating", 24 | "IMDB number of votes" = "imdb_num_votes", 25 | "Critics Score" = "critics_score", 26 | "Audience Score" = "audience_score", 27 | "Runtime" = "runtime"), 28 | selected = "audience_score"), 29 | 30 | # Select variable for x-axis ---------------------------------- 31 | selectInput(inputId = "x", 32 | label = "X-axis:", 33 | choices = c("IMDB rating" = "imdb_rating", 34 | "IMDB number of votes" = "imdb_num_votes", 35 | "Critics Score" = "critics_score", 36 | "Audience Score" = "audience_score", 37 | "Runtime" = "runtime"), 38 | selected = "critics_score"), 39 | 40 | # Select variable for color ----------------------------------- 41 | selectInput(inputId = "z", 42 | label = "Color by:", 43 | choices = c("Title Type" = "title_type", 44 | "Genre" = "genre", 45 | "MPAA Rating" = "mpaa_rating", 46 | "Critics Rating" = "critics_rating", 47 | "Audience Rating" = "audience_rating"), 48 | selected = "mpaa_rating"), 49 | 50 | # Set alpha level --------------------------------------------- 51 | sliderInput(inputId = "alpha", 52 | label = "Alpha:", 53 | min = 0, max = 1, 54 | value = 0.5) 55 | 56 | ), 57 | 58 | # Output -------------------------------------------------------- 59 | mainPanel( 60 | 61 | # Show scatterplot -------------------------------------------- 62 | plotOutput(outputId = "scatterplot"), 63 | 64 | # Show data table --------------------------------------------- 65 | DT::dataTableOutput(outputId = "moviestable") 66 | ) 67 | ) 68 | ) 69 | 70 | # Define server function required to create the scatterplot --------- 71 | server <- function(input, output) { 72 | 73 | # Create scatterplot object the plotOutput function is expecting -- 74 | output$scatterplot <- renderPlot({ 75 | ggplot(data = movies, aes_string(x = input$x, y = input$y, 76 | color = input$z)) + 77 | geom_point(alpha = input$alpha) + 78 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 79 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 80 | color = toTitleCase(str_replace_all(input$z, "_", " "))) 81 | }) 82 | 83 | # Print data table if checked ------------------------------------- 84 | output$moviestable <- DT::renderDataTable({ 85 | DT::datatable(data = movies[, 1:7], 86 | options = list(pageLength = 10), 87 | rownames = FALSE) 88 | }) 89 | } 90 | 91 | # Create the Shiny app object --------------------------------------- 92 | shinyApp(ui = ui, server = server) 93 | -------------------------------------------------------------------------------- /05-understand-reactivity/05-understand-reactivity.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/05-understand-reactivity/05-understand-reactivity.key -------------------------------------------------------------------------------- /05-understand-reactivity/05-understand-reactivity.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/05-understand-reactivity/05-understand-reactivity.pdf -------------------------------------------------------------------------------- /05-understand-reactivity/apps/movies/movies.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/05-understand-reactivity/apps/movies/movies.Rdata -------------------------------------------------------------------------------- /05-understand-reactivity/apps/movies/movies_05.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(ggplot2) 3 | library(DT) 4 | library(stringr) 5 | library(tools) 6 | load("movies.Rdata") 7 | 8 | # Define UI for application that plots features of movies ----------- 9 | ui <- fluidPage( 10 | 11 | # Application title ----------------------------------------------- 12 | titlePanel("Movie browser"), 13 | 14 | # Sidebar layout with a input and output definitions -------------- 15 | sidebarLayout( 16 | 17 | # Inputs: Select variables to plot ------------------------------ 18 | sidebarPanel( 19 | 20 | # Select variable for y-axis ---------------------------------- 21 | selectInput(inputId = "y", 22 | label = "Y-axis:", 23 | choices = c("IMDB rating" = "imdb_rating", 24 | "IMDB number of votes" = "imdb_num_votes", 25 | "Critics Score" = "critics_score", 26 | "Audience Score" = "audience_score", 27 | "Runtime" = "runtime"), 28 | selected = "audience_score"), 29 | 30 | # Select variable for x-axis ---------------------------------- 31 | selectInput(inputId = "x", 32 | label = "X-axis:", 33 | choices = c("IMDB rating" = "imdb_rating", 34 | "IMDB number of votes" = "imdb_num_votes", 35 | "Critics Score" = "critics_score", 36 | "Audience Score" = "audience_score", 37 | "Runtime" = "runtime"), 38 | selected = "critics_score"), 39 | 40 | # Select variable for color ----------------------------------- 41 | selectInput(inputId = "z", 42 | label = "Color by:", 43 | choices = c("Title Type" = "title_type", 44 | "Genre" = "genre", 45 | "MPAA Rating" = "mpaa_rating", 46 | "Critics Rating" = "critics_rating", 47 | "Audience Rating" = "audience_rating"), 48 | selected = "mpaa_rating"), 49 | 50 | # Set alpha level --------------------------------------------- 51 | sliderInput(inputId = "alpha", 52 | label = "Alpha:", 53 | min = 0, max = 1, 54 | value = 0.5) 55 | 56 | ), 57 | 58 | # Output -------------------------------------------------------- 59 | mainPanel( 60 | 61 | # Show scatterplot -------------------------------------------- 62 | plotOutput(outputId = "scatterplot"), 63 | 64 | # Show data table --------------------------------------------- 65 | DT::dataTableOutput(outputId = "moviestable") 66 | ) 67 | ) 68 | ) 69 | 70 | # Define server function required to create the scatterplot --------- 71 | server <- function(input, output) { 72 | 73 | # Create scatterplot object the plotOutput function is expecting -- 74 | output$scatterplot <- renderPlot({ 75 | ggplot(data = movies, aes_string(x = input$x, y = input$y, 76 | color = input$z)) + 77 | geom_point(alpha = input$alpha) + 78 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 79 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 80 | color = toTitleCase(str_replace_all(input$z, "_", " "))) 81 | }) 82 | 83 | # Print data table if checked ------------------------------------- 84 | output$moviestable <- DT::renderDataTable({ 85 | DT::datatable(data = movies[, 1:7], 86 | options = list(pageLength = 10), 87 | rownames = FALSE) 88 | }) 89 | } 90 | 91 | # Create the Shiny app object --------------------------------------- 92 | shinyApp(ui = ui, server = server) 93 | -------------------------------------------------------------------------------- /05-understand-reactivity/apps/movies/movies_06.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(ggplot2) 3 | library(DT) 4 | library(stringr) 5 | load("movies.Rdata") 6 | 7 | # Define UI for application that plots features of movies ----------- 8 | ui <- fluidPage( 9 | 10 | # Application title ----------------------------------------------- 11 | titlePanel("Movie browser"), 12 | 13 | # Sidebar layout with a input and output definitions -------------- 14 | sidebarLayout( 15 | 16 | # Inputs: Select variables to plot ------------------------------ 17 | sidebarPanel( 18 | 19 | # Select variable for y-axis ---------------------------------- 20 | selectInput(inputId = "y", 21 | label = "Y-axis:", 22 | choices = c("IMDB rating" = "imdb_rating", 23 | "IMDB number of votes" = "imdb_num_votes", 24 | "Critics Score" = "critics_score", 25 | "Audience Score" = "audience_score", 26 | "Runtime" = "runtime"), 27 | selected = "audience_score"), 28 | 29 | # Select variable for x-axis ---------------------------------- 30 | selectInput(inputId = "x", 31 | label = "X-axis:", 32 | choices = c("IMDB rating" = "imdb_rating", 33 | "IMDB number of votes" = "imdb_num_votes", 34 | "Critics Score" = "critics_score", 35 | "Audience Score" = "audience_score", 36 | "Runtime" = "runtime"), 37 | selected = "critics_score"), 38 | 39 | # Select variable for color ----------------------------------- 40 | selectInput(inputId = "z", 41 | label = "Color by:", 42 | choices = c("Title Type" = "title_type", 43 | "Genre" = "genre", 44 | "MPAA Rating" = "mpaa_rating", 45 | "Critics Rating" = "critics_rating", 46 | "Audience Rating" = "audience_rating"), 47 | selected = "mpaa_rating"), 48 | 49 | # Set alpha level --------------------------------------------- 50 | sliderInput(inputId = "alpha", 51 | label = "Alpha:", 52 | min = 0, max = 1, 53 | value = 0.5), 54 | 55 | # Set point size ---------------------------------------------- 56 | sliderInput(inputId = "size", 57 | label = "Size:", 58 | min = 0, max = 5, 59 | value = 2) 60 | 61 | ), 62 | 63 | # Output -------------------------------------------------------- 64 | mainPanel( 65 | 66 | # Show scatterplot -------------------------------------------- 67 | plotOutput(outputId = "scatterplot"), 68 | 69 | # Show data table --------------------------------------------- 70 | DT::dataTableOutput(outputId = "moviestable") 71 | ) 72 | ) 73 | ) 74 | 75 | # Define server function required to create the scatterplot --------- 76 | server <- function(input, output) { 77 | 78 | # Create scatterplot object the plotOutput function is expecting -- 79 | output$scatterplot <- renderPlot({ 80 | ggplot(data = movies, aes_string(x = input$x, y = input$y, 81 | color = input$z)) + 82 | geom_point(alpha = input$alpha, size = input$size) + 83 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 84 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 85 | color = toTitleCase(str_replace_all(input$z, "_", " "))) 86 | }) 87 | 88 | # Print data table if checked ------------------------------------- 89 | output$moviestable <- DT::renderDataTable({ 90 | DT::datatable(data = movies[, 1:7], 91 | options = list(pageLength = 10), 92 | rownames = FALSE) 93 | }) 94 | } 95 | 96 | # Create the Shiny app object --------------------------------------- 97 | shinyApp(ui = ui, server = server) 98 | -------------------------------------------------------------------------------- /05-understand-reactivity/apps/movies/movies_07.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(ggplot2) 3 | library(DT) 4 | library(stringr) 5 | library(dplyr) 6 | library(tools) 7 | load("movies.Rdata") 8 | 9 | # Define UI for application that plots features of movies ----------- 10 | ui <- fluidPage( 11 | 12 | # Application title ----------------------------------------------- 13 | titlePanel("Movie browser"), 14 | 15 | # Sidebar layout with a input and output definitions -------------- 16 | sidebarLayout( 17 | 18 | # Inputs: Select variables to plot ------------------------------ 19 | sidebarPanel( 20 | 21 | # Select variable for y-axis ---------------------------------- 22 | selectInput(inputId = "y", 23 | label = "Y-axis:", 24 | choices = c("IMDB rating" = "imdb_rating", 25 | "IMDB number of votes" = "imdb_num_votes", 26 | "Critics Score" = "critics_score", 27 | "Audience Score" = "audience_score", 28 | "Runtime" = "runtime"), 29 | selected = "audience_score"), 30 | 31 | # Select variable for x-axis ---------------------------------- 32 | selectInput(inputId = "x", 33 | label = "X-axis:", 34 | choices = c("IMDB rating" = "imdb_rating", 35 | "IMDB number of votes" = "imdb_num_votes", 36 | "Critics Score" = "critics_score", 37 | "Audience Score" = "audience_score", 38 | "Runtime" = "runtime"), 39 | selected = "critics_score"), 40 | 41 | # Select variable for color ----------------------------------- 42 | selectInput(inputId = "z", 43 | label = "Color by:", 44 | choices = c("Title Type" = "title_type", 45 | "Genre" = "genre", 46 | "MPAA Rating" = "mpaa_rating", 47 | "Critics Rating" = "critics_rating", 48 | "Audience Rating" = "audience_rating"), 49 | selected = "mpaa_rating"), 50 | 51 | # Set alpha level --------------------------------------------- 52 | sliderInput(inputId = "alpha", 53 | label = "Alpha:", 54 | min = 0, max = 1, 55 | value = 0.5), 56 | 57 | # Set point size ---------------------------------------------- 58 | sliderInput(inputId = "size", 59 | label = "Size:", 60 | min = 0, max = 5, 61 | value = 2), 62 | 63 | # Horizontal line for visual separation ----------------------- 64 | hr(), 65 | 66 | # Select which types of movies to plot ------------------------ 67 | checkboxGroupInput(inputId = "selected_type", 68 | label = "Select movie type(s):", 69 | choices = c("Documentary", "Feature Film", "TV Movie"), 70 | selected = "Feature Film") 71 | ), 72 | 73 | # Output: ------------------------------------------------------- 74 | mainPanel( 75 | 76 | # Show scatterplot -------------------------------------------- 77 | plotOutput(outputId = "scatterplot"), 78 | br(), # a little bit of visual separation 79 | 80 | # Print number of obs plotted --------------------------------- 81 | uiOutput(outputId = "n"), 82 | br(), br(), # a little bit of visual separation 83 | 84 | # Show data table --------------------------------------------- 85 | DT::dataTableOutput(outputId = "moviestable") 86 | ) 87 | ) 88 | ) 89 | 90 | # Define server function required to create the scatterplot --------- 91 | server <- function(input, output) { 92 | 93 | # Create a subset of data filtering for selected title types ------ 94 | movies_subset <- reactive({ 95 | req(input$selected_type) # ensure availablity of value before proceeding 96 | filter(movies, title_type %in% input$selected_type) 97 | }) 98 | 99 | # Create scatterplot object the plotOutput function is expecting -- 100 | output$scatterplot <- renderPlot({ 101 | ggplot(data = movies_subset(), aes_string(x = input$x, y = input$y, 102 | color = input$z)) + 103 | geom_point(alpha = input$alpha, size = input$size) + 104 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 105 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 106 | color = toTitleCase(str_replace_all(input$z, "_", " "))) 107 | }) 108 | 109 | # Print number of movies plotted ---------------------------------- 110 | output$n <- renderUI({ 111 | types <- movies_subset()$title_type %>% 112 | factor(levels = input$selected_type) 113 | counts <- table(types) 114 | 115 | HTML(paste("There are", counts, input$selected_type, "movies in this dataset.
")) 116 | }) 117 | 118 | # Print data table if checked ------------------------------------- 119 | output$moviestable <- DT::renderDataTable({ 120 | DT::datatable(data = movies[, 1:7], 121 | options = list(pageLength = 10), 122 | rownames = FALSE) 123 | }) 124 | } 125 | 126 | # Create the Shiny app object --------------------------------------- 127 | shinyApp(ui = ui, server = server) 128 | -------------------------------------------------------------------------------- /05-understand-reactivity/apps/movies/movies_08.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(ggplot2) 3 | library(DT) 4 | library(stringr) 5 | library(dplyr) 6 | library(tools) 7 | load("movies.Rdata") 8 | 9 | # Define UI for application that plots features of movies ----------- 10 | ui <- fluidPage( 11 | 12 | # Application title ----------------------------------------------- 13 | titlePanel("Movie browser"), 14 | 15 | # Sidebar layout with a input and output definitions -------------- 16 | sidebarLayout( 17 | 18 | # Inputs: Select variables to plot ------------------------------ 19 | sidebarPanel( 20 | 21 | # Select variable for y-axis ---------------------------------- 22 | selectInput(inputId = "y", 23 | label = "Y-axis:", 24 | choices = c("IMDB rating" = "imdb_rating", 25 | "IMDB number of votes" = "imdb_num_votes", 26 | "Critics Score" = "critics_score", 27 | "Audience Score" = "audience_score", 28 | "Runtime" = "runtime"), 29 | selected = "audience_score"), 30 | 31 | # Select variable for x-axis ---------------------------------- 32 | selectInput(inputId = "x", 33 | label = "X-axis:", 34 | choices = c("IMDB rating" = "imdb_rating", 35 | "IMDB number of votes" = "imdb_num_votes", 36 | "Critics Score" = "critics_score", 37 | "Audience Score" = "audience_score", 38 | "Runtime" = "runtime"), 39 | selected = "critics_score"), 40 | 41 | # Select variable for color ----------------------------------- 42 | selectInput(inputId = "z", 43 | label = "Color by:", 44 | choices = c("Title Type" = "title_type", 45 | "Genre" = "genre", 46 | "MPAA Rating" = "mpaa_rating", 47 | "Critics Rating" = "critics_rating", 48 | "Audience Rating" = "audience_rating"), 49 | selected = "mpaa_rating"), 50 | 51 | # Set alpha level --------------------------------------------- 52 | sliderInput(inputId = "alpha", 53 | label = "Alpha:", 54 | min = 0, max = 1, 55 | value = 0.5), 56 | 57 | # Set point size ---------------------------------------------- 58 | sliderInput(inputId = "size", 59 | label = "Size:", 60 | min = 0, max = 5, 61 | value = 2), 62 | 63 | # Horizontal line for visual separation ----------------------- 64 | hr(), 65 | 66 | # Select which types of movies to plot ------------------------ 67 | checkboxGroupInput(inputId = "selected_type", 68 | label = "Select movie type(s):", 69 | choices = c("Documentary", "Feature Film", "TV Movie"), 70 | selected = "Feature Film") 71 | ), 72 | 73 | # Output: ------------------------------------------------------- 74 | mainPanel( 75 | 76 | # Show scatterplot -------------------------------------------- 77 | plotOutput(outputId = "scatterplot"), 78 | br(), # a little bit of visual separation 79 | 80 | # Print number of obs plotted --------------------------------- 81 | uiOutput(outputId = "n"), 82 | br(), br(), # a little bit of visual separation 83 | 84 | # Show data table --------------------------------------------- 85 | DT::dataTableOutput(outputId = "moviestable") 86 | ) 87 | ) 88 | ) 89 | 90 | # Define server function required to create the scatterplot --------- 91 | server <- function(input, output) { 92 | 93 | # Create a subset of data filtering for selected title types ------ 94 | movies_subset <- reactive({ 95 | req(input$selected_type) # ensure availablity of value before proceeding 96 | filter(movies, title_type %in% input$selected_type) 97 | }) 98 | 99 | # Create scatterplot object the plotOutput function is expecting -- 100 | output$scatterplot <- renderPlot({ 101 | ggplot(data = movies_subset(), aes_string(x = input$x, y = input$y, 102 | color = input$z)) + 103 | geom_point(alpha = input$alpha, size = input$size) + 104 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 105 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 106 | color = toTitleCase(str_replace_all(input$z, "_", " "))) 107 | }) 108 | 109 | # Print number of movies plotted ---------------------------------- 110 | output$n <- renderUI({ 111 | types <- movies_subset()$title_type %>% 112 | factor(levels = input$selected_type) 113 | counts <- table(types) 114 | 115 | HTML(paste("There are", counts, input$selected_type, "movies in this dataset.
")) 116 | }) 117 | 118 | # Print data table if checked ------------------------------------- 119 | output$moviestable <- DT::renderDataTable({ 120 | DT::datatable(data = movies_subset()[, 1:7], 121 | options = list(pageLength = 10), 122 | rownames = FALSE) 123 | }) 124 | } 125 | 126 | # Create the Shiny app object --------------------------------------- 127 | shinyApp(ui = ui, server = server) 128 | -------------------------------------------------------------------------------- /05-understand-reactivity/apps/movies/movies_09.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(ggplot2) 3 | library(DT) 4 | library(stringr) 5 | library(dplyr) 6 | library(tools) 7 | load("movies.Rdata") 8 | 9 | # Define UI for application that plots features of movies ----------- 10 | ui <- fluidPage( 11 | 12 | # Application title ----------------------------------------------- 13 | titlePanel("Movie browser"), 14 | 15 | # Sidebar layout with a input and output definitions -------------- 16 | sidebarLayout( 17 | 18 | # Inputs: Select variables to plot ------------------------------ 19 | sidebarPanel( 20 | 21 | # Select variable for y-axis ---------------------------------- 22 | selectInput(inputId = "y", 23 | label = "Y-axis:", 24 | choices = c("IMDB rating" = "imdb_rating", 25 | "IMDB number of votes" = "imdb_num_votes", 26 | "Critics Score" = "critics_score", 27 | "Audience Score" = "audience_score", 28 | "Runtime" = "runtime"), 29 | selected = "audience_score"), 30 | 31 | # Select variable for x-axis ---------------------------------- 32 | selectInput(inputId = "x", 33 | label = "X-axis:", 34 | choices = c("IMDB rating" = "imdb_rating", 35 | "IMDB number of votes" = "imdb_num_votes", 36 | "Critics Score" = "critics_score", 37 | "Audience Score" = "audience_score", 38 | "Runtime" = "runtime"), 39 | selected = "critics_score"), 40 | 41 | # Select variable for color ----------------------------------- 42 | selectInput(inputId = "z", 43 | label = "Color by:", 44 | choices = c("Title Type" = "title_type", 45 | "Genre" = "genre", 46 | "MPAA Rating" = "mpaa_rating", 47 | "Critics Rating" = "critics_rating", 48 | "Audience Rating" = "audience_rating"), 49 | selected = "mpaa_rating"), 50 | 51 | # Set alpha level --------------------------------------------- 52 | sliderInput(inputId = "alpha", 53 | label = "Alpha:", 54 | min = 0, max = 1, 55 | value = 0.5), 56 | 57 | # Set point size ---------------------------------------------- 58 | sliderInput(inputId = "size", 59 | label = "Size:", 60 | min = 0, max = 5, 61 | value = 2), 62 | 63 | # Horizontal line for visual separation ----------------------- 64 | hr(), 65 | 66 | # Select which types of movies to plot ------------------------ 67 | checkboxGroupInput(inputId = "selected_type", 68 | label = "Select movie type(s):", 69 | choices = c("Documentary", "Feature Film", "TV Movie"), 70 | selected = "Feature Film"), 71 | 72 | # Select sample size ---------------------------------------------------- 73 | numericInput(inputId = "n_samp", 74 | label = "Sample size:", 75 | min = 1, max = nrow(movies), 76 | value = 50) 77 | ), 78 | 79 | # Output: ------------------------------------------------------- 80 | mainPanel( 81 | 82 | # Show scatterplot -------------------------------------------- 83 | plotOutput(outputId = "scatterplot"), 84 | br(), # a little bit of visual separation 85 | 86 | # Print number of obs plotted --------------------------------- 87 | uiOutput(outputId = "n"), 88 | br(), br(), # a little bit of visual separation 89 | 90 | # Show data table --------------------------------------------- 91 | DT::dataTableOutput(outputId = "moviestable") 92 | ) 93 | ) 94 | ) 95 | 96 | # Define server function required to create the scatterplot --------- 97 | server <- function(input, output) { 98 | 99 | # Create a subset of data filtering for selected title types ------ 100 | movies_subset <- reactive({ 101 | req(input$selected_type) # ensure availablity of value before proceeding 102 | filter(movies, title_type %in% input$selected_type) 103 | }) 104 | 105 | # Create new df that is n_samp obs from selected type movies ------ 106 | movies_sample <- reactive({ 107 | req(input$n_samp) # ensure availablity of value before proceeding 108 | sample_n(movies_subset(), input$n_samp) 109 | }) 110 | 111 | # Create scatterplot object the plotOutput function is expecting -- 112 | output$scatterplot <- renderPlot({ 113 | ggplot(data = movies_sample(), aes_string(x = input$x, y = input$y, color = input$z)) + 114 | geom_point(alpha = input$alpha, size = input$size) + 115 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 116 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 117 | color = toTitleCase(str_replace_all(input$z, "_", " "))) 118 | }) 119 | 120 | # Print number of movies plotted ---------------------------------- 121 | output$n <- renderUI({ 122 | types <- movies_sample()$title_type %>% 123 | factor(levels = input$selected_type) 124 | counts <- table(types) 125 | 126 | HTML(paste("There are", counts, input$selected_type, "movies in this dataset.
")) 127 | }) 128 | 129 | # Print data table if checked ------------------------------------- 130 | output$moviestable <- DT::renderDataTable({ 131 | DT::datatable(data = movies_sample()[, 1:7], 132 | options = list(pageLength = 10), 133 | rownames = FALSE) 134 | }) 135 | } 136 | 137 | # Create the Shiny app object --------------------------------------- 138 | shinyApp(ui = ui, server = server) 139 | -------------------------------------------------------------------------------- /05-understand-reactivity/apps/movies/movies_10.R: -------------------------------------------------------------------------------- 1 | # Note: This app is intentionally broken, 2 | # it is used as part of an exercise 3 | 4 | library(shiny) 5 | library(ggplot2) 6 | library(DT) 7 | library(stringr) 8 | library(dplyr) 9 | library(tools) 10 | load("movies.Rdata") 11 | 12 | # Define UI for application that plots features of movies ----------- 13 | ui <- fluidPage( 14 | 15 | # Application title ----------------------------------------------- 16 | titlePanel("Movie browser"), 17 | 18 | # Sidebar layout with a input and output definitions -------------- 19 | sidebarLayout( 20 | 21 | # Inputs: Select variables to plot ------------------------------ 22 | sidebarPanel( 23 | 24 | # Select variable for y-axis ---------------------------------- 25 | selectInput(inputId = "y", 26 | label = "Y-axis:", 27 | choices = c("IMDB rating" = "imdb_rating", 28 | "IMDB number of votes" = "imdb_num_votes", 29 | "Critics Score" = "critics_score", 30 | "Audience Score" = "audience_score", 31 | "Runtime" = "runtime"), 32 | selected = "audience_score"), 33 | 34 | # Select variable for x-axis ---------------------------------- 35 | selectInput(inputId = "x", 36 | label = "X-axis:", 37 | choices = c("IMDB rating" = "imdb_rating", 38 | "IMDB number of votes" = "imdb_num_votes", 39 | "Critics Score" = "critics_score", 40 | "Audience Score" = "audience_score", 41 | "Runtime" = "runtime"), 42 | selected = "critics_score"), 43 | 44 | # Select variable for color ----------------------------------- 45 | selectInput(inputId = "z", 46 | label = "Color by:", 47 | choices = c("Title Type" = "title_type", 48 | "Genre" = "genre", 49 | "MPAA Rating" = "mpaa_rating", 50 | "Critics Rating" = "critics_rating", 51 | "Audience Rating" = "audience_rating"), 52 | selected = "mpaa_rating"), 53 | 54 | # Set alpha level --------------------------------------------- 55 | sliderInput(inputId = "alpha", 56 | label = "Alpha:", 57 | min = 0, max = 1, 58 | value = 0.5), 59 | 60 | # Set point size ---------------------------------------------- 61 | sliderInput(inputId = "size", 62 | label = "Size:", 63 | min = 0, max = 5, 64 | value = 2), 65 | 66 | # Enter text for plot title --------------------------------------------- 67 | textInput(inputId = "plot_title", 68 | label = "Plot title", 69 | placeholder = "Enter text to be used as plot title"), 70 | 71 | # Horizontal line for visual separation ----------------------- 72 | hr(), 73 | 74 | # Select which types of movies to plot ------------------------ 75 | checkboxGroupInput(inputId = "selected_type", 76 | label = "Select movie type(s):", 77 | choices = c("Documentary", "Feature Film", "TV Movie"), 78 | selected = "Feature Film"), 79 | 80 | # Select sample size ---------------------------------------------------- 81 | numericInput(inputId = "n_samp", 82 | label = "Sample size:", 83 | min = 1, max = nrow(movies), 84 | value = 50) 85 | ), 86 | 87 | # Output: ------------------------------------------------------- 88 | mainPanel( 89 | 90 | # Show scatterplot -------------------------------------------- 91 | plotOutput(outputId = "scatterplot"), 92 | br(), # a little bit of visual separation 93 | 94 | # Print number of obs plotted --------------------------------- 95 | uiOutput(outputId = "n"), 96 | br(), br(), # a little bit of visual separation 97 | 98 | # Show data table --------------------------------------------- 99 | DT::dataTableOutput(outputId = "moviestable") 100 | ) 101 | ) 102 | ) 103 | 104 | # Define server function required to create the scatterplot --------- 105 | server <- function(input, output) { 106 | 107 | # Create a subset of data filtering for selected title types ------ 108 | movies_subset <- reactive({ 109 | req(input$selected_type) # ensure availablity of value before proceeding 110 | filter(movies, title_type %in% input$selected_type) 111 | }) 112 | 113 | # Create new df that is n_samp obs from selected type movies ------ 114 | movies_sample <- reactive({ 115 | req(input$n_samp) # ensure availablity of value before proceeding 116 | sample_n(movies_subset(), input$n_samp) 117 | }) 118 | 119 | # Convert plot_title toTitleCase ---------------------------------- 120 | output$pretty_plot_title <- toTitleCase(input$plot_title) 121 | 122 | # Create scatterplot object the plotOutput function is expecting -- 123 | output$scatterplot <- renderPlot({ 124 | ggplot(data = movies_sample(), aes_string(x = input$x, y = input$y, 125 | color = input$z)) + 126 | geom_point(alpha = input$alpha, size = input$size) + 127 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 128 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 129 | color = toTitleCase(str_replace_all(input$z, "_", " ")), 130 | title = output$pretty_plot_title 131 | ) 132 | }) 133 | 134 | # Print number of movies plotted ---------------------------------- 135 | output$n <- renderUI({ 136 | types <- movies_sample()$title_type %>% 137 | factor(levels = input$selected_type) 138 | counts <- table(types) 139 | 140 | HTML(paste("There are", counts, input$selected_type, "movies in this dataset.
")) 141 | }) 142 | 143 | # Print data table if checked ------------------------------------- 144 | output$moviestable <- DT::renderDataTable({ 145 | DT::datatable(data = movies_sample()[, 1:7], 146 | options = list(pageLength = 10), 147 | rownames = FALSE) 148 | }) 149 | } 150 | 151 | # Create the Shiny app object --------------------------------------- 152 | shinyApp(ui = ui, server = server) 153 | -------------------------------------------------------------------------------- /05-understand-reactivity/apps/movies/movies_11.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(ggplot2) 3 | library(DT) 4 | library(stringr) 5 | library(dplyr) 6 | library(tools) 7 | load("movies.Rdata") 8 | 9 | # Define UI for application that plots features of movies ----------- 10 | ui <- fluidPage( 11 | 12 | # Application title ----------------------------------------------- 13 | titlePanel("Movie browser"), 14 | 15 | # Sidebar layout with a input and output definitions -------------- 16 | sidebarLayout( 17 | 18 | # Inputs: Select variables to plot ------------------------------ 19 | sidebarPanel( 20 | 21 | # Select variable for y-axis ---------------------------------- 22 | selectInput(inputId = "y", 23 | label = "Y-axis:", 24 | choices = c("IMDB rating" = "imdb_rating", 25 | "IMDB number of votes" = "imdb_num_votes", 26 | "Critics Score" = "critics_score", 27 | "Audience Score" = "audience_score", 28 | "Runtime" = "runtime"), 29 | selected = "audience_score"), 30 | 31 | # Select variable for x-axis ---------------------------------- 32 | selectInput(inputId = "x", 33 | label = "X-axis:", 34 | choices = c("IMDB rating" = "imdb_rating", 35 | "IMDB number of votes" = "imdb_num_votes", 36 | "Critics Score" = "critics_score", 37 | "Audience Score" = "audience_score", 38 | "Runtime" = "runtime"), 39 | selected = "critics_score"), 40 | 41 | # Select variable for color ----------------------------------- 42 | selectInput(inputId = "z", 43 | label = "Color by:", 44 | choices = c("Title Type" = "title_type", 45 | "Genre" = "genre", 46 | "MPAA Rating" = "mpaa_rating", 47 | "Critics Rating" = "critics_rating", 48 | "Audience Rating" = "audience_rating"), 49 | selected = "mpaa_rating"), 50 | 51 | # Set alpha level --------------------------------------------- 52 | sliderInput(inputId = "alpha", 53 | label = "Alpha:", 54 | min = 0, max = 1, 55 | value = 0.5), 56 | 57 | # Set point size ---------------------------------------------- 58 | sliderInput(inputId = "size", 59 | label = "Size:", 60 | min = 0, max = 5, 61 | value = 2), 62 | 63 | # Enter text for plot title --------------------------------------------- 64 | textInput(inputId = "plot_title", 65 | label = "Plot title", 66 | placeholder = "Enter text to be used as plot title"), 67 | 68 | # Horizontal line for visual separation ----------------------- 69 | hr(), 70 | 71 | # Select which types of movies to plot ------------------------ 72 | checkboxGroupInput(inputId = "selected_type", 73 | label = "Select movie type(s):", 74 | choices = c("Documentary", "Feature Film", "TV Movie"), 75 | selected = "Feature Film"), 76 | 77 | # Select sample size ---------------------------------------------------- 78 | numericInput(inputId = "n_samp", 79 | label = "Sample size:", 80 | min = 1, max = nrow(movies), 81 | value = 50) 82 | ), 83 | 84 | # Output: ------------------------------------------------------- 85 | mainPanel( 86 | 87 | # Show scatterplot -------------------------------------------- 88 | plotOutput(outputId = "scatterplot"), 89 | br(), # a little bit of visual separation 90 | 91 | # Print number of obs plotted --------------------------------- 92 | uiOutput(outputId = "n"), 93 | br(), br(), # a little bit of visual separation 94 | 95 | # Show data table --------------------------------------------- 96 | DT::dataTableOutput(outputId = "moviestable") 97 | ) 98 | ) 99 | ) 100 | 101 | # Define server function required to create the scatterplot --------- 102 | server <- function(input, output) { 103 | 104 | # Create a subset of data filtering for selected title types ------ 105 | movies_subset <- reactive({ 106 | req(input$selected_type) # ensure availablity of value before proceeding 107 | filter(movies, title_type %in% input$selected_type) 108 | }) 109 | 110 | # Create new df that is n_samp obs from selected type movies ------ 111 | movies_sample <- reactive({ 112 | req(input$n_samp) # ensure availablity of value before proceeding 113 | sample_n(movies_subset(), input$n_samp) 114 | }) 115 | 116 | # Convert plot_title toTitleCase ---------------------------------- 117 | pretty_plot_title <- reactive({ toTitleCase(input$plot_title) }) 118 | 119 | # Create scatterplot object the plotOutput function is expecting -- 120 | output$scatterplot <- renderPlot({ 121 | ggplot(data = movies_sample(), aes_string(x = input$x, y = input$y, 122 | color = input$z)) + 123 | geom_point(alpha = input$alpha, size = input$size) + 124 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 125 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 126 | color = toTitleCase(str_replace_all(input$z, "_", " ")), 127 | title = pretty_plot_title() 128 | ) 129 | }) 130 | 131 | # Print number of movies plotted ---------------------------------- 132 | output$n <- renderUI({ 133 | types <- movies_sample()$title_type %>% 134 | factor(levels = input$selected_type) 135 | counts <- table(types) 136 | 137 | HTML(paste("There are", counts, input$selected_type, "movies in this dataset.
")) 138 | }) 139 | 140 | # Print data table if checked ------------------------------------- 141 | output$moviestable <- DT::renderDataTable({ 142 | DT::datatable(data = movies_sample()[, 1:7], 143 | options = list(pageLength = 10), 144 | rownames = FALSE) 145 | }) 146 | } 147 | 148 | # Run the application ----------------------------------------------- 149 | shinyApp(ui = ui, server = server) 150 | -------------------------------------------------------------------------------- /06-design-ui/06-design-ui.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/06-design-ui/06-design-ui.key -------------------------------------------------------------------------------- /06-design-ui/06-design-ui.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/06-design-ui/06-design-ui.pdf -------------------------------------------------------------------------------- /06-design-ui/apps/big_mac_index/prototype.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Prototype for the Big Mac exchange-rate index" 3 | author: "D. Kaplan" 4 | date: "1/16/2019" 5 | output: html_document 6 | runtime: shiny 7 | --- 8 | 9 | ```{r setup, include=FALSE} 10 | library(tidyverse) 11 | knitr::opts_chunk$set(echo = TRUE) 12 | ``` 13 | 14 | ## Introduction 15 | 16 | > *"Premature optimization is the root of all evil."* -- Donald Knuth 17 | 18 | I like to prototype shiny apps as an Rmd document. This has several advantages: 19 | 20 | * Avoids start-up work of arranging a UI. 21 | * Makes it easy to include narrative, including comments on the design from your co-workers. 22 | * Let's you display the code as you like. 23 | 24 | For some clients, a document is the way to go, anyways. 25 | 26 | 27 | ```{r load_data, message = FALSE} 28 | # NOTE: If you want to deploy this app on a server (e.g. shinyapps.io) 29 | # you need to move all data files needed into the app's directory 30 | month_names <- c("Jan", "Feb", "Mar", "Apr", "May", "June", "July", "Aug", "Sept", "Oct", "Nov", "Dec") 31 | 32 | Raw <- readr::read_csv("../../../data/big-mac-index.csv") 33 | Big_mac_data <- 34 | Raw %>% 35 | mutate(year = lubridate::year(date), 36 | month = month_names[lubridate::month(date)]) 37 | ``` 38 | 39 | 40 | 41 | This chunk is going to create some controls. Note that since the controls are ultimately HTML, I can create them in one place and display them in another. 42 | 43 | ```{r make_controls, eval = TRUE} 44 | countries <- unique(Big_mac_data$name) 45 | years <- unique(Big_mac_data$year) 46 | months <- unique(Big_mac_data$month) 47 | country <- selectInput("countries", "Comparison countries:", choices = countries, multiple = TRUE ) 48 | year <- selectInput("year", "Year:", choices = years) 49 | month <- selectInput("month", "Months:", choices = months, multiple = TRUE) 50 | ``` 51 | 52 | `r country` | `r year` | `r month` 53 | ------------|----------|---------- 54 | Choose many | Just 1 | As many as you like. 55 | 56 | Comment: Watch out. You'll have to reset the choices for "Months" whenever a new year is selected. 57 | 58 | ```{r some_server_code} 59 | for_one_year <- reactive(Big_mac_data %>% filter(year %in% input$year)) 60 | observe({ 61 | updateSelectInput(session, inputId = "month", choices = unique(for_one_year()$month)) 62 | }) 63 | ``` 64 | 65 | -------------------------------------------------------------------------------- /06-design-ui/apps/movies/movies.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/06-design-ui/apps/movies/movies.Rdata -------------------------------------------------------------------------------- /06-design-ui/apps/movies/movies_11-soln.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(shinythemes) 3 | library(ggplot2) 4 | library(DT) 5 | library(stringr) 6 | library(dplyr) 7 | library(tools) 8 | load("movies.Rdata") 9 | 10 | # Define UI for application that plots features of movies ----------- 11 | ui <- fluidPage( 12 | 13 | # Application title ----------------------------------------------- 14 | titlePanel("Movie browser"), 15 | 16 | # Sidebar layout with a input and output definitions -------------- 17 | sidebarLayout( 18 | 19 | # Inputs: Select variables to plot ------------------------------ 20 | sidebarPanel( 21 | themeSelector(), 22 | HTML("You could put in some instructions as simply as this!
And notice the ? after some of the control names."), 23 | # Select variable for y-axis ---------------------------------- 24 | selectInput(inputId = "y", 25 | label = HTML("Y-axis: ?"), 26 | choices = c("IMDB rating" = "imdb_rating", 27 | "IMDB number of votes" = "imdb_num_votes", 28 | "Critics Score" = "critics_score", 29 | "Audience Score" = "audience_score", 30 | "Runtime" = "runtime"), 31 | selected = "audience_score"), 32 | 33 | # Select variable for x-axis ---------------------------------- 34 | selectInput(inputId = "x", 35 | label = "X-axis:", 36 | choices = c("IMDB rating" = "imdb_rating", 37 | "IMDB number of votes" = "imdb_num_votes", 38 | "Critics Score" = "critics_score", 39 | "Audience Score" = "audience_score", 40 | "Runtime" = "runtime"), 41 | selected = "critics_score"), 42 | 43 | # Select variable for color ----------------------------------- 44 | selectInput(inputId = "z", 45 | label = "Color by:", 46 | choices = c("Title Type" = "title_type", 47 | "Genre" = "genre", 48 | "MPAA Rating" = "mpaa_rating", 49 | "Critics Rating" = "critics_rating", 50 | "Audience Rating" = "audience_rating"), 51 | selected = "mpaa_rating"), 52 | 53 | # Set alpha level --------------------------------------------- 54 | sliderInput(inputId = "alpha", 55 | label = HTML("Alpha:?"), 56 | min = 0, max = 1, 57 | value = 0.5), 58 | 59 | # Set point size ---------------------------------------------- 60 | sliderInput(inputId = "size", 61 | label = "Size:", 62 | min = 0, max = 5, 63 | value = 2), 64 | 65 | # Enter text for plot title --------------------------------------------- 66 | textInput(inputId = "plot_title", 67 | label = "Plot title", 68 | placeholder = "Enter text to be used as plot title"), 69 | 70 | # Horizontal line for visual separation ----------------------- 71 | hr(), 72 | 73 | # Select which types of movies to plot ------------------------ 74 | checkboxGroupInput(inputId = "selected_type", 75 | label = "Select movie type(s):", 76 | choices = c("Documentary", "Feature Film", "TV Movie"), 77 | selected = "Feature Film"), 78 | 79 | # Select sample size ---------------------------------------------------- 80 | numericInput(inputId = "n_samp", 81 | label = "Sample size:", 82 | min = 1, max = nrow(movies), 83 | value = 50) 84 | ), 85 | 86 | # Output: ------------------------------------------------------- 87 | mainPanel( 88 | 89 | # Show scatterplot -------------------------------------------- 90 | plotOutput(outputId = "scatterplot"), 91 | br(), # a little bit of visual separation 92 | 93 | # Print number of obs plotted --------------------------------- 94 | uiOutput(outputId = "n"), 95 | br(), br(), # a little bit of visual separation 96 | 97 | # Show data table --------------------------------------------- 98 | DT::dataTableOutput(outputId = "moviestable") 99 | ) 100 | ) 101 | ) 102 | 103 | # Define server function required to create the scatterplot --------- 104 | server <- function(input, output) { 105 | 106 | # Create a subset of data filtering for selected title types ------ 107 | movies_subset <- reactive({ 108 | req(input$selected_type) # ensure availablity of value before proceeding 109 | filter(movies, title_type %in% input$selected_type) 110 | }) 111 | 112 | # Create new df that is n_samp obs from selected type movies ------ 113 | movies_sample <- reactive({ 114 | req(input$n_samp) # ensure availablity of value before proceeding 115 | sample_n(movies_subset(), input$n_samp) 116 | }) 117 | 118 | # Convert plot_title toTitleCase ---------------------------------- 119 | pretty_plot_title <- reactive({ toTitleCase(input$plot_title) }) 120 | 121 | # Create scatterplot object the plotOutput function is expecting -- 122 | output$scatterplot <- renderPlot({ 123 | ggplot(data = movies_sample(), aes_string(x = input$x, y = input$y, 124 | color = input$z)) + 125 | geom_point(alpha = input$alpha, size = input$size) + 126 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 127 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 128 | color = toTitleCase(str_replace_all(input$z, "_", " ")), 129 | title = pretty_plot_title() 130 | ) 131 | }) 132 | 133 | # Print number of movies plotted ---------------------------------- 134 | output$n <- renderUI({ 135 | types <- movies_sample()$title_type %>% 136 | factor(levels = input$selected_type) 137 | counts <- table(types) 138 | 139 | HTML(paste("There are", counts, input$selected_type, "movies in this dataset.
")) 140 | }) 141 | 142 | # Print data table if checked ------------------------------------- 143 | output$moviestable <- DT::renderDataTable({ 144 | DT::datatable(data = movies_sample()[, 1:7], 145 | options = list(pageLength = 10), 146 | rownames = FALSE) 147 | }) 148 | } 149 | 150 | # Run the application ----------------------------------------------- 151 | shinyApp(ui = ui, server = server) 152 | -------------------------------------------------------------------------------- /06-design-ui/apps/movies/movies_11.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(ggplot2) 3 | library(DT) 4 | library(stringr) 5 | library(dplyr) 6 | library(tools) 7 | load("movies.Rdata") 8 | 9 | # Define UI for application that plots features of movies ----------- 10 | ui <- fluidPage( 11 | 12 | # Application title ----------------------------------------------- 13 | titlePanel("Movie browser"), 14 | 15 | # Sidebar layout with a input and output definitions -------------- 16 | sidebarLayout( 17 | 18 | # Inputs: Select variables to plot ------------------------------ 19 | sidebarPanel( 20 | 21 | # Select variable for y-axis ---------------------------------- 22 | selectInput(inputId = "y", 23 | label = "Y-axis:", 24 | choices = c("IMDB rating" = "imdb_rating", 25 | "IMDB number of votes" = "imdb_num_votes", 26 | "Critics Score" = "critics_score", 27 | "Audience Score" = "audience_score", 28 | "Runtime" = "runtime"), 29 | selected = "audience_score"), 30 | 31 | # Select variable for x-axis ---------------------------------- 32 | selectInput(inputId = "x", 33 | label = "X-axis:", 34 | choices = c("IMDB rating" = "imdb_rating", 35 | "IMDB number of votes" = "imdb_num_votes", 36 | "Critics Score" = "critics_score", 37 | "Audience Score" = "audience_score", 38 | "Runtime" = "runtime"), 39 | selected = "critics_score"), 40 | 41 | # Select variable for color ----------------------------------- 42 | selectInput(inputId = "z", 43 | label = "Color by:", 44 | choices = c("Title Type" = "title_type", 45 | "Genre" = "genre", 46 | "MPAA Rating" = "mpaa_rating", 47 | "Critics Rating" = "critics_rating", 48 | "Audience Rating" = "audience_rating"), 49 | selected = "mpaa_rating"), 50 | 51 | # Set alpha level --------------------------------------------- 52 | sliderInput(inputId = "alpha", 53 | label = "Alpha:", 54 | min = 0, max = 1, 55 | value = 0.5), 56 | 57 | # Set point size ---------------------------------------------- 58 | sliderInput(inputId = "size", 59 | label = "Size:", 60 | min = 0, max = 5, 61 | value = 2), 62 | 63 | # Enter text for plot title --------------------------------------------- 64 | textInput(inputId = "plot_title", 65 | label = "Plot title", 66 | placeholder = "Enter text to be used as plot title"), 67 | 68 | # Horizontal line for visual separation ----------------------- 69 | hr(), 70 | 71 | # Select which types of movies to plot ------------------------ 72 | checkboxGroupInput(inputId = "selected_type", 73 | label = "Select movie type(s):", 74 | choices = c("Documentary", "Feature Film", "TV Movie"), 75 | selected = "Feature Film"), 76 | 77 | # Select sample size ---------------------------------------------------- 78 | numericInput(inputId = "n_samp", 79 | label = "Sample size:", 80 | min = 1, max = nrow(movies), 81 | value = 50) 82 | ), 83 | 84 | # Output: ------------------------------------------------------- 85 | mainPanel( 86 | 87 | # Show scatterplot -------------------------------------------- 88 | plotOutput(outputId = "scatterplot"), 89 | br(), # a little bit of visual separation 90 | 91 | # Print number of obs plotted --------------------------------- 92 | uiOutput(outputId = "n"), 93 | br(), br(), # a little bit of visual separation 94 | 95 | # Show data table --------------------------------------------- 96 | DT::dataTableOutput(outputId = "moviestable") 97 | ) 98 | ) 99 | ) 100 | 101 | # Define server function required to create the scatterplot --------- 102 | server <- function(input, output) { 103 | 104 | # Create a subset of data filtering for selected title types ------ 105 | movies_subset <- reactive({ 106 | req(input$selected_type) # ensure availablity of value before proceeding 107 | filter(movies, title_type %in% input$selected_type) 108 | }) 109 | 110 | # Create new df that is n_samp obs from selected type movies ------ 111 | movies_sample <- reactive({ 112 | req(input$n_samp) # ensure availablity of value before proceeding 113 | sample_n(movies_subset(), input$n_samp) 114 | }) 115 | 116 | # Convert plot_title toTitleCase ---------------------------------- 117 | pretty_plot_title <- reactive({ toTitleCase(input$plot_title) }) 118 | 119 | # Create scatterplot object the plotOutput function is expecting -- 120 | output$scatterplot <- renderPlot({ 121 | ggplot(data = movies_sample(), aes_string(x = input$x, y = input$y, 122 | color = input$z)) + 123 | geom_point(alpha = input$alpha, size = input$size) + 124 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 125 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 126 | color = toTitleCase(str_replace_all(input$z, "_", " ")), 127 | title = pretty_plot_title() 128 | ) 129 | }) 130 | 131 | # Print number of movies plotted ---------------------------------- 132 | output$n <- renderUI({ 133 | types <- movies_sample()$title_type %>% 134 | factor(levels = input$selected_type) 135 | counts <- table(types) 136 | 137 | HTML(paste("There are", counts, input$selected_type, "movies in this dataset.
")) 138 | }) 139 | 140 | # Print data table if checked ------------------------------------- 141 | output$moviestable <- DT::renderDataTable({ 142 | DT::datatable(data = movies_sample()[, 1:7], 143 | options = list(pageLength = 10), 144 | rownames = FALSE) 145 | }) 146 | } 147 | 148 | # Run the application ----------------------------------------------- 149 | shinyApp(ui = ui, server = server) 150 | -------------------------------------------------------------------------------- /07-dashboards/07-dashboards.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/07-dashboards/07-dashboards.key -------------------------------------------------------------------------------- /07-dashboards/07-dashboards.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/07-dashboards/07-dashboards.pdf -------------------------------------------------------------------------------- /07-dashboards/apps/dashboard/flexdashboard_01.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "flexdashboard + shiny" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: columns 6 | vertical_layout: fill 7 | runtime: shiny 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | library(flexdashboard) 12 | library(tidyverse) 13 | ``` 14 | 15 | Column {data-width=650} 16 | ----------------------------------------------------------------------- 17 | 18 | ### Scatterplot of weight and miles per gallon 19 | 20 | ```{r} 21 | mpg_subset <- reactive({ 22 | mtcars %>% 23 | filter( 24 | hp >= input$hp[1], 25 | hp <= input$hp[2], 26 | cyl %in% input$cyl 27 | ) 28 | }) 29 | 30 | renderPlot({ 31 | ggplot(mpg_subset(), aes(x = wt, y = mpg, color = factor(cyl))) + 32 | geom_point() 33 | }) 34 | ``` 35 | 36 | Column {data-width=350} 37 | ----------------------------------------------------------------------- 38 | 39 | ### Inputs 40 | 41 | ```{r} 42 | checkboxGroupInput("cyl", "Cylinders", choices = c("4", "6", "8"), 43 | selected = c("4", "6", "8"), inline = TRUE 44 | ) 45 | 46 | sliderInput("hp", "Horsepower", 47 | min = min(mtcars$hp), max = max(mtcars$hp), 48 | value = range(mtcars$hp) 49 | ) 50 | ``` 51 | 52 | ### Histogram of weight 53 | 54 | ```{r} 55 | renderPlot({ 56 | 57 | ggplot(mpg_subset(), aes(x = wt)) + 58 | geom_histogram(binwidth = 0.25) 59 | 60 | }) 61 | ``` 62 | -------------------------------------------------------------------------------- /07-dashboards/apps/dashboard/flexdashboard_02.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "flexdashboard + shiny" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: columns 6 | vertical_layout: fill 7 | runtime: shiny 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | library(flexdashboard) 12 | library(tidyverse) 13 | ``` 14 | 15 | Column {data-width=650} 16 | ----------------------------------------------------------------------- 17 | 18 | ### Scatterplot of weight and miles per gallon 19 | 20 | ```{r} 21 | mpg_subset <- reactive({ 22 | mtcars %>% 23 | filter( 24 | hp >= input$hp[1], 25 | hp <= input$hp[2], 26 | cyl %in% input$cyl 27 | ) 28 | }) 29 | 30 | renderPlot({ 31 | ggplot(mpg_subset(), aes(x = wt, y = mpg, color = factor(cyl))) + 32 | geom_point() 33 | }) 34 | ``` 35 | 36 | Column {data-width=350} 37 | ----------------------------------------------------------------------- 38 | 39 | ### Inputs 40 | 41 | ```{r} 42 | checkboxGroupInput("cyl", "Cylinders", choices = c("4", "6", "8"), 43 | selected = c("4", "6", "8"), inline = TRUE 44 | ) 45 | 46 | sliderInput("hp", "Horsepower", 47 | min = min(mtcars$hp), max = max(mtcars$hp), 48 | value = range(mtcars$hp) 49 | ) 50 | 51 | radioButtons("plot_type", "Weight plot type", 52 | choices = c("Histogram", "Violin plot"), selected = c("Histogram")) 53 | ``` 54 | 55 | ### Histogram of weight 56 | 57 | ```{r} 58 | renderPlot({ 59 | 60 | if(input$plot_type == "Histogram"){ 61 | ggplot(mpg_subset(), aes(x = wt)) + 62 | geom_histogram(binwidth = 0.25) + 63 | coord_cartesian(xlim = range(mtcars$wt)) 64 | } 65 | else { 66 | ggplot(mpg_subset(), aes(y = wt, x = factor(1))) + 67 | geom_violin() 68 | } 69 | 70 | }) 71 | ``` 72 | 73 | -------------------------------------------------------------------------------- /07-dashboards/apps/dashboard/movies.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/07-dashboards/apps/dashboard/movies.Rdata -------------------------------------------------------------------------------- /08-more-react/08-more-react.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/08-more-react/08-more-react.key -------------------------------------------------------------------------------- /08-more-react/08-more-react.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/08-more-react/08-more-react.pdf -------------------------------------------------------------------------------- /08-more-react/movies.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/08-more-react/movies.Rdata -------------------------------------------------------------------------------- /08-more-react/movies_11.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(ggplot2) 3 | library(DT) 4 | library(stringr) 5 | library(dplyr) 6 | library(tools) 7 | load("movies.Rdata") 8 | 9 | # Define UI for application that plots features of movies ----------- 10 | ui <- fluidPage( 11 | 12 | # Application title ----------------------------------------------- 13 | titlePanel("Movie browser"), 14 | 15 | # Sidebar layout with a input and output definitions -------------- 16 | sidebarLayout( 17 | 18 | # Inputs: Select variables to plot ------------------------------ 19 | sidebarPanel( 20 | 21 | # Select variable for y-axis ---------------------------------- 22 | selectInput(inputId = "y", 23 | label = "Y-axis:", 24 | choices = c("IMDB rating" = "imdb_rating", 25 | "IMDB number of votes" = "imdb_num_votes", 26 | "Critics Score" = "critics_score", 27 | "Audience Score" = "audience_score", 28 | "Runtime" = "runtime"), 29 | selected = "audience_score"), 30 | 31 | # Select variable for x-axis ---------------------------------- 32 | selectInput(inputId = "x", 33 | label = "X-axis:", 34 | choices = c("IMDB rating" = "imdb_rating", 35 | "IMDB number of votes" = "imdb_num_votes", 36 | "Critics Score" = "critics_score", 37 | "Audience Score" = "audience_score", 38 | "Runtime" = "runtime"), 39 | selected = "critics_score"), 40 | 41 | # Select variable for color ----------------------------------- 42 | selectInput(inputId = "z", 43 | label = "Color by:", 44 | choices = c("Title Type" = "title_type", 45 | "Genre" = "genre", 46 | "MPAA Rating" = "mpaa_rating", 47 | "Critics Rating" = "critics_rating", 48 | "Audience Rating" = "audience_rating"), 49 | selected = "mpaa_rating"), 50 | 51 | # Set alpha level --------------------------------------------- 52 | sliderInput(inputId = "alpha", 53 | label = "Alpha:", 54 | min = 0, max = 1, 55 | value = 0.5), 56 | 57 | # Set point size ---------------------------------------------- 58 | sliderInput(inputId = "size", 59 | label = "Size:", 60 | min = 0, max = 5, 61 | value = 2), 62 | 63 | # Enter text for plot title --------------------------------------------- 64 | textInput(inputId = "plot_title", 65 | label = "Plot title", 66 | placeholder = "Enter text to be used as plot title"), 67 | 68 | # Horizontal line for visual separation ----------------------- 69 | hr(), 70 | 71 | # Select which types of movies to plot ------------------------ 72 | checkboxGroupInput(inputId = "selected_type", 73 | label = "Select movie type(s):", 74 | choices = c("Documentary", "Feature Film", "TV Movie"), 75 | selected = "Feature Film"), 76 | 77 | # Select sample size ---------------------------------------------------- 78 | numericInput(inputId = "n_samp", 79 | label = "Sample size:", 80 | min = 1, max = nrow(movies), 81 | value = 50) 82 | ), 83 | 84 | # Output: ------------------------------------------------------- 85 | mainPanel( 86 | 87 | # Show scatterplot -------------------------------------------- 88 | plotOutput(outputId = "scatterplot"), 89 | br(), # a little bit of visual separation 90 | 91 | # Print number of obs plotted --------------------------------- 92 | uiOutput(outputId = "n"), 93 | br(), br(), # a little bit of visual separation 94 | 95 | # Show data table --------------------------------------------- 96 | DT::dataTableOutput(outputId = "moviestable") 97 | ) 98 | ) 99 | ) 100 | 101 | # Define server function required to create the scatterplot --------- 102 | server <- function(input, output) { 103 | 104 | # Create a subset of data filtering for selected title types ------ 105 | movies_subset <- reactive({ 106 | req(input$selected_type) # ensure availablity of value before proceeding 107 | filter(movies, title_type %in% input$selected_type) 108 | }) 109 | 110 | # Create new df that is n_samp obs from selected type movies ------ 111 | movies_sample <- reactive({ 112 | req(input$n_samp) # ensure availablity of value before proceeding 113 | sample_n(movies_subset(), input$n_samp) 114 | }) 115 | 116 | # Convert plot_title toTitleCase ---------------------------------- 117 | pretty_plot_title <- reactive({ toTitleCase(input$plot_title) }) 118 | 119 | # Create scatterplot object the plotOutput function is expecting -- 120 | output$scatterplot <- renderPlot({ 121 | ggplot(data = movies_sample(), aes_string(x = input$x, y = input$y, 122 | color = input$z)) + 123 | geom_point(alpha = input$alpha, size = input$size) + 124 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 125 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 126 | color = toTitleCase(str_replace_all(input$z, "_", " ")), 127 | title = isolate({ pretty_plot_title() }) 128 | ) 129 | }) 130 | 131 | # Print number of movies plotted ---------------------------------- 132 | output$n <- renderUI({ 133 | types <- movies_sample()$title_type %>% 134 | factor(levels = input$selected_type) 135 | counts <- table(types) 136 | 137 | HTML(paste("There are", counts, input$selected_type, "movies in this dataset.
")) 138 | }) 139 | 140 | # Print data table if checked ------------------------------------- 141 | output$moviestable <- DT::renderDataTable({ 142 | DT::datatable(data = movies_sample()[, 1:7], 143 | options = list(pageLength = 10), 144 | rownames = FALSE) 145 | }) 146 | } 147 | 148 | # Run the application ----------------------------------------------- 149 | shinyApp(ui = ui, server = server) 150 | -------------------------------------------------------------------------------- /08-more-react/movies_12.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(ggplot2) 3 | library(DT) 4 | library(stringr) 5 | library(dplyr) 6 | library(tools) 7 | load("movies.Rdata") 8 | 9 | # Define UI for application that plots features of movies ----------- 10 | ui <- fluidPage( 11 | 12 | # Application title ----------------------------------------------- 13 | titlePanel("Movie browser"), 14 | 15 | # Sidebar layout with a input and output definitions -------------- 16 | sidebarLayout( 17 | 18 | # Inputs: Select variables to plot ------------------------------ 19 | sidebarPanel( 20 | 21 | # Select variable for y-axis ---------------------------------- 22 | selectInput(inputId = "y", 23 | label = "Y-axis:", 24 | choices = c("IMDB rating" = "imdb_rating", 25 | "IMDB number of votes" = "imdb_num_votes", 26 | "Critics Score" = "critics_score", 27 | "Audience Score" = "audience_score", 28 | "Runtime" = "runtime"), 29 | selected = "audience_score"), 30 | 31 | # Select variable for x-axis ---------------------------------- 32 | selectInput(inputId = "x", 33 | label = "X-axis:", 34 | choices = c("IMDB rating" = "imdb_rating", 35 | "IMDB number of votes" = "imdb_num_votes", 36 | "Critics Score" = "critics_score", 37 | "Audience Score" = "audience_score", 38 | "Runtime" = "runtime"), 39 | selected = "critics_score"), 40 | 41 | # Select variable for color ----------------------------------- 42 | selectInput(inputId = "z", 43 | label = "Color by:", 44 | choices = c("Title Type" = "title_type", 45 | "Genre" = "genre", 46 | "MPAA Rating" = "mpaa_rating", 47 | "Critics Rating" = "critics_rating", 48 | "Audience Rating" = "audience_rating"), 49 | selected = "mpaa_rating"), 50 | 51 | # Set alpha level --------------------------------------------- 52 | sliderInput(inputId = "alpha", 53 | label = "Alpha:", 54 | min = 0, max = 1, 55 | value = 0.5), 56 | 57 | # Set point size ---------------------------------------------- 58 | sliderInput(inputId = "size", 59 | label = "Size:", 60 | min = 0, max = 5, 61 | value = 2), 62 | 63 | # Show data table --------------------------------------------- 64 | checkboxInput(inputId = "show_data", 65 | label = "Show data table", 66 | value = TRUE), 67 | 68 | # Enter text for plot title --------------------------------------------- 69 | textInput(inputId = "plot_title", 70 | label = "Plot title", 71 | placeholder = "Enter text to be used as plot title"), 72 | 73 | # Horizontal line for visual separation ----------------------- 74 | hr(), 75 | 76 | # Select which types of movies to plot ------------------------ 77 | checkboxGroupInput(inputId = "selected_type", 78 | label = "Select movie type(s):", 79 | choices = c("Documentary", "Feature Film", "TV Movie"), 80 | selected = "Feature Film"), 81 | 82 | # Select sample size ---------------------------------------------------- 83 | numericInput(inputId = "n_samp", 84 | label = "Sample size:", 85 | min = 1, max = nrow(movies), 86 | value = 50), 87 | 88 | # Get a new sample ------------------------------------------------------ 89 | actionButton(inputId = "get_new_sample", 90 | label = "Get new sample"), 91 | 92 | # A little bit of visual separation ------------------------------------- 93 | br(), br(), 94 | 95 | # Write sampled data as csv ------------------------------------------ 96 | actionButton(inputId = "write_csv", 97 | label = "Write CSV") 98 | 99 | ), 100 | 101 | # Output: ------------------------------------------------------- 102 | mainPanel( 103 | 104 | # Print how long app is being viewed for ---------------------- 105 | textOutput(outputId = "time_elapsed"), 106 | br(), 107 | 108 | # Show scatterplot -------------------------------------------- 109 | plotOutput(outputId = "scatterplot"), 110 | br(), # a little bit of visual separation 111 | 112 | # Print number of obs plotted --------------------------------- 113 | uiOutput(outputId = "n"), 114 | br(), br(), # a little bit of visual separation 115 | 116 | # Show data table --------------------------------------------- 117 | DT::dataTableOutput(outputId = "moviestable") 118 | ) 119 | ) 120 | ) 121 | 122 | # Define server function required to create the scatterplot --------- 123 | server <- function(input, output, session) { 124 | 125 | # Create a subset of data filtering for selected title types ------ 126 | movies_subset <- reactive({ 127 | req(input$selected_type) # ensure availablity of value before proceeding 128 | filter(movies, title_type %in% input$selected_type) 129 | }) 130 | 131 | # Update the maximum allowed n_samp for selected type movies ------ 132 | observe({ 133 | updateNumericInput(session, 134 | inputId = "n_samp", 135 | value = min(50, nrow(movies_subset())), 136 | max = nrow(movies_subset()) 137 | ) 138 | }) 139 | 140 | # Get new sample -------------------------------------------------- 141 | movies_sample <- eventReactive(eventExpr = input$get_new_sample, 142 | valueExpr = { 143 | req(input$n_samp) 144 | sample_n(movies_subset(), input$n_samp) 145 | }, 146 | ignoreNULL = FALSE 147 | ) 148 | 149 | # Convert plot_title toTitleCase ---------------------------------- 150 | pretty_plot_title <- reactive({ toTitleCase(input$plot_title) }) 151 | 152 | # Create scatterplot object the plotOutput function is expecting -- 153 | output$scatterplot <- renderPlot({ 154 | ggplot(data = movies_sample(), aes_string(x = input$x, y = input$y, 155 | color = input$z)) + 156 | geom_point(alpha = input$alpha, size = input$size) + 157 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 158 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 159 | color = toTitleCase(str_replace_all(input$z, "_", " ")), 160 | title = isolate({ pretty_plot_title() }) 161 | ) 162 | }) 163 | 164 | # Print number of movies plotted ---------------------------------- 165 | output$n <- renderUI({ 166 | types <- movies_sample()$title_type %>% 167 | factor(levels = input$selected_type) 168 | counts <- table(types) 169 | 170 | HTML(paste("There are", counts, input$selected_type, "movies in this dataset.
")) 171 | }) 172 | 173 | # Print data table if checked ------------------------------------- 174 | output$moviestable <- DT::renderDataTable( 175 | if(input$show_data){ 176 | DT::datatable(data = movies_sample()[, 1:7], 177 | options = list(pageLength = 10), 178 | rownames = FALSE) 179 | } 180 | ) 181 | 182 | # Write sampled data as csv --------------------------------------- 183 | observeEvent(eventExpr = input$write_csv, 184 | handlerExpr = { 185 | filename <- paste0("movies_", str_replace_all(Sys.time(), ":|\ ", "_"), ".csv") 186 | write.csv(movies_sample(), file = filename, row.names = FALSE) 187 | } 188 | ) 189 | 190 | # Calculate time diff bet when app is first launched and now ------ 191 | beg <- Sys.time() 192 | now <- reactive({ invalidateLater(millis = 1000); Sys.time() }) 193 | diff <- reactive({ round(difftime(now(), beg, units = "secs")) }) 194 | 195 | # Print time viewing app ------------------------------------------ 196 | output$time_elapsed <- renderText({ 197 | paste("You have been viewing this app for", diff(), "seconds.") 198 | }) 199 | 200 | } 201 | 202 | # Run the app ------------------------------------------------------- 203 | shinyApp(ui = ui, server = server) 204 | -------------------------------------------------------------------------------- /08-more-react/movies_13.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(ggplot2) 3 | library(DT) 4 | library(stringr) 5 | library(dplyr) 6 | library(tools) 7 | load("movies.Rdata") 8 | 9 | # Define UI for application that plots features of movies ----------- 10 | ui <- fluidPage( 11 | 12 | # Application title ----------------------------------------------- 13 | titlePanel("Movie browser"), 14 | 15 | # Sidebar layout with a input and output definitions -------------- 16 | sidebarLayout( 17 | 18 | # Inputs: Select variables to plot ------------------------------ 19 | sidebarPanel( 20 | 21 | # Select variable for y-axis ---------------------------------- 22 | selectInput(inputId = "y", 23 | label = "Y-axis:", 24 | choices = c("IMDB rating" = "imdb_rating", 25 | "IMDB number of votes" = "imdb_num_votes", 26 | "Critics Score" = "critics_score", 27 | "Audience Score" = "audience_score", 28 | "Runtime" = "runtime"), 29 | selected = "audience_score"), 30 | 31 | # Select variable for x-axis ---------------------------------- 32 | selectInput(inputId = "x", 33 | label = "X-axis:", 34 | choices = c("IMDB rating" = "imdb_rating", 35 | "IMDB number of votes" = "imdb_num_votes", 36 | "Critics Score" = "critics_score", 37 | "Audience Score" = "audience_score", 38 | "Runtime" = "runtime"), 39 | selected = "critics_score"), 40 | 41 | # Select variable for color ----------------------------------- 42 | selectInput(inputId = "z", 43 | label = "Color by:", 44 | choices = c("Title Type" = "title_type", 45 | "Genre" = "genre", 46 | "MPAA Rating" = "mpaa_rating", 47 | "Critics Rating" = "critics_rating", 48 | "Audience Rating" = "audience_rating"), 49 | selected = "mpaa_rating"), 50 | 51 | # Set alpha level --------------------------------------------- 52 | sliderInput(inputId = "alpha", 53 | label = "Alpha:", 54 | min = 0, max = 1, 55 | value = 0.5), 56 | 57 | # Set point size ---------------------------------------------- 58 | sliderInput(inputId = "size", 59 | label = "Size:", 60 | min = 0, max = 5, 61 | value = 2), 62 | 63 | # Show data table --------------------------------------------- 64 | checkboxInput(inputId = "show_data", 65 | label = "Show data table", 66 | value = TRUE), 67 | 68 | # Enter text for plot title --------------------------------------------- 69 | textInput(inputId = "plot_title", 70 | label = "Plot title", 71 | placeholder = "Enter text to be used as plot title"), 72 | 73 | # Horizontal line for visual separation ----------------------- 74 | hr(), 75 | 76 | # Select which types of movies to plot ------------------------ 77 | checkboxGroupInput(inputId = "selected_type", 78 | label = "Select movie type(s):", 79 | choices = c("Documentary", "Feature Film", "TV Movie"), 80 | selected = "Feature Film"), 81 | 82 | # Select sample size ---------------------------------------------------- 83 | numericInput(inputId = "n_samp", 84 | label = "Sample size:", 85 | min = 1, max = nrow(movies), 86 | value = 50), 87 | 88 | # A little bit of visual separation ------------------------------------- 89 | br(), br(), 90 | 91 | # Write sampled data as csv ------------------------------------------ 92 | actionButton(inputId = "write_csv", 93 | label = "Write CSV") 94 | 95 | ), 96 | 97 | # Output: ------------------------------------------------------- 98 | mainPanel( 99 | 100 | # Print how long app is being viewed for ---------------------- 101 | textOutput(outputId = "time_elapsed"), 102 | br(), 103 | 104 | # Show scatterplot -------------------------------------------- 105 | plotOutput(outputId = "scatterplot"), 106 | br(), # a little bit of visual separation 107 | 108 | # Print number of obs plotted --------------------------------- 109 | uiOutput(outputId = "n"), 110 | br(), br(), # a little bit of visual separation 111 | 112 | # Show data table --------------------------------------------- 113 | DT::dataTableOutput(outputId = "moviestable") 114 | ) 115 | ) 116 | ) 117 | 118 | # Define server function required to create the scatterplot --------- 119 | server <- function(input, output, session) { 120 | 121 | # Create a subset of data filtering for selected title types ------ 122 | movies_subset <- reactive({ 123 | req(input$selected_type) # ensure availablity of value before proceeding 124 | filter(movies, title_type %in% input$selected_type) 125 | }) 126 | 127 | # Update the maximum allowed n_samp for selected type movies ------ 128 | observe({ 129 | updateNumericInput(session, 130 | inputId = "n_samp", 131 | value = min(50, nrow(movies_subset())), 132 | max = nrow(movies_subset()) 133 | ) 134 | }) 135 | 136 | # Get new sample every 5 seconds ---------------------------------- 137 | movies_sample <- reactive({ invalidateLater(millis = 5000) 138 | req(input$n_samp) 139 | sample_n(movies_subset(), input$n_samp) 140 | }) 141 | 142 | # Convert plot_title toTitleCase ---------------------------------- 143 | pretty_plot_title <- reactive({ toTitleCase(input$plot_title) }) 144 | 145 | # Create scatterplot object the plotOutput function is expecting -- 146 | output$scatterplot <- renderPlot({ 147 | ggplot(data = movies_sample(), aes_string(x = input$x, y = input$y, 148 | color = input$z)) + 149 | geom_point(alpha = input$alpha, size = input$size) + 150 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 151 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 152 | color = toTitleCase(str_replace_all(input$z, "_", " ")), 153 | title = isolate({ pretty_plot_title() }) 154 | ) 155 | }) 156 | 157 | # Print number of movies plotted ---------------------------------- 158 | output$n <- renderUI({ 159 | types <- movies_sample()$title_type %>% 160 | factor(levels = input$selected_type) 161 | counts <- table(types) 162 | 163 | HTML(paste("There are", counts, input$selected_type, "movies in this dataset.
")) 164 | }) 165 | 166 | # Print data table if checked ------------------------------------- 167 | output$moviestable <- DT::renderDataTable( 168 | if(input$show_data){ 169 | DT::datatable(data = movies_sample()[, 1:7], 170 | options = list(pageLength = 10), 171 | rownames = FALSE) 172 | } 173 | ) 174 | 175 | # Write sampled data as csv --------------------------------------- 176 | observeEvent(eventExpr = input$write_csv, 177 | handlerExpr = { 178 | filename <- paste0("movies_", str_replace_all(Sys.time(), ":|\ ", "_"), ".csv") 179 | write.csv(movies_sample(), file = filename, row.names = FALSE) 180 | } 181 | ) 182 | 183 | # Calculate time diff bet when app is first launched and now ------ 184 | beg <- Sys.time() 185 | now <- reactive({ invalidateLater(millis = 1000); Sys.time() }) 186 | diff <- reactive({ round(difftime(now(), beg, units = "secs")) }) 187 | 188 | # Print time viewing app ------------------------------------------ 189 | output$time_elapsed <- renderText({ 190 | paste("You have been viewing this app for", diff(), "seconds.") 191 | }) 192 | 193 | } 194 | 195 | # Run the app ------------------------------------------------------- 196 | shinyApp(ui = ui, server = server) 197 | -------------------------------------------------------------------------------- /08-more-react/movies_14.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(ggplot2) 3 | library(DT) 4 | library(stringr) 5 | library(dplyr) 6 | library(tools) 7 | load("movies.Rdata") 8 | 9 | # Define UI for application that plots features of movies ----------- 10 | ui <- fluidPage( 11 | 12 | # Application title ----------------------------------------------- 13 | titlePanel("Movie browser"), 14 | 15 | # Sidebar layout with a input and output definitions -------------- 16 | sidebarLayout( 17 | 18 | # Inputs: Select variables to plot ------------------------------ 19 | sidebarPanel( 20 | 21 | # Select variable for y-axis ---------------------------------- 22 | selectInput(inputId = "y", 23 | label = "Y-axis:", 24 | choices = c("IMDB rating" = "imdb_rating", 25 | "IMDB number of votes" = "imdb_num_votes", 26 | "Critics Score" = "critics_score", 27 | "Audience Score" = "audience_score", 28 | "Runtime" = "runtime"), 29 | selected = "audience_score"), 30 | 31 | # Select variable for x-axis ---------------------------------- 32 | selectInput(inputId = "x", 33 | label = "X-axis:", 34 | choices = c("IMDB rating" = "imdb_rating", 35 | "IMDB number of votes" = "imdb_num_votes", 36 | "Critics Score" = "critics_score", 37 | "Audience Score" = "audience_score", 38 | "Runtime" = "runtime"), 39 | selected = "critics_score"), 40 | 41 | # Select variable for color ----------------------------------- 42 | selectInput(inputId = "z", 43 | label = "Color by:", 44 | choices = c("Title Type" = "title_type", 45 | "Genre" = "genre", 46 | "MPAA Rating" = "mpaa_rating", 47 | "Critics Rating" = "critics_rating", 48 | "Audience Rating" = "audience_rating"), 49 | selected = "mpaa_rating"), 50 | 51 | # Set alpha level --------------------------------------------- 52 | sliderInput(inputId = "alpha", 53 | label = "Alpha:", 54 | min = 0, max = 1, 55 | value = 0.5), 56 | 57 | # Set point size ---------------------------------------------- 58 | sliderInput(inputId = "size", 59 | label = "Size:", 60 | min = 0, max = 5, 61 | value = 2), 62 | 63 | # Show data table --------------------------------------------- 64 | checkboxInput(inputId = "show_data", 65 | label = "Show data table", 66 | value = TRUE), 67 | 68 | # Enter text for plot title --------------------------------------------- 69 | textInput(inputId = "plot_title", 70 | label = "Plot title", 71 | placeholder = "Enter text to be used as plot title"), 72 | 73 | # Horizontal line for visual separation ----------------------- 74 | hr(), 75 | 76 | # Select which types of movies to plot ------------------------ 77 | checkboxGroupInput(inputId = "selected_type", 78 | label = "Select movie type(s):", 79 | choices = c("Documentary", "Feature Film", "TV Movie"), 80 | selected = "Feature Film"), 81 | 82 | # Select sample size ---------------------------------------------------- 83 | numericInput(inputId = "n_samp", 84 | label = "Sample size:", 85 | min = 1, max = nrow(movies), 86 | value = 50), 87 | 88 | # A little bit of visual separation ------------------------------------- 89 | br(), br(), 90 | 91 | # Write sampled data as csv ------------------------------------------ 92 | actionButton(inputId = "write_csv", 93 | label = "Write CSV") 94 | 95 | ), 96 | 97 | # Output: ------------------------------------------------------- 98 | mainPanel( 99 | 100 | # Print how long app is being viewed for ---------------------- 101 | textOutput(outputId = "time_elapsed"), 102 | br(), 103 | 104 | # Show scatterplot -------------------------------------------- 105 | plotOutput(outputId = "scatterplot"), 106 | br(), # a little bit of visual separation 107 | 108 | # Print number of obs plotted --------------------------------- 109 | uiOutput(outputId = "n"), 110 | br(), br(), # a little bit of visual separation 111 | 112 | # Use tabs for the data tables to reduce clutter ------------------------ 113 | tabsetPanel( 114 | # Show data table ----------------------------------------------------- 115 | tabPanel("Plotted data", DT::dataTableOutput(outputId = "moviestable")), 116 | 117 | # Show CSV files in directory ----------------------------------------- 118 | tabPanel("Files in directory", DT::dataTableOutput(outputId = "csv_files")) 119 | ) 120 | 121 | ) 122 | ) 123 | ) 124 | 125 | # Define server function required to create the scatterplot --------- 126 | server <- function(input, output, session) { 127 | 128 | # Create a subset of data filtering for selected title types ------ 129 | movies_subset <- reactive({ 130 | req(input$selected_type) # ensure availablity of value before proceeding 131 | filter(movies, title_type %in% input$selected_type) 132 | }) 133 | 134 | # Update the maximum allowed n_samp for selected type movies ------ 135 | observe({ 136 | updateNumericInput(session, 137 | inputId = "n_samp", 138 | value = min(50, nrow(movies_subset())), 139 | max = nrow(movies_subset()) 140 | ) 141 | }) 142 | 143 | # Get new sample every 5 seconds ---------------------------------- 144 | movies_sample <- reactive({ invalidateLater(millis = 5000) 145 | req(input$n_samp) 146 | sample_n(movies_subset(), input$n_samp) 147 | }) 148 | 149 | # Convert plot_title toTitleCase ---------------------------------- 150 | pretty_plot_title <- reactive({ toTitleCase(input$plot_title) }) 151 | 152 | # Create scatterplot object the plotOutput function is expecting -- 153 | output$scatterplot <- renderPlot({ 154 | ggplot(data = movies_sample(), aes_string(x = input$x, y = input$y, 155 | color = input$z)) + 156 | geom_point(alpha = input$alpha, size = input$size) + 157 | labs(x = toTitleCase(str_replace_all(input$x, "_", " ")), 158 | y = toTitleCase(str_replace_all(input$y, "_", " ")), 159 | color = toTitleCase(str_replace_all(input$z, "_", " ")), 160 | title = isolate({ pretty_plot_title() }) 161 | ) 162 | }) 163 | 164 | # Print number of movies plotted ---------------------------------- 165 | output$n <- renderUI({ 166 | types <- movies_sample()$title_type %>% 167 | factor(levels = input$selected_type) 168 | counts <- table(types) 169 | 170 | HTML(paste("There are", counts, input$selected_type, "movies in this dataset.
")) 171 | }) 172 | 173 | # Print data table if checked ------------------------------------- 174 | output$moviestable <- DT::renderDataTable( 175 | if(input$show_data){ 176 | DT::datatable(data = movies_sample()[, 1:7], 177 | options = list(pageLength = 10), 178 | rownames = FALSE) 179 | } 180 | ) 181 | 182 | # Write sampled data as csv --------------------------------------- 183 | observeEvent(eventExpr = input$write_csv, 184 | handlerExpr = { 185 | filename <- paste0("movies_", str_replace_all(Sys.time(), ":|\ ", "_"), ".csv") 186 | write.csv(movies_sample(), file = filename, row.names = FALSE) 187 | } 188 | ) 189 | 190 | # Calculate time diff bet when app is first launched and now ------ 191 | beg <- Sys.time() 192 | now <- reactive({ invalidateLater(millis = 1000); Sys.time() }) 193 | diff <- reactive({ round(difftime(now(), beg, units = "secs")) }) 194 | 195 | # Print time viewing app ------------------------------------------ 196 | output$time_elapsed <- renderText({ 197 | paste("You have been viewing this app for", diff(), "seconds.") 198 | }) 199 | 200 | # Helper funs to count and list CSV files in the directory ------------------ 201 | 202 | # Check function 203 | count_files <- function(){ length(dir(pattern = "*.csv")) } 204 | 205 | # Value retrieval function 206 | list_files <- function(){ 207 | files <- dir(pattern = "*.csv") 208 | if(length(files) == 0){ return( data.frame() ) } 209 | sapply(files, function(file) dim(read.csv(file))) %>% 210 | unlist() %>% 211 | t() %>% 212 | as.data.frame() %>% 213 | setNames(c("rows", "cols")) 214 | } 215 | 216 | # Count and list CSV files in the directory every 5 seconds ----------------- 217 | csv_files <- reactivePoll(intervalMillis = 5000, 218 | session, 219 | checkFunc = count_files, 220 | valueFunc = list_files) 221 | 222 | # Print CSV files in the directory ------------------------------------------ 223 | output$csv_files <- DT::renderDataTable( 224 | DT::datatable(data = csv_files(), 225 | options = list(pageLength = 10), 226 | rownames = TRUE) 227 | ) 228 | 229 | } 230 | 231 | # Run the app ------------------------------------------------------- 232 | shinyApp(ui = ui, server = server) 233 | -------------------------------------------------------------------------------- /09-wrap-up/09-wrap-up.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/09-wrap-up/09-wrap-up.key -------------------------------------------------------------------------------- /09-wrap-up/09-wrap-up.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dtkaplan/shinymark/bab70cc0b50951183c3b468dd4a7eeb1af2e851c/09-wrap-up/09-wrap-up.pdf -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # shinymark 2 | 3 | Materials for the *Introduction to Shiny and R Markdown* workshop at rstudio::conf 2019 4 | 5 | --- 6 | 7 | ## Locating the materials 8 | 9 | * Option 1 - :cloud: RStudio Cloud: [bit.ly/shinymark](https://bit.ly/shinymark) 10 | 11 | - If you do not already have an RStudio.cloud account, you will be prompted to login via Google or create a new account. 12 | - When you are 13 | 14 | * Option 2 - :computer: Local installation: [github.com/dtkaplan/shinymark](https://github.com/dtkaplan/shinymark) 15 | 16 | --- 17 | 18 | ## Outline 19 | 20 | ### Day 1: January 15, 2019 21 | 22 | #### :computer: 09:00 - 10:30: Session 1 - Getting started with Markdown 23 | - 00 - [Welcome](00-welcome/00-welcome.pdf) Getting started instructions + motivation + demo 24 | - 01 - Composing prose with Markdown: 25 | - Text and headers 26 | - Links and images 27 | - Math text 28 | - Tables 29 | - The Markdown Quick Reference 30 | - Your turn: From plain text to embellished 31 | 32 | #### :coffee: 10:30 - 11:00: Morning break 33 | 34 | #### :computer: 11:00 - 12:30: Session 2 - Putting the R in R Markdown 35 | - 02 - Putting the R in R Markdown: 36 | - Embedding R code -- in chunks and inline 37 | - Chunk and global options 38 | - Other languages 39 | - Output options 40 | - Output formats 41 | - Your turn: Restructure from plain R Markdown to xaringan slides or Tufte document 42 | 43 | #### :fork_and_knife: 12:30 - 14:00: Lunch 44 | 45 | #### :computer: 14:00 - 15:00: Session 3 - Upping your R Markdown game 46 | - Tables 47 | - Parameterized reports 48 | - Bibliography and citation 49 | - Templates 50 | 51 | #### :coffee: 15:00 - 15:30: Afternoon break 52 | 53 | #### :computer: 15:30 - 17:00: Session 4 - First dip into interactivity 54 | - Slides: `03B-interactivity-on-the-cheap.key` 55 | - Embedding htmlwidgets in R Markdown documents 56 | - Dashboards 57 | - First practice with shiny widgets. Use `runtime: shiny` 58 | 59 | 60 | ### Day 2: January 16, 2019 61 | 62 | The activities will be based on files in the `apps/` directory. Each file includes a suffix like `_01`, `_02`, .... 63 | 64 | - Start by opening the `_01` file. Edit that to complete the activity. 65 | - In the follow-up exercises, you can keep on going with the file you started with, *or* if you get lost ... 66 | - Open up the next file (e.g. `_02`) so that you have a working document for the next activity. 67 | 68 | #### :computer: 09:00 - 10:30: Session 1 - Getting started with Shiny 69 | - 04 - Getting started with Shiny: 70 | - High level view 71 | - Anatomy of a Shiny app 72 | - UI / Server 73 | - File structure 74 | - Deploying an app 75 | 76 | #### :coffee: 10:30 - 11:00: Morning break 77 | 78 | #### :computer: 11:00 - 12:30: Session 2 - Understanding reactivity 79 | - 05 - Understanding reactivity: 80 | - Reactivity 101 81 | - Reactive flow 82 | - Implementation 83 | - Render functions 84 | 85 | #### :fork_and_knife: 12:30 - 13:30: Lunch 86 | 87 | #### :computer: 13:30 - 15:00: Session 3 - Designing UI 88 | - Interface builder functions 89 | - Tabs 90 | - shinythemes 91 | 92 | #### :coffee: 15:00 - 15:30: Afternoon break 93 | 94 | #### :computer: 15:30 - 17:00: Session 4 - Dashboards 95 | - What's in a dashboard? 96 | - flexdashboards 97 | - Where to go next? 98 | 99 | --- 100 | 101 | ## Setup instructions 102 | 103 | ### Install all packages we will need 104 | 105 | ``` 106 | from_cran <- c("shiny", "rmarkdown", 107 | "DT", "devtools", "flexdashboard", "gapminder", 108 | "rticles", "shinydashboard", "shinythemes", 109 | "tidyverse", "tufte", "xaringan") 110 | 111 | install.packages(from_cran, repos = "http://cran.rstudio.com") 112 | ``` 113 | 114 | ### Load all packages we just installed 115 | 116 | ``` 117 | lapply(from_cran, library, character.only = TRUE) 118 | ``` 119 | -------------------------------------------------------------------------------- /cond/app.R: -------------------------------------------------------------------------------- 1 | # 2 | # This is a Shiny web application. You can run the application by clicking 3 | # the 'Run App' button above. 4 | # 5 | # Find out more about building applications with Shiny here: 6 | # 7 | # http://shiny.rstudio.com/ 8 | # 9 | 10 | library(shiny) 11 | 12 | # Define UI for application that draws a histogram 13 | ui <- fluidPage( 14 | 15 | titlePanel("Conditional panels"), 16 | 17 | column(4, wellPanel( 18 | sliderInput("n", "Number of points:", 19 | min = 10, max = 200, value = 50, step = 10) 20 | )), 21 | 22 | column(5, 23 | "The plot below will be not displayed when the slider value", 24 | "is less than 50.", 25 | 26 | # With the conditionalPanel, the condition is a JavaScript 27 | # expression. In these expressions, input values like 28 | # input$n are accessed with dots, as in input.n 29 | conditionalPanel("input.n >= 50", 30 | plotOutput("scatterPlot", height = 300) 31 | ) 32 | ) 33 | ) 34 | 35 | # Define server logic required to draw a histogram 36 | server <- function(input, output) { 37 | 38 | output$scatterPlot <- renderPlot({ 39 | x <- rnorm(input$n) 40 | y <- rnorm(input$n) 41 | plot(x, y) 42 | }) 43 | 44 | } 45 | 46 | # Run the application 47 | shinyApp(ui = ui, server = server) 48 | 49 | -------------------------------------------------------------------------------- /shinymark.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | --------------------------------------------------------------------------------