├── targets ├── .gitignore ├── input_data │ ├── first.csv │ ├── second.csv │ └── third.csv ├── output_data │ └── .gitignore ├── R Targets, what’s that and why.pptx ├── R │ ├── write_csv_and_return.R │ └── get_data.R ├── data_pipeline.R ├── README.md └── _targets.R ├── shiny ├── excelReports │ ├── LICENSE │ ├── .gitignore │ ├── TestScoresDB.xlsx │ ├── inst │ │ ├── app │ │ │ └── www │ │ │ │ └── favicon.ico │ │ └── golem-config.yml │ ├── .Rbuildignore │ ├── dev │ │ ├── run_dev.R │ │ ├── 03_deploy.R │ │ ├── 01_start.R │ │ └── 02_dev.R │ ├── R │ │ ├── utils-pipe.R │ │ ├── app_server.R │ │ ├── run_app.R │ │ ├── mod_upload_data.R │ │ ├── app_config.R │ │ ├── mod_per_test.R │ │ ├── app_ui.R │ │ ├── mod_per_subject.R │ │ ├── mod_per_class.R │ │ └── mod_per_student.R │ ├── excelReports.Rproj │ ├── NAMESPACE │ ├── man │ │ ├── pipe.Rd │ │ └── run_app.Rd │ ├── DESCRIPTION │ └── LICENSE.md ├── README.md ├── building_reports_from_excel │ ├── README.md │ ├── GRASS per subject.R │ └── GRASS per test.R ├── reactive_web_scraping │ ├── README.md │ └── app.R ├── reactive_example │ ├── README.md │ └── app.R ├── github_logo │ ├── README.md │ └── app.R ├── changingSelection │ ├── readme.md │ └── app.R ├── dynamic_list_ui │ ├── app.R │ └── README.md ├── PersonPicker │ ├── PersonPickerApp.R │ └── readme.md ├── simpleGrandTour │ ├── readme.md │ └── app.R └── access_html_elements │ ├── app.R │ └── README.md ├── kh03 ├── _targets │ └── .gitignore ├── kh03.Rds ├── kh03.parquet ├── _targets.R ├── Readme.md ├── Readme.rmd └── kh03.R ├── ggplot ├── camcoder │ ├── Data │ │ ├── README.md │ │ ├── RTT_TS_data.xlsx │ │ └── AE_England_data.xls │ ├── visualizations_description.txt │ ├── README.md │ ├── Camcoder │ │ └── README.md │ ├── 00 Project folder structure.R │ ├── Group_by_example.R │ ├── 04 AandE Excel data into R from URL.R │ ├── 02 Download RTT TS data.R │ ├── 10 Density plot for AE Attendances.R │ ├── 01 Download RTT data.R │ ├── A Using Google fonts in plots.R │ ├── 14 Sparkline OECD CPI.R │ ├── 08 Attendances by type same plot.R │ ├── 13 Spaghetti plot OECD CPI 1974_2022.R │ ├── 05 Tidy up downloaded AE data.R │ ├── 03 Import Excel data into R.R │ ├── 11 Density plot Major Single AE Attendances.R │ ├── 12 Raincloud chart AE Attendances_test.R │ ├── 12 Raincloud chart AE Attendances.R │ ├── 13 01 Spaghetti plot OECD CPI 1974_2022.R │ ├── 07 AE chart facet wrap by month.R │ └── 09 Attendances by year geom_smooth.R └── median_barplot │ ├── README.md │ └── median_barplot.Rmd ├── excel_multiple_files_to_one ├── copy2.xlsx ├── copy3.xlsx ├── PD 2021 Wk 4 Input.xlsx └── multiple_excel_files_to_one.R ├── leaflet_loop ├── json │ └── gz_2010_us_050_00_500k.json ├── README.md └── leaflet.Rmd ├── ccg_mergers └── README_files │ └── figure-gfm │ └── visualise graph-1.png ├── random ├── random.R ├── README.md └── Group_Dates.R ├── child_documents ├── README.md ├── child.Rmd └── child_demo.Rmd ├── conditional_table_formatting ├── kableExtra │ ├── README.md │ └── penguin_kable.Rmd ├── README.md └── gt │ └── gt_format.Rmd ├── demos-and-how-tos.Rproj ├── rmarkdown ├── loop_rmarkdown │ ├── README.md │ ├── loop_variables.Rmd │ ├── loop_species.Rmd │ ├── run_report.R │ └── loop_tabs.Rmd ├── loop_tabs │ ├── README.md │ └── loop_tabs.Rmd ├── loop_graphs │ ├── loop_dataframe_graphs.Rmd │ └── loop_dataframe_graphs_medicaldata.Rmd └── rmarkdown_functions_and_functionals │ ├── markdown_template.rmd │ ├── readme.md │ └── script_to_run_template.R ├── NHSD_Data ├── README.md └── nhs-sickness-absence-rates.R ├── character_encoding ├── README.md └── encoding_helper.R ├── caseload_size ├── README └── test_data.R ├── example_chloropleth_ICB_map ├── readme.md └── example ICB map.Rmd ├── .gitignore ├── README.md ├── LICENSE ├── separate-codes └── separate-codes.qmd ├── recoding-na └── recoding-na.qmd ├── opcs ├── opcs_matching.R └── README.md ├── create_filter_from_logic_evaluation ├── filter_creation.R └── Readme.md ├── zip-files └── lsoa-population.Rmd ├── optim-with-rmse ├── README.md └── R │ └── make_synthetic_germany_functions.R ├── Sending_Emails └── Sending_Emails.R ├── statistics └── summary_stats.Rmd └── CODE_OF_CONDUCT.md /targets/.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | _targets 3 | .Rhistory -------------------------------------------------------------------------------- /targets/input_data/first.csv: -------------------------------------------------------------------------------- 1 | a_field, b_field 2 | 1, 2 3 | 3, 4 -------------------------------------------------------------------------------- /shiny/excelReports/LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: NHS-R 3 | -------------------------------------------------------------------------------- /targets/input_data/second.csv: -------------------------------------------------------------------------------- 1 | things, stuff 2 | a, x 3 | b, y 4 | c, z -------------------------------------------------------------------------------- /shiny/README.md: -------------------------------------------------------------------------------- 1 | # Shiny 2 | 3 | Examples based on Shiny will be added in here -------------------------------------------------------------------------------- /kh03/_targets/.gitignore: -------------------------------------------------------------------------------- 1 | * 2 | !.gitignore 3 | !meta 4 | meta/* 5 | !meta/meta 6 | -------------------------------------------------------------------------------- /targets/input_data/third.csv: -------------------------------------------------------------------------------- 1 | guns, butter 2 | 100, 50 3 | 500, 20 4 | 10000, 70000 -------------------------------------------------------------------------------- /targets/output_data/.gitignore: -------------------------------------------------------------------------------- 1 | # Ignore everything except this file 2 | * 3 | !.gitignore -------------------------------------------------------------------------------- /kh03/kh03.Rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/kh03/kh03.Rds -------------------------------------------------------------------------------- /kh03/kh03.parquet: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/kh03/kh03.parquet -------------------------------------------------------------------------------- /shiny/excelReports/.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .Rdata 4 | .httr-oauth 5 | .DS_Store 6 | -------------------------------------------------------------------------------- /ggplot/camcoder/Data/README.md: -------------------------------------------------------------------------------- 1 | This folder contains all files used in the ggplot2-visualizations project 2 | -------------------------------------------------------------------------------- /ggplot/median_barplot/README.md: -------------------------------------------------------------------------------- 1 | A simple barplot of median bill length for different penguin species 2 | -------------------------------------------------------------------------------- /ggplot/camcoder/Data/RTT_TS_data.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/ggplot/camcoder/Data/RTT_TS_data.xlsx -------------------------------------------------------------------------------- /shiny/building_reports_from_excel/README.md: -------------------------------------------------------------------------------- 1 | 2 | ## Building reports from Excel 3 | 4 | This code builds a dataset from several Excel files -------------------------------------------------------------------------------- /shiny/excelReports/TestScoresDB.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/shiny/excelReports/TestScoresDB.xlsx -------------------------------------------------------------------------------- /excel_multiple_files_to_one/copy2.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/excel_multiple_files_to_one/copy2.xlsx -------------------------------------------------------------------------------- /excel_multiple_files_to_one/copy3.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/excel_multiple_files_to_one/copy3.xlsx -------------------------------------------------------------------------------- /ggplot/camcoder/Data/AE_England_data.xls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/ggplot/camcoder/Data/AE_England_data.xls -------------------------------------------------------------------------------- /shiny/excelReports/inst/app/www/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/shiny/excelReports/inst/app/www/favicon.ico -------------------------------------------------------------------------------- /targets/R Targets, what’s that and why.pptx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/targets/R Targets, what’s that and why.pptx -------------------------------------------------------------------------------- /targets/R/write_csv_and_return.R: -------------------------------------------------------------------------------- 1 | 2 | write_csv_and_return <- function(df, file_name) { 3 | 4 | write_csv2(df, file_name) 5 | 6 | file_name 7 | } -------------------------------------------------------------------------------- /leaflet_loop/json/gz_2010_us_050_00_500k.json: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/leaflet_loop/json/gz_2010_us_050_00_500k.json -------------------------------------------------------------------------------- /excel_multiple_files_to_one/PD 2021 Wk 4 Input.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/excel_multiple_files_to_one/PD 2021 Wk 4 Input.xlsx -------------------------------------------------------------------------------- /ccg_mergers/README_files/figure-gfm/visualise graph-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nhs-r-community/demos-and-how-tos/HEAD/ccg_mergers/README_files/figure-gfm/visualise graph-1.png -------------------------------------------------------------------------------- /shiny/excelReports/.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^data-raw$ 4 | dev_history.R 5 | ^dev$ 6 | $run_dev.* 7 | ^LICENSE\.md$ 8 | ^app\.R$ 9 | ^rsconnect$ 10 | -------------------------------------------------------------------------------- /ggplot/camcoder/visualizations_description.txt: -------------------------------------------------------------------------------- 1 | Set of GGPLOT visualizations 2 | 3 | - Using facet_wrap() to produce a grid of plots 4 | - Using different geoms to plot distributions 5 | -------------------------------------------------------------------------------- /random/random.R: -------------------------------------------------------------------------------- 1 | # find bank holidays (example is for England and Wales) 2 | 3 | holidays <- jsonlite::fromJSON( 4 | "https://www.gov.uk/bank-holidays.json")$`england-and-wales`$events$date -------------------------------------------------------------------------------- /shiny/reactive_web_scraping/README.md: -------------------------------------------------------------------------------- 1 | # Reactive web scraper 2 | 3 | This is an example to show how to allow your user to interactively run a web scraping script and show the results by pressing a button. -------------------------------------------------------------------------------- /ggplot/camcoder/README.md: -------------------------------------------------------------------------------- 1 | This is a project displaying several types of visualization in GGPLOT2 2 | 3 | - Facet wrap plots 4 | - Density plots 5 | - Raincloud plot 6 | - Spaghetti plot 7 | - Sparkline plot 8 | -------------------------------------------------------------------------------- /shiny/excelReports/inst/golem-config.yml: -------------------------------------------------------------------------------- 1 | default: 2 | golem_name: excelReports 3 | golem_version: 0.0.0.9000 4 | app_prod: no 5 | production: 6 | app_prod: yes 7 | dev: 8 | golem_wd: !expr here::here() 9 | -------------------------------------------------------------------------------- /shiny/reactive_example/README.md: -------------------------------------------------------------------------------- 1 | 2 | This is rather a contrived example to show how reactive UI works- the limits of the slider input are determined by the values within the specific penguins species that is selected. -------------------------------------------------------------------------------- /child_documents/README.md: -------------------------------------------------------------------------------- 1 | This is an example of using child documents to make a big document that is composed of several parts, each of which can be run with parameters. This example uses tabs but you could equally just make a really long document of course -------------------------------------------------------------------------------- /targets/data_pipeline.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | lapply(list.files("./R", full.names = TRUE), source) 3 | 4 | df_some_data <- get_data() 5 | 6 | df_wrangled_data <- df_some_data %>% mutate(c=a * 2) 7 | 8 | write_csv2(df_wrangled_data, 'output_data/wrangled_data.csv') 9 | -------------------------------------------------------------------------------- /conditional_table_formatting/kableExtra/README.md: -------------------------------------------------------------------------------- 1 | 2 | This is an example to show how tables can be RAG rated using conditional formatting, based on quantiles in the data. 3 | 4 | (this code does not amount to an endorsement of RAG rating, and was produced to help somebody out :wink:) 5 | -------------------------------------------------------------------------------- /demos-and-how-tos.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 | -------------------------------------------------------------------------------- /shiny/github_logo/README.md: -------------------------------------------------------------------------------- 1 | Add a GitHub badge that users can click to take them to a GitHub page (in this case, the same repo that this application is in) to the upper right of a shinydashboard. Can use an image file instead of a hyperlink to an image but it's just more fiddling around writing filepaths :wink: 2 | -------------------------------------------------------------------------------- /kh03/_targets.R: -------------------------------------------------------------------------------- 1 | library(targets) 2 | source("kh03.R") 3 | 4 | tar_option_set(packages = c("dplyr", "purrr", "withr", "rvest")) 5 | 6 | list( 7 | tar_target(kh03_files, get_kh03_filelist(), cue = tar_cue("always")), 8 | tar_target(kh03_data, process_kh03_file(kh03_files), pattern = map(kh03_files)) 9 | ) 10 | -------------------------------------------------------------------------------- /targets/R/get_data.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | get_data <- function(){ 4 | print("GETTING SOME DATA") 5 | Sys.sleep(3) 6 | print("Boy this is taking a while....") 7 | Sys.sleep(3) 8 | print("I wonder if there's time to get a cup of tea...") 9 | Sys.sleep(5) 10 | print("OK it's finished.") 11 | tibble(a=c(1,2,3), b=c(4,5,6)) 12 | } -------------------------------------------------------------------------------- /targets/README.md: -------------------------------------------------------------------------------- 1 | # Targets Basics 2 | 3 | Basics on how to use [R targets](https://books.ropensci.org/targets/), the code files are examples to be read 4 | along with the Powerpoint. 5 | 6 | Make sure you `setwd('targets')` and `install.packages('tarchetypes')` (includes the targets package as well) 7 | before trying to run the examples. -------------------------------------------------------------------------------- /rmarkdown/loop_rmarkdown/README.md: -------------------------------------------------------------------------------- 1 | 2 | This is a demo of using a loop to produce several RMarkdown documents. Simply install the {palmerpenguins} package and run the run_report.R file (from the git repo working directory). 3 | 4 | The first loop runs different code for different species, and the second for all penguins across different variables. -------------------------------------------------------------------------------- /conditional_table_formatting/README.md: -------------------------------------------------------------------------------- 1 | Conditionally formatting the cells of tables is quite a common thing that people want to do when they move from Excel to R. This folder contains (at the time of writing) two ways of doing so- one with kableExtra, and the other with gt. The kableExtra version uses discrete red/ amber/ green values, whereas the gt version gives a smooth colour gradient. -------------------------------------------------------------------------------- /NHSD_Data/README.md: -------------------------------------------------------------------------------- 1 | # Using NHSD data can be hard 2 | 3 | ### A repo for community contributed code that pulls NHSD data into R 4 | 5 | ### nhs-sickness-absence-rates 6 | 7 | This pulls the latest data from: https://digital.nhs.uk/data-and-information/publications/statistical/nhs-sickness-absence-rates 8 | The example given creates a dataframe with the sickness abscence rates for Acute trusts 9 | -------------------------------------------------------------------------------- /character_encoding/README.md: -------------------------------------------------------------------------------- 1 | A simple script that will help you to diagnose character encoding issues. Connect the first bit to your database, and then when you run the rest it will try the same operation on the remote database as well as a SQLite database in memory. 2 | 3 | If the SQLite works and your database doesn't then you know it's the database and not your R session that's causing the problem -------------------------------------------------------------------------------- /shiny/excelReports/dev/run_dev.R: -------------------------------------------------------------------------------- 1 | # Set options here 2 | options(golem.app.prod = FALSE) # TRUE = production mode, FALSE = development mode 3 | 4 | # Detach all loaded packages and clean your environment 5 | golem::detach_all_attached() 6 | # rm(list=ls(all.names = TRUE)) 7 | 8 | # Document and reload your package 9 | golem::document_and_reload() 10 | 11 | # Run the application 12 | run_app() 13 | -------------------------------------------------------------------------------- /ggplot/camcoder/Camcoder/README.md: -------------------------------------------------------------------------------- 1 | ## CAMCODER 2 | 3 | This is a practical example on how to use Camcoder package to record animated GIF from GGPLOT2 charts 4 | 5 | Camcoder GitHub repository: 6 | 7 | https://github.com/thebioengineer/camcorder 8 | 9 | There is an example on this project on how to use camcoder to create a GIF from a ggplot chart. Useful to explore the design process of any chart in R 10 | -------------------------------------------------------------------------------- /random/README.md: -------------------------------------------------------------------------------- 1 | This section is for useful functions that are too small to need their own code file. Over time if it expands (with help from pull requests :smile:) it will be worth splitting the code files into separate pieces. 2 | 3 | ## random.R 4 | Finds bank holidays (example is for England and Wales) 5 | 6 | ## Group_Dates.R 7 | Do you have daily data that would be useful to present weekly or monthly? 8 | Demonstrates the cut.Date function -------------------------------------------------------------------------------- /shiny/excelReports/R/utils-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom magrittr %>% 10 | #' @usage lhs \%>\% rhs 11 | #' @param lhs A value or the magrittr placeholder. 12 | #' @param rhs A function call using the magrittr semantics. 13 | #' @return The result of calling `rhs(lhs)`. 14 | NULL 15 | -------------------------------------------------------------------------------- /ggplot/camcoder/00 Project folder structure.R: -------------------------------------------------------------------------------- 1 | 2 | # Function to setup project folder structure 3 | 4 | project_setup <-function(){ 5 | 6 | if(!dir.exists("data")){dir.create("data")} 7 | if(!dir.exists("plots")){dir.create("plots")} 8 | if(!dir.exists("Archive")){dir.create("Archive")} 9 | if(!dir.exists("Test")){dir.create("Test")} 10 | 11 | } 12 | 13 | # Run code below to use function and create folder structure 14 | project_setup() 15 | -------------------------------------------------------------------------------- /shiny/excelReports/excelReports.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 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageRoxygenize: rd,collate,namespace 19 | -------------------------------------------------------------------------------- /shiny/excelReports/NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(run_app) 5 | import(shiny) 6 | import(shinydashboard) 7 | importFrom(golem,activate_js) 8 | importFrom(golem,add_resource_path) 9 | importFrom(golem,bundle_resources) 10 | importFrom(golem,favicon) 11 | importFrom(golem,with_golem_options) 12 | importFrom(magrittr,"%>%") 13 | importFrom(shiny,NS) 14 | importFrom(shiny,shinyApp) 15 | importFrom(shiny,tagList) 16 | -------------------------------------------------------------------------------- /rmarkdown/loop_rmarkdown/loop_variables.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Loop variables" 3 | author: "Chris Beeley" 4 | date: "21/04/2021" 5 | output: html_document 6 | params: 7 | variable: NA 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | 12 | library(palmerpenguins) 13 | library(tidyverse) 14 | 15 | knitr::opts_chunk$set(echo = TRUE) 16 | 17 | ``` 18 | 19 | ## `r params$variable` 20 | 21 | ```{r} 22 | 23 | penguins %>% 24 | ggplot(aes(x = .data[[params$variable]])) + geom_density() 25 | 26 | ``` 27 | -------------------------------------------------------------------------------- /caseload_size/README: -------------------------------------------------------------------------------- 1 | Test data is produced in test_data.R. Please produce a function that accepts a date or range of dates and a team and calculates how many patients were open to that team at the time. 2 | 3 | If discharge date is NA it means they are still in the team on the day the function is run. Client ID is NHS number or similar, and referral id disambiguates individual referrals for the same patient. 4 | 5 | If you would like to add other or better examples, or to change this one, please do :slightly_smiling_face: 6 | 7 | -------------------------------------------------------------------------------- /rmarkdown/loop_rmarkdown/loop_species.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Loop species" 3 | author: "Chris Beeley" 4 | date: "21/04/2021" 5 | output: html_document 6 | params: 7 | species: NA 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | 12 | library(palmerpenguins) 13 | library(tidyverse) 14 | 15 | knitr::opts_chunk$set(echo = TRUE) 16 | 17 | ``` 18 | 19 | ## `r params$species` 20 | 21 | ```{r} 22 | 23 | penguins %>% 24 | filter(species == params$species) %>% 25 | ggplot(aes(x = bill_length_mm)) + geom_density() 26 | 27 | ``` 28 | -------------------------------------------------------------------------------- /rmarkdown/loop_rmarkdown/run_report.R: -------------------------------------------------------------------------------- 1 | 2 | # install.packages("palmerpenguins") 3 | 4 | library(rmarkdown) 5 | library(palmerpenguins) 6 | 7 | for(i in unique(penguins$species)){ 8 | 9 | render("loop_rmarkdown/loop_species.Rmd", params = list(species = i), 10 | output_file = paste0("report_", i)) 11 | } 12 | 13 | for(i in c("bill_length_mm", "bill_depth_mm")){ 14 | 15 | render("loop_rmarkdown/loop_variables.Rmd", params = list(variable = i), 16 | output_file = paste0("variable_report_", i)) 17 | } 18 | -------------------------------------------------------------------------------- /shiny/excelReports/man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \arguments{ 10 | \item{lhs}{A value or the magrittr placeholder.} 11 | 12 | \item{rhs}{A function call using the magrittr semantics.} 13 | } 14 | \value{ 15 | The result of calling `rhs(lhs)`. 16 | } 17 | \description{ 18 | See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /child_documents/child.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Child document" 3 | author: "Chris Beeley" 4 | date: "16/06/2021" 5 | output: html_document 6 | --- 7 | 8 | ```{r, include=FALSE} 9 | knitr::opts_chunk$set(echo = TRUE) 10 | ``` 11 | 12 | #### Text 13 | 14 | There are `r penguins %>% filter(species == filter_species) %>% nrow()` penguins in this dataset. 15 | 16 | #### Graph 17 | 18 | ```{r} 19 | 20 | penguins %>% 21 | filter(species == filter_species) %>% 22 | ggplot(aes(x = bill_length_mm, y = bill_depth_mm)) + 23 | geom_point() 24 | 25 | ``` 26 | -------------------------------------------------------------------------------- /rmarkdown/loop_tabs/README.md: -------------------------------------------------------------------------------- 1 | # Looping graphs and tabs in RMarkdown 2 | 3 | This is a demo of using a loop to produce several charts and tabs in an RMarkdown document. It requires using the SPC package {qicharts2}. 4 | 5 | Loop examples like this often relate to base R plot code but this works with {ggplot2} and consequently also {qicharts2}. Each category group is its own plot, in this case it's gender, and these are presented in a separate tab. This is useful for many plots as otherwise reports can grow very long. As each tab requires a title, this is generated within the loop using the category name. 6 | -------------------------------------------------------------------------------- /ggplot/camcoder/Group_by_example.R: -------------------------------------------------------------------------------- 1 | ## GGPLOT2 group by 2 | 3 | library(reshape2) 4 | library(ggplot2) 5 | x <- seq(1, 5, length = 100) 6 | y <- replicate(10, sin(2 * pi * x) + rnorm(100, 0, 0.3), "list") 7 | z <- replicate(10, sin(2 * pi * x) + rnorm(100, 5, 0.3), "list") 8 | y <- melt(y) 9 | z <- melt(z) 10 | df <- data.frame(x = y$Var1, rep = y$Var2, y = y$value, z = z$value) 11 | dat <- melt(df, id = c("x", "rep")) 12 | 13 | dat 14 | 15 | # Plot it using dacet wrap 16 | 17 | ggplot(dat) + geom_line(aes(x, value, group = rep, color = variable), 18 | alpha = 0.3) + facet_wrap(~variable) 19 | -------------------------------------------------------------------------------- /random/Group_Dates.R: -------------------------------------------------------------------------------- 1 | #Do you have daily data that would be useful to present weekly or monthly? 2 | #The cut.Date function will help! 3 | 4 | 5 | library(dplyr) 6 | 7 | #Create data 8 | df <- data.frame( 9 | ActivityDate = seq(as.Date("2021-01-01"), as.Date("2021-12-31"), by="days"), 10 | Activity = sample(100:200, size = 365, replace = TRUE) 11 | ) 12 | 13 | #Group by week 14 | df |> mutate(Week = 15 | cut.Date(as.Date(`ActivityDate`), breaks="week", start.on.monday = TRUE)) 16 | 17 | 18 | #Group by month 19 | df |> mutate(Month = 20 | cut.Date(as.Date(`ActivityDate`), breaks="month")) -------------------------------------------------------------------------------- /shiny/excelReports/R/app_server.R: -------------------------------------------------------------------------------- 1 | #' The application server-side 2 | #' 3 | #' @param input,output,session Internal parameters for {shiny}. 4 | #' DO NOT REMOVE. 5 | #' @import shiny 6 | #' @noRd 7 | app_server <- function( input, output, session ) { 8 | # Your application server logic 9 | 10 | # load data 11 | 12 | all_data <- mod_upload_data_server("upload_data_ui_1") 13 | 14 | mod_per_class_server("per_class_ui_1", all_data) 15 | 16 | mod_per_student_server("per_student_ui_1", all_data) 17 | 18 | mod_per_subject_server("per_subject_ui_1", all_data) 19 | 20 | mod_per_test_server("per_test_ui_1", all_data) 21 | } 22 | -------------------------------------------------------------------------------- /shiny/changingSelection/readme.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Using uiOutput to change selection" 3 | author: "Jon Minton" 4 | date: "8 September 2022" 5 | --- 6 | 7 | # Introduction 8 | 9 | This code example shows how uiOutput can be used to dynamically change one selectInput given the choice of the other selectInput. 10 | 11 | The example uses `uiOutput`, which has an appreciable latency when updating. 12 | For this particular usecase it may therefore be better to use a different approach instead. 13 | However, this can be considered a proof of principle, which is perhaps more useful when an input's type needs to be changed (as from `selectInput` to `sliderInput`) rather than selection within should be changed. -------------------------------------------------------------------------------- /leaflet_loop/README.md: -------------------------------------------------------------------------------- 1 | 2 | This is an example of producing leaflet maps in a loop, with different variables summarised. AFAIK leaflet doesn't play nicely with quasiquotation so I've made a bit of a hacky solution, but it works :smiley:. 3 | 4 | Note that the data has a completely made up column in it to illustrate the point so please ignore the actual dataset because I made a mess of it. 5 | 6 | Note also that the use of mapview package is because the person who asked wanted a Word document- you don't need this if you're just doing HTML reporting. 7 | 8 | Data sourced from https://eric.clst.org/tech/usgeojson/, via the US Census Bureau (no copyright protection applies to this data but the Census Bureau requests a citation in work which uses the data) 9 | -------------------------------------------------------------------------------- /example_chloropleth_ICB_map/readme.md: -------------------------------------------------------------------------------- 1 | Hi 2 | 3 | This is an example map script for ICB data linked to some random data for mapping ICBs, to create a leaflet map for comparing NHS systems. 4 | 5 | See a demo here: https://aporter121.github.io/r-stuff/example-ICB-map.html 6 | 7 | Simple features; 8 | - labeling areas, currently with system name 9 | - a button to go full screen 10 | - output to an RMarkdown HTML to make it easy to share via email etc. 11 | - could easily filter for region etc. 12 | 13 | I've experimented with labelling maps etc, and use data from the UK Geoportal. 14 | 15 | Feedback and improvements welcome, probably using too many libraries in this example, as code originally also had point data overlayed for providers. 16 | 17 | Alex 18 | -------------------------------------------------------------------------------- /shiny/github_logo/app.R: -------------------------------------------------------------------------------- 1 | # with thanks to this answer https://stackoverflow.com/a/36062742/486245 2 | 3 | library(shiny) 4 | library(shinydashboard) 5 | 6 | dbHeader <- dashboardHeader( 7 | tags$li(class = "dropdown", 8 | tags$a(href="https://github.com/nhs-r-community/demos-and-how-tos", target="_blank", 9 | tags$img(height="20", alt="GitHub Logomark", 10 | src="https://cdn.icon-icons.com/icons2/2368/PNG/512/github_logo_icon_143772.png") 11 | ) 12 | ) 13 | ) 14 | 15 | sidebar <- dashboardSidebar() 16 | 17 | body <- dashboardBody() 18 | 19 | ui <- dashboardPage( 20 | dbHeader, 21 | sidebar, 22 | body 23 | ) 24 | 25 | server = function(input, output) { } 26 | 27 | shinyApp(ui, server) -------------------------------------------------------------------------------- /shiny/excelReports/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: excelReports 2 | Title: Making school reports with Shiny and golem 3 | Version: 0.0.0.9000 4 | Authors@R: person('Chris', 'Beeley', email = 'chris.beeley@gmail.com', role = c('cre', 'aut')) 5 | Description: This is a Shiny application that automates school based reporting. 6 | The user can select a class and/ or a student and produce reports based on 7 | their selection 8 | License: MIT + file LICENSE 9 | Imports: 10 | attempt, 11 | config (>= 0.3.1), 12 | datamods, 13 | DT, 14 | ggplot2, 15 | glue, 16 | golem (>= 0.3.1), 17 | htmltools, 18 | magrittr, 19 | pkgload, 20 | shiny (>= 1.6.0), 21 | shinydashboard 22 | Encoding: UTF-8 23 | LazyData: true 24 | RoxygenNote: 7.1.1 25 | -------------------------------------------------------------------------------- /shiny/excelReports/R/run_app.R: -------------------------------------------------------------------------------- 1 | #' Run the Shiny Application 2 | #' 3 | #' @param ... arguments to pass to golem_opts. 4 | #' See `?golem::get_golem_options` for more details. 5 | #' @inheritParams shiny::shinyApp 6 | #' 7 | #' @export 8 | #' @importFrom shiny shinyApp 9 | #' @importFrom golem with_golem_options 10 | run_app <- function( 11 | onStart = NULL, 12 | options = list(), 13 | enableBookmarking = NULL, 14 | uiPattern = "/", 15 | ... 16 | ) { 17 | with_golem_options( 18 | app = shinyApp( 19 | ui = app_ui, 20 | server = app_server, 21 | onStart = onStart, 22 | options = options, 23 | enableBookmarking = enableBookmarking, 24 | uiPattern = uiPattern 25 | ), 26 | golem_opts = list(...) 27 | ) 28 | } 29 | -------------------------------------------------------------------------------- /shiny/dynamic_list_ui/app.R: -------------------------------------------------------------------------------- 1 | 2 | ui <- fluidPage( 3 | 4 | # Application title 5 | titlePanel("Dynamic tag list"), 6 | 7 | sidebarLayout( 8 | sidebarPanel( 9 | checkboxInput("show_tab", "Show the optional tab?") 10 | ), 11 | 12 | mainPanel( 13 | uiOutput("main_panelUI") 14 | ) 15 | ) 16 | ) 17 | 18 | server <- function(input, output) { 19 | 20 | output$main_panelUI <- renderUI({ 21 | 22 | ui_list <- list(tabPanel("Panel one", h2("Hello!"))) 23 | 24 | if(input$show_tab){ 25 | 26 | ui_list <- c(ui_list, list(tabPanel("Panel two", h2("Peekaboo!")))) 27 | } 28 | 29 | do.call(tabsetPanel, ui_list) 30 | }) 31 | } 32 | 33 | # Run the application 34 | shinyApp(ui = ui, server = server) 35 | -------------------------------------------------------------------------------- /caseload_size/test_data.R: -------------------------------------------------------------------------------- 1 | 2 | teams <- c("Apple", "Banana", "Clementine") 3 | dates <- seq(as.Date("2017-01-01"), as.Date("2021-01-01"), "days") 4 | 5 | # 5 columns- client id, referral id, team_desc, referral_date, discharge_date 6 | 7 | test_frame <- purrr::map_dfr(1 : 100, function(x){ 8 | 9 | rnum <- sample(1 : 5, 1) 10 | team_name <- sample(teams, rnum, replace = TRUE) 11 | ran_date <- sample(dates, rnum) 12 | 13 | tibble::tibble("client_id" = rep(x, rnum), 14 | "referral_id" = 1 : rnum, 15 | "team_desc" = team_name, 16 | "referral_date" = ran_date, 17 | "discharge_date" = ran_date + sample(7 : 365, 1)) 18 | 19 | }) 20 | 21 | test_frame[sample(nrow(test_frame), 100), "discharge_date"] = NA 22 | 23 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # User-specific files 9 | .Ruserdata 10 | 11 | # Example code in package build process 12 | *-Ex.R 13 | 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | 17 | # Output files from R CMD check 18 | /*.Rcheck/ 19 | 20 | # RStudio files 21 | .Rproj.user/ 22 | 23 | # produced vignettes 24 | vignettes/*.html 25 | vignettes/*.pdf 26 | 27 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 28 | .httr-oauth 29 | 30 | # knitr and R markdown default cache directories 31 | *_cache/ 32 | /cache/ 33 | 34 | # Temporary files created by R markdown 35 | *.utf8.md 36 | *.knit.md 37 | 38 | # R Environment Variables 39 | .Renviron 40 | 41 | # Images 42 | 43 | *.png 44 | -------------------------------------------------------------------------------- /conditional_table_formatting/gt/gt_format.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Conditionally formatting penguins with gt" 3 | author: "Chris Beeley" 4 | date: "31/05/2021" 5 | output: html_document 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | 10 | library(palmerpenguins) 11 | library(tidyverse) 12 | library(gt) 13 | 14 | knitr::opts_chunk$set(echo = TRUE) 15 | 16 | ``` 17 | 18 | ```{r} 19 | 20 | # with thanks to this excellent blog post https://themockup.blog/posts/2020-09-04-10-table-rules-in-r/ 21 | 22 | penguins %>% 23 | sample_n(30) %>% 24 | gt::gt() %>% 25 | gt::data_color( 26 | columns = c(bill_length_mm, bill_depth_mm), 27 | colors = scales::col_numeric( 28 | palette = paletteer::paletteer_d( 29 | palette = "ggsci::default_gsea" 30 | ) %>% as.character(), 31 | domain = NULL 32 | ) 33 | ) 34 | 35 | ``` 36 | 37 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | # demos-and-how-tos 4 | 5 | ### A repo for community contributed demos and how-tos to get common stuff done in the R language 6 | 7 | Code is kept in folders with a README to explain the code. 8 | 9 | ## Contributing 10 | 11 | Please see our 12 | [guidance on how to contribute](https://tools.nhsrcommunity.com/contribution.html). 13 | 14 | This project is released with a Contributor [Code of Conduct](./CODE_OF_CONDUCT.md). 15 | By contributing to this project, you agree to abide by its terms. 16 | 17 | The simplest way to contribute is to raise an issue detailing the feature or 18 | functionality you would like to see added, or any unexpected behaviour or bugs 19 | you have experienced. 20 | -------------------------------------------------------------------------------- /ggplot/median_barplot/median_barplot.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Bar chart of medians" 3 | author: "Chris Beeley" 4 | date: "27/04/2021" 5 | output: html_document 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | 10 | library(tidyverse) 11 | library(palmerpenguins) 12 | 13 | knitr::opts_chunk$set(echo = TRUE) 14 | 15 | ``` 16 | 17 | ## Data prep 18 | 19 | ```{r} 20 | 21 | to_plot <- penguins %>% 22 | group_by(species) %>% 23 | summarise(median_bill_length = median(bill_length_mm, na.rm = TRUE)) 24 | 25 | ``` 26 | 27 | ## Unordered 28 | 29 | ```{r} 30 | 31 | to_plot %>% 32 | ggplot(aes(x = species, y = median_bill_length)) + 33 | geom_col() 34 | 35 | ``` 36 | 37 | ## Ordered 38 | 39 | ```{r} 40 | 41 | to_plot %>% 42 | mutate(species = fct_reorder(species, median_bill_length)) %>% 43 | ggplot(aes(x = species, y = median_bill_length)) + 44 | geom_col() 45 | 46 | ``` 47 | 48 | -------------------------------------------------------------------------------- /shiny/dynamic_list_ui/README.md: -------------------------------------------------------------------------------- 1 | # Making a list of Shiny UI dynamically 2 | 3 | In a [text mining application](https://github.com/CDU-data-science-team/experiencesdashboard) that I have running in a few different Trusts (hoping to add more- get in touch! :wink:) I need to include or exclude tabs. I can't use conditional panel- well, I don't think I can, it makes something really ugly when I do the obvious thing with it. There doesn't seem to be an obvious simple way of doing it, so I'm going to have a go in here to build a simple example to make sure it works and then transfer it to the main project. 4 | 5 | If you've been on my Shiny training you'll know I always emphasise starting simple, I think doing this in the full application I'm really asking for trouble, so here's me taking my own medicine and starting simple. 6 | 7 | I'm open sourcing it here so there's a simple version of the idea others can copy :relaxed:. 8 | -------------------------------------------------------------------------------- /child_documents/child_demo.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Child demo" 3 | output: html_document 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | 8 | library(palmerpenguins) 9 | library(tidyverse) 10 | 11 | knitr::opts_chunk$set(echo = TRUE, results = "asis") 12 | 13 | ``` 14 | 15 | ## All penguin species {.tabset} 16 | 17 | ### Adelie 18 | 19 | ```{r} 20 | 21 | filter_species <- "Adelie" 22 | 23 | res <- knitr::knit_child( 24 | 'child.Rmd', envir = environment(), quiet = TRUE 25 | ) 26 | 27 | cat(unlist(res), sep = '\n') 28 | 29 | ``` 30 | 31 | ### Chinstrap 32 | 33 | ```{r} 34 | 35 | filter_species <- "Chinstrap" 36 | 37 | res <- knitr::knit_child( 38 | 'child.Rmd', envir = environment(), quiet = TRUE 39 | ) 40 | 41 | cat(unlist(res), sep = '\n') 42 | 43 | ``` 44 | 45 | ### Gentoo 46 | 47 | ```{r} 48 | 49 | filter_species <- "Gentoo" 50 | 51 | res <- knitr::knit_child( 52 | 'child.Rmd', envir = environment(), quiet = TRUE 53 | ) 54 | 55 | cat(unlist(res), sep = '\n') 56 | 57 | ``` -------------------------------------------------------------------------------- /conditional_table_formatting/kableExtra/penguin_kable.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Penguins conditional formatting" 3 | author: "Chris Beeley" 4 | date: "27/03/2021" 5 | output: html_document 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | knitr::opts_chunk$set(echo = TRUE) 10 | ``` 11 | 12 | ```{r} 13 | 14 | library(palmerpenguins) 15 | library(tidyverse) 16 | library(kableExtra) 17 | 18 | penguin_df <- penguins %>% 19 | na.omit() 20 | 21 | penguin_table <- penguin_df %>% 22 | mutate(q_bill_length = ntile(bill_length_mm, 4)) %>% 23 | mutate(q_bill_length = recode(q_bill_length, 24 | `1` = "green", `2` = "yellow", `3` = "orange", `4` = "red" 25 | )) %>% 26 | select(species, island, bill_length_mm, q_bill_length) %>% 27 | sample_n(10) 28 | 29 | penguin_table %>% 30 | select(species, island, bill_length_mm) %>% 31 | kbl() %>% 32 | kable_paper(bootstrap_options = "striped", full_width = F) %>% 33 | column_spec(3, background = penguin_table$q_bill_length) 34 | 35 | ``` 36 | 37 | -------------------------------------------------------------------------------- /character_encoding/encoding_helper.R: -------------------------------------------------------------------------------- 1 | reprex({ 2 | library(DBI) 3 | 4 | con <- DBI::dbConnect(odbc::odbc(), 5 | Driver = "MySQL ODBC 8.0 Unicode Driver", 6 | Server = Sys.getenv("HOST_NAME"), 7 | UID = Sys.getenv("DB_USER"), 8 | PWD = Sys.getenv("MYSQL_PASSWORD"), 9 | Port = 3306, 10 | database = "SUCE", 11 | encoding = "UTF-8") 12 | 13 | df <- data.frame(x = 1, y = "佃煮惣菜", z = "It's okay", a = "Zürich") 14 | dbWriteTable(con, 'test-utf8', df, temporary = TRUE) 15 | dbReadTable(con, 'test-utf8') 16 | 17 | dbDisconnect(con) 18 | 19 | ### SQLlite 20 | 21 | # Create an ephemeral in-memory RSQLite database 22 | con <- dbConnect(RSQLite::SQLite(), ":memory:") 23 | 24 | dbListTables(con) 25 | 26 | df <- data.frame(x = 1, y = "佃煮惣菜", z = "It's okay", a = "Zürich") 27 | dbWriteTable(con, 'test-utf8', df, temporary = TRUE) 28 | dbReadTable(con, 'test-utf8') 29 | 30 | dbDisconnect(con) 31 | }) 32 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 Crown Copyright 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /shiny/excelReports/LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 NHS-R 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /separate-codes/separate-codes.qmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Separating codes" 3 | format: html 4 | embed-resources: true 5 | --- 6 | 7 | ## Create data 8 | 9 | ```{r} 10 | #| echo: false 11 | #| include: false 12 | library(tidyverse) 13 | ``` 14 | 15 | 16 | This was written originally in an Excel spreadsheet and used {datapasta} to copy into R as code to build the same data frame. 17 | 18 | ```{r} 19 | data <- tibble::tribble( 20 | ~Patient, ~Codes, 21 | "PatientA", "A01, A02, A03", 22 | "PatientB", "B01; B02; B03", 23 | "PatientC", "C01; C03", 24 | "PatientD", "D01. D02. D03" 25 | ) 26 | 27 | ``` 28 | 29 | 30 | ## Separate codes by position 31 | 32 | Separate into columns in the order data appears 33 | 34 | ```{r} 35 | library(tidyverse) 36 | 37 | data |> 38 | tidyr::separate(Codes, c("col1", "col2", "col3")) 39 | ``` 40 | 41 | 42 | [https://tidyr.tidyverse.org/reference/separate.html](https://tidyr.tidyverse.org/reference/separate.html) 43 | 44 | ## Add a pivot 45 | 46 | To move wide data to longer: 47 | 48 | ```{r} 49 | data |> 50 | tidyr::separate(Codes, c("col1", "col2", "col3")) |> 51 | tidyr::pivot_longer(cols = c(starts_with("col")), 52 | names_to = "type") 53 | ``` 54 | 55 | 56 | -------------------------------------------------------------------------------- /ggplot/camcoder/04 AandE Excel data into R from URL.R: -------------------------------------------------------------------------------- 1 | # 04 Import A&E Excel data into R from URL 2 | 3 | #Searching for the href HTML tag we can find the corresponding .xls file to import it into R 4 | #

Unadjusted: Monthly A&E Time series April 2019 (XLS, 364K)
5 | 6 | 7 | # This is an .xls file extension, Excel 97-Excel 2003 Workbook , The Excel 97 - Excel 2003 Binary file format (BIFF8). 8 | # We can import both .xls and .xlsx file using download.file() function from readxl package 9 | 10 | pacman::p_load(readxl,here,dplyr,janitor) 11 | 12 | AE_data <- function() { 13 | 14 | if(!dir.exists("data")){dir.create("data")} 15 | 16 | # England-level time series 17 | # Download Excel file to a Project sub-folder called "data" 18 | # Created previously using an adhoc project structure function 19 | 20 | xlsFile = "AE_England_data.xls" 21 | 22 | download.file( 23 | url = 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2019/11/Timeseries-monthly-Unadjusted-9kidr.xls', 24 | destfile = here("data",xlsFile), 25 | mode ="wb" 26 | ) 27 | 28 | } 29 | # Download A&E data function (no arguments) 30 | AE_data() -------------------------------------------------------------------------------- /shiny/excelReports/R/mod_upload_data.R: -------------------------------------------------------------------------------- 1 | #' upload_data UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList 10 | mod_upload_data_ui <- function(id){ 11 | ns <- NS(id) 12 | tagList( 13 | 14 | fluidPage( 15 | 16 | actionButton(ns("launch_modal"), "Upload new data"), 17 | 18 | hr(), 19 | 20 | h3("Data preview"), 21 | 22 | DT::DTOutput(ns("data_preview")) 23 | ) 24 | 25 | ) 26 | } 27 | 28 | #' upload_data Server Functions 29 | #' 30 | #' @noRd 31 | mod_upload_data_server <- function(id){ 32 | moduleServer( id, function(input, output, session){ 33 | ns <- session$ns 34 | 35 | observeEvent(input$launch_modal, { 36 | datamods::import_modal( 37 | id = session$ns("myid"), 38 | from = "file", 39 | title = "Import data to be used in application" 40 | ) 41 | }) 42 | 43 | imported <- datamods::import_server("myid", return_class = "tbl_df") 44 | 45 | output$data_preview <- DT::renderDT({ 46 | 47 | imported$data() 48 | }) 49 | 50 | reactive( 51 | imported$data() 52 | ) 53 | 54 | }) 55 | } 56 | -------------------------------------------------------------------------------- /recoding-na/recoding-na.qmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Recoding NA" 3 | format: html 4 | embed-resources: true 5 | --- 6 | 7 | ## Create data 8 | 9 | ```{r} 10 | #| echo: false 11 | #| include: false 12 | library(tidyverse) 13 | ``` 14 | 15 | This was written originally in an Excel spreadsheet and used {datapasta} to copy into R as code to build the same data frame. 16 | 17 | 18 | ## Recoding to NA 19 | 20 | ```{r} 21 | survey <- tibble::tribble( 22 | ~Survey.Response, ~Code, 23 | "Response1", -9L, 24 | "Response2", 2L, 25 | "Response3", 10L, 26 | "Response4", 0L, 27 | "Response5", 5L, 28 | "Response6", -9L, 29 | "Missing", NA 30 | ) 31 | 32 | ``` 33 | 34 | ## Recode to NA 35 | 36 | ```{r} 37 | survey |> 38 | mutate(new_column = na_if(Code, -9)) 39 | ``` 40 | 41 | It's also possible to use the numbers and `case_when()`: 42 | 43 | ```{r} 44 | survey |> 45 | mutate(new_column = case_when(Code < 0 ~ NA, 46 | .default = Code)) 47 | 48 | ``` 49 | 50 | Or `ifelse()` where there are only two options: 51 | 52 | ```{r} 53 | survey |> 54 | mutate(new_column = ifelse(Code < 0, NA, Code)) 55 | ``` 56 | 57 | 58 | ## Recode from NA 59 | 60 | ```{r} 61 | survey |> 62 | mutate(new_column2 = replace_na(Code, 1000)) 63 | ``` 64 | 65 | -------------------------------------------------------------------------------- /shiny/excelReports/R/app_config.R: -------------------------------------------------------------------------------- 1 | #' Access files in the current app 2 | #' 3 | #' NOTE: If you manually change your package name in the DESCRIPTION, 4 | #' don't forget to change it here too, and in the config file. 5 | #' For a safer name change mechanism, use the `golem::set_golem_name()` function. 6 | #' 7 | #' @param ... character vectors, specifying subdirectory and file(s) 8 | #' within your package. The default, none, returns the root of the app. 9 | #' 10 | #' @noRd 11 | app_sys <- function(...){ 12 | system.file(..., package = "excelReports") 13 | } 14 | 15 | 16 | #' Read App Config 17 | #' 18 | #' @param value Value to retrieve from the config file. 19 | #' @param config GOLEM_CONFIG_ACTIVE value. If unset, R_CONFIG_ACTIVE. 20 | #' If unset, "default". 21 | #' @param use_parent Logical, scan the parent directory for config file. 22 | #' 23 | #' @noRd 24 | get_golem_config <- function( 25 | value, 26 | config = Sys.getenv( 27 | "GOLEM_CONFIG_ACTIVE", 28 | Sys.getenv( 29 | "R_CONFIG_ACTIVE", 30 | "default" 31 | ) 32 | ), 33 | use_parent = TRUE 34 | ){ 35 | config::get( 36 | value = value, 37 | config = config, 38 | # Modify this if your config file is somewhere else: 39 | file = app_sys("golem-config.yml"), 40 | use_parent = use_parent 41 | ) 42 | } 43 | 44 | -------------------------------------------------------------------------------- /shiny/PersonPicker/PersonPickerApp.R: -------------------------------------------------------------------------------- 1 | 2 | library(shiny) 3 | 4 | ui <- fluidPage( 5 | h1("Meeting/Workshop Volunteer Picker"), 6 | HTML("Perfectly fair as the random number don't care!"), 7 | textInput("name", "Name"), 8 | actionButton("add", "add"), 9 | actionButton("del", "delete"), 10 | textOutput("names"), 11 | textOutput("num_names"), 12 | hr(), 13 | actionButton("vol", "Pick a volunteer!"), 14 | textOutput("vol_name") 15 | ) 16 | 17 | server <- function(input, output, session) { 18 | r <- reactiveValues(names = character(), volunteer = character()) 19 | 20 | observeEvent(input$add, { 21 | r$names <- union(r$names, input$name) 22 | updateTextInput(session, "name", value = "") 23 | }) 24 | 25 | observeEvent(input$del, { 26 | r$names <- setdiff(r$names, input$name) 27 | updateTextInput(session, "name", value = "") 28 | }) 29 | 30 | observeEvent(input$vol, { 31 | r$volunteer <- sample(r$names, 1) 32 | }) 33 | 34 | output$names <- renderText(paste("Today's attendees are", paste0(r$names, collapse = ", "))) 35 | 36 | output$num_names <- renderText(paste("There are", length(r$names), "attendees")) 37 | 38 | output$vol_name <- renderText({ 39 | req(r$volunteer) 40 | paste("Today's volunteer to lead is", r$volunteer) 41 | }) 42 | } 43 | 44 | shinyApp(ui, server) 45 | -------------------------------------------------------------------------------- /opcs/opcs_matching.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | library(tidyr) 3 | library(purrr) 4 | library(stringr) 5 | 6 | opcs_lookup <- data.frame( 7 | stringsAsFactors = FALSE, 8 | speciality = c("ENT", "ENT"), 9 | procedure_name = c("Wide incision", "Biopsy"), 10 | opcs = c("B1", "D1"), 11 | procedurecode2 = c(NA, "B1") 12 | ) 13 | 14 | patient_data <- data.frame( 15 | stringsAsFactors = FALSE, 16 | patient = c("Patient1", "Patient2", "Patient3", "Patient4"), 17 | procedurecode1 = c("B1", "D1", "C1", "E1"), 18 | procedurecode2 = c(NA, "B1", "D1", "B1"), 19 | procedurecode3 = c(NA, NA, "B1", "D1"), 20 | procedurecode4 = c(NA, NA, NA, NA), 21 | procedurecode5 = c(NA, NA, NA, NA) 22 | ) 23 | 24 | joined <- patient_data |> 25 | select( 26 | patient, 27 | procedurecode1, 28 | procedurecode2, 29 | procedurecode3, 30 | procedurecode4, 31 | procedurecode5) |> 32 | mutate(rn = row_number()) |> 33 | pivot_longer(cols = starts_with("procedurecode"), 34 | names_to = "procedure_code_number", 35 | values_to = "opcs") |> 36 | na.omit(opcs) |> 37 | group_by(rn) |> 38 | mutate(all_codes = map_chr(list(opcs), paste, collapse= " ")) |> 39 | inner_join(opcs_lookup, 40 | by = "opcs") |> 41 | filter(is.na(procedurecode2) | str_detect(all_codes, procedurecode2)) 42 | 43 | 44 | -------------------------------------------------------------------------------- /shiny/excelReports/dev/03_deploy.R: -------------------------------------------------------------------------------- 1 | # Building a Prod-Ready, Robust Shiny Application. 2 | # 3 | # README: each step of the dev files is optional, and you don't have to 4 | # fill every dev scripts before getting started. 5 | # 01_start.R should be filled at start. 6 | # 02_dev.R should be used to keep track of your development during the project. 7 | # 03_deploy.R should be used once you need to deploy your app. 8 | # 9 | # 10 | ###################################### 11 | #### CURRENT FILE: DEPLOY SCRIPT ##### 12 | ###################################### 13 | 14 | # Test your app 15 | 16 | ## Run checks ---- 17 | ## Check the package before sending to prod 18 | devtools::check() 19 | rhub::check_for_cran() 20 | 21 | # Deploy 22 | 23 | ## Local, CRAN or Package Manager ---- 24 | ## This will build a tar.gz that can be installed locally, 25 | ## sent to CRAN, or to a package manager 26 | devtools::build() 27 | 28 | ## RStudio ---- 29 | ## If you want to deploy on RStudio related platforms 30 | golem::add_rstudioconnect_file() 31 | golem::add_shinyappsio_file() 32 | golem::add_shinyserver_file() 33 | 34 | ## Docker ---- 35 | ## If you want to deploy via a generic Dockerfile 36 | golem::add_dockerfile() 37 | 38 | ## If you want to deploy to ShinyProxy 39 | golem::add_dockerfile_shinyproxy() 40 | 41 | ## If you want to deploy to Heroku 42 | golem::add_dockerfile_heroku() 43 | -------------------------------------------------------------------------------- /opcs/README.md: -------------------------------------------------------------------------------- 1 | # OPCS codes 2 | 3 | OPCS codes are hospital procedural codes that are detailed in the [NHS Dictionary](https://www.datadictionary.nhs.uk/data_elements/opcs-4_code.html#:~:text=OPCS%2D4%20CODE%20is%20the%20same%20as%20attribute%20CLINICAL%20CLASSIFICATION,identify%20the%20CODED%20CLINICAL%20ENTRY.) 4 | and available (upon request) from NHS Digital [TRUD](https://isd.digital.nhs.uk/trud/users/guest/filters/0/categories/37). 5 | 6 | Although the procedures are categorised in order, this only is set out by clinical 7 | coders at a later stage. This particular code relate to that earlier general order 8 | prior to recoding. 9 | 10 | The two datasets created are a dummy and based on the wide layout format with 11 | each procedure code appearing in its own column. The matches to the lookup table 12 | are based on the codes appearing in the order opcs and then procedurecode2. As 13 | the data has not been cleaned it can mean that whilst biopsy is code D1 followed 14 | by B1, the patient data could have the data appearing as B1 then D1. 15 | 16 | The result dataset needs to have: 17 | 18 | - patient1 with only 1 procedure listed 19 | - patient2 has 2 categories it can join to `procedure_name` Biopsy and Wide 20 | incision 21 | - patient3 has 2 categories but at later procudure columns and should join to 22 | Biopsy and Wide incision 23 | - patient4 has 2 categories reversed but should also join to `procedure_name` Biospy -------------------------------------------------------------------------------- /rmarkdown/loop_tabs/loop_tabs.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "loop_tabs" 3 | author: "Zoë Turner" 4 | date: "24/11/2021" 5 | output: html_document 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | knitr::opts_chunk$set(echo = FALSE, 10 | message = FALSE, 11 | warning = FALSE, 12 | results = 'asis') 13 | 14 | library(qicharts2) 15 | library(tidyverse) 16 | library(lubridate) 17 | 18 | ``` 19 | 20 | ## Gender {.tabset .tabset-fade} 21 | 22 | 23 | ```{r loop-with-tabs} 24 | 25 | gender <- cabg %>% 26 | select(gender) %>% 27 | unique() %>% 28 | pull() 29 | 30 | for(i in gender){ 31 | 32 | cat("###", i, '
', '\n') 33 | 34 | # data from the qicharts2 package, vignette https://cran.r-project.org/web/packages/qicharts2/vignettes/qicharts2.html#faceting-readmission-rates-by-gender 35 | cabg_by_month_gender <- cabg %>% 36 | filter(gender == i) %>% 37 | mutate(month = lubridate::floor_date(date, 'month')) %>% 38 | group_by(month) %>% 39 | summarise(readmissions = sum(readmission), 40 | n = n()) 41 | 42 | chart <- qic(month, readmissions, n, 43 | data = cabg_by_month_gender, 44 | chart = 'run', 45 | y.percent = TRUE, 46 | title = 'Readmissions within 30 days (run chart)', 47 | ylab = '', 48 | xlab = 'Month') 49 | 50 | 51 | print(chart) 52 | 53 | cat('\n', '
', '\n\n') 54 | 55 | } 56 | ``` 57 | -------------------------------------------------------------------------------- /rmarkdown/loop_rmarkdown/loop_tabs.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "loop_tabs" 3 | author: "Zoë Turner" 4 | date: "24/11/2021" 5 | output: html_document 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | knitr::opts_chunk$set(echo = FALSE, 10 | message = FALSE, 11 | warning = FALSE, 12 | results = 'asis') 13 | 14 | library(qicharts2) 15 | library(tidyverse) 16 | library(lubridate) 17 | 18 | ``` 19 | 20 | ## Gender {.tabset .tabset-fade} 21 | 22 | 23 | ```{r loop-with-tabs} 24 | 25 | gender <- cabg %>% 26 | select(gender) %>% 27 | unique() %>% 28 | pull() 29 | 30 | for(i in gender){ 31 | 32 | cat("###", i, '
', '\n') 33 | 34 | # data from the qicharts2 package, vignette https://cran.r-project.org/web/packages/qicharts2/vignettes/qicharts2.html#faceting-readmission-rates-by-gender 35 | cabg_by_month_gender <- cabg %>% 36 | filter(gender == i) %>% 37 | mutate(month = lubridate::floor_date(date, 'month')) %>% 38 | group_by(month) %>% 39 | summarise(readmissions = sum(readmission), 40 | n = n()) 41 | 42 | chart <- qic(month, readmissions, n, 43 | data = cabg_by_month_gender, 44 | chart = 'run', 45 | y.percent = TRUE, 46 | title = 'Readmissions within 30 days (run chart)', 47 | ylab = '', 48 | xlab = 'Month') 49 | 50 | 51 | print(chart) 52 | 53 | cat('\n', '
', '\n\n') 54 | 55 | } 56 | ``` 57 | -------------------------------------------------------------------------------- /shiny/PersonPicker/readme.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Person Picker shiny app" 3 | author: "Jon Minton" 4 | date "8 September 2022" 5 | 6 | --- 7 | 8 | # Introduction 9 | 10 | This folder contains a modification of the code chunk in [section 16.3.2](https://mastering-shiny.org/reactivity-components.html#accumulating-inputs) of Wickham's [Mastering Shiny](https://mastering-shiny.org/index.html), also available as a physical book [here](https://www.amazon.co.uk/Mastering-Shiny-Interactive-Reports-Dashboards/dp/1492047384). (Other booksellers are available.) 11 | 12 | # Modification 13 | 14 | The original code allowed the user to enter a series of names, then display them. 15 | The modification of the code allows one of the names to be selected at random. 16 | 17 | # Aims 18 | 19 | ## Facilitating meetings 20 | 21 | The aim of this is to support more equitable participation in meetings and workshops, by allowing attendees to be selected at random, rather than on the basis of personal preference. 22 | Often, within meetings, the same two or three people may keep volunteering, meaning the contents of such meetings may be dominated by these few individuals, whereas the more quiet attendees, who can potentially gain more from speaking and leading part of a meeting, stay quiet, meaning over time initial differentials in both preference for and skill in 'public' speaking compound over time. 23 | 24 | ## Technical 25 | 26 | The app is intended both to show how reactive values can be used in practice, and how existing example code can be adapted to other purposes. 27 | 28 | -------------------------------------------------------------------------------- /leaflet_loop/leaflet.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Test maps" 3 | author: "Chris Beeley" 4 | date: "21/04/2021" 5 | output: 6 | word_document: default 7 | html_document: default 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | 12 | library(leaflet) 13 | library(tidyverse) 14 | library(mapview) 15 | 16 | knitr::opts_chunk$set(echo = TRUE) 17 | 18 | # https://eric.clst.org/tech/usgeojson/ 19 | 20 | nycounties <- rgdal::readOGR("json/gz_2010_us_050_00_500k.json") 21 | 22 | pal <- colorNumeric("viridis", NULL) 23 | 24 | # make some fake data to loop through 25 | 26 | nycounties@data$CENSUSAREA2 = 2 * nycounties@data$CENSUSAREA 27 | 28 | ``` 29 | 30 | ```{r results="asis"} 31 | 32 | for(i in c("CENSUSAREA", "CENSUSAREA2")){ 33 | 34 | cat(paste0("## ", i, "\\n \\n")) 35 | 36 | nycounties@data$variable = nycounties@data[[i]] 37 | 38 | l <- leaflet(nycounties) %>% 39 | setView(lng = -98.583, lat = 39.833, zoom = 4) %>% 40 | addTiles() %>% 41 | addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 1, 42 | fillColor = ~pal(log10(variable)), 43 | label = ~paste0(LSAD, ": ", formatC(variable, big.mark = ","))) %>% 44 | addLegend(pal = pal, values = ~log10(variable), opacity = 1.0, 45 | labFormat = labelFormat(transform = function(x) round(10^x))) 46 | 47 | mapshot(l, file = paste0(i, "_map_plot.png")) 48 | 49 | cat(paste0("![](", "", i, "_map_plot.png)"), " \n \n") 50 | 51 | cat(paste0("You can even put some more text in here about ", i, ". \n \n")) 52 | 53 | } 54 | 55 | ``` 56 | 57 | -------------------------------------------------------------------------------- /shiny/simpleGrandTour/readme.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Simple grand tour example" 3 | author: "Jon Minton" 4 | date: "8 September 2022" 5 | --- 6 | 7 | # Introduction 8 | 9 | The code example here shows how to produce something like a Grand Tour of a series of data by linking two `plotlyOutput` objects. 10 | 11 | Initially, a main plot appears, for which multiple selections can be supplied. Each of these selections produces a new line trace, showing how a value changes for a different place. These traces can quickly become overwhelming. 12 | 13 | When the user clicks on a point on any of the series in the main graph, two subplots are produced below the mainplot. 14 | One of these subplots shows how the place selected, for the period selected, compares with other places in the same period. (I.e. a dotplot) 15 | The other subplot shows how the value for the place selected changed over time, highlighting the year selected as a point on top of the polyline for the place selected. 16 | 17 | The app includes text outputs to show that both hover-over and click-on events are passed from the main plot to elsewhere in the shiny server. 18 | 19 | # Methods demonstrated 20 | 21 | The shiny app shows how plotly's `event_register` and `event_data` functions can be used to allow user interactions with a plotly canvas can be passed between parts of the server in the shiny app. 22 | This is what allows the selected data, on click, to be passed from the main figure to the subfigure logic. 23 | 24 | The example also shows how plotly objects can be given a source attribute, allowing `event_data` to listen only to specific plotly plots, rather than any plotly plot. -------------------------------------------------------------------------------- /shiny/reactive_example/app.R: -------------------------------------------------------------------------------- 1 | library(palmerpenguins) 2 | library(tidyverse) 3 | 4 | # Define UI for application that draws a histogram 5 | ui <- fluidPage( 6 | 7 | # Application title 8 | titlePanel("Reactive example"), 9 | 10 | sidebarLayout( 11 | sidebarPanel( 12 | selectInput("species", 13 | "Select penguin species", 14 | choices = c("Adelie", "Chinstrap", "Gentoo")), 15 | uiOutput("plotSizeUI") 16 | ), 17 | 18 | mainPanel( 19 | plotOutput("pengPlot") 20 | ) 21 | ) 22 | ) 23 | 24 | server <- function(input, output) { 25 | 26 | penguinData <- reactive({ 27 | 28 | penguins %>% 29 | filter(species == input$species) 30 | }) 31 | 32 | output$plotSizeUI <- renderUI({ 33 | 34 | min_bill_length <- min(penguinData()$bill_length_mm, na.rm = TRUE) 35 | max_bill_length <- max(penguinData()$bill_length_mm, na.rm = TRUE) 36 | 37 | sliderInput("billLength", 38 | "Bill length range selector", 39 | min = min_bill_length, 40 | max = max_bill_length, 41 | value = c(min_bill_length, max_bill_length)) 42 | }) 43 | 44 | output$pengPlot <- renderPlot({ 45 | 46 | penguinData() %>% 47 | ggplot(aes(x = bill_length_mm, y = bill_depth_mm)) + 48 | scale_x_continuous( 49 | limits = c(input$billLength[1], input$billLength[2])) + 50 | geom_point() 51 | }) 52 | } 53 | 54 | # Run the application 55 | shinyApp(ui = ui, server = server) 56 | -------------------------------------------------------------------------------- /rmarkdown/loop_graphs/loop_dataframe_graphs.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Loop graphs in RMarkdown" 3 | author: "Chris Beeley" 4 | date: "02/09/2021" 5 | output: html_document 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | 10 | library(palmerpenguins) 11 | library(tidyverse) 12 | 13 | knitr::opts_chunk$set(echo = TRUE) 14 | 15 | # make several datasets 16 | 17 | penguins_1 <- penguins %>% 18 | sample_n(50) 19 | 20 | penguins_2 <- penguins %>% 21 | sample_n(50) 22 | 23 | penguins_3 <- penguins %>% 24 | sample_n(50) 25 | 26 | lots_of_penguins <- list(penguins_1, penguins_2, penguins_3) 27 | 28 | ``` 29 | 30 | Sometimes you may wish to run the same plotting function on multiple datasets. There's a simple way and a slightly-weird-but-works way. 31 | 32 | Note that this is a contrived example and that this is not the simplest way of doing this particular thing. 33 | 34 | ### Simple 35 | 36 | ```{r} 37 | 38 | walk(lots_of_penguins, function(x) { 39 | 40 | p <- x %>% 41 | ggplot(aes(flipper_length_mm, body_mass_g)) + 42 | geom_point() 43 | 44 | print(p) 45 | }) 46 | 47 | ``` 48 | 49 | ### Slightly-weird-but-works 50 | 51 | ```{r} 52 | 53 | walk(paste0("penguins_", 1 : 3), function(x) { 54 | 55 | df <- get(x) 56 | 57 | p <- df %>% 58 | ggplot(aes(flipper_length_mm, body_mass_g)) + 59 | geom_point() 60 | 61 | print(p) 62 | }) 63 | 64 | ``` 65 | 66 | ### Add a title 67 | 68 | ```{r} 69 | 70 | penguin_names <- c("Penguin one", "Penguin two", "Penguin three") 71 | 72 | walk2(lots_of_penguins, penguin_names, function(x, y) { 73 | 74 | p <- x %>% 75 | ggplot(aes(flipper_length_mm, body_mass_g)) + 76 | geom_point() + 77 | ggtitle(y) 78 | 79 | print(p) 80 | }) 81 | 82 | ``` 83 | 84 | -------------------------------------------------------------------------------- /kh03/Readme.md: -------------------------------------------------------------------------------- 1 | 2 | # Download and Process the KH03 data 3 | 4 | Each NHS Trust has so submit a report containing the amount of beds 5 | available and occupied in a month. This report is called “KH03”, and is 6 | available (by quarter) from April 2010 onwards. 7 | 8 | The script in this folder will download and process these files. It does 9 | not attempt to use the yearly versions which were available prior to 10 | April 2010. 11 | 12 | `{targets}` is used to orchestrate the downloading and processing of 13 | files. There are two targets: 14 | 15 | - `kh03_files` goes to the NHS England [Bed Availability and 16 | Occupancy](https://www.england.nhs.uk/statistics/statistical-work-areas/bed-availability-and-occupancy/bed-data-overnight/) 17 | site and find’s the available files to download, using the `{rvest}` 18 | package. This target is set to always run, no matter what. 19 | - `kh03_data` then uses the list of files from the `kh03_files` target 20 | and will run the function `process_kh03_file()` for each of the 21 | available files. This target will only run for newly added items to 22 | the `kh03_files` list. In other words, we only will download and 23 | process each file once. 24 | 25 | We can run the targets pipeline using the following: 26 | 27 | ``` r 28 | library(targets) 29 | tar_make() 30 | ``` 31 | 32 | Once targets has finished running we can save the data to an Rds/parquet 33 | file for easier use outside of this targets environment. 34 | 35 | ``` r 36 | suppressMessages({ 37 | library(tidyverse) 38 | library(arrow) 39 | }) 40 | 41 | kh03_data <- tar_read(kh03_data) 42 | 43 | saveRDS(kh03_data, "kh03.Rds") 44 | 45 | kh03_data |> 46 | unnest(by_specialty) |> 47 | write_parquet("kh03.parquet") 48 | ``` 49 | -------------------------------------------------------------------------------- /create_filter_from_logic_evaluation/filter_creation.R: -------------------------------------------------------------------------------- 1 | library(palmerpenguins) 2 | library(tidyverse) 3 | 4 | ce1_use_filter <- TRUE 5 | ce1_event_name <- 'bill_length_mm' 6 | # This option can also be used to identify pts without this event 7 | ce1_occured <- TRUE 8 | ce1_result_evaluation <- TRUE 9 | 10 | equal_to_ce1_result <- FALSE 11 | greater_than_ce1_result <- FALSE 12 | greater_than_or_equal_to_ce1_result <- TRUE 13 | less_than_ce1_result <- FALSE 14 | less_than_or_equal_to_ce1_result <- FALSE 15 | 16 | ce1_result <- "30" 17 | 18 | math_opperator <- if (equal_to_ce1_result == TRUE) { 19 | '==' 20 | } else if (greater_than_ce1_result == TRUE) { 21 | '>' 22 | } else if(greater_than_or_equal_to_ce1_result == TRUE) { 23 | '>=' 24 | } else if (less_than_ce1_result == TRUE) { 25 | '<' 26 | }else if (less_than_or_equal_to_ce1_result == TRUE) { 27 | '<=' 28 | } 29 | 30 | if(ce1_use_filter == TRUE){ 31 | a <- paste0("variable == ","'",ce1_event_name,"'") 32 | if (ce1_occured==FALSE) { 33 | a <- paste0('!',a) 34 | } 35 | if (ce1_result_evaluation == TRUE) { 36 | a <- paste0( 37 | a, 38 | " & ", 39 | "measure ", 40 | math_opperator, 41 | ce1_result 42 | ) 43 | } 44 | ce1_filter <- a 45 | rm(a) 46 | } 47 | ce1_filter 48 | 49 | palmerpenguins::penguins %>% 50 | # transform the penguins data set to make it more like a database table 51 | pivot_longer(names_to = 'variable', 52 | values_to = 'measure', 53 | cols = c( 54 | "bill_length_mm", 55 | "bill_depth_mm", 56 | "flipper_length_mm", 57 | "body_mass_g" 58 | )) %>% 59 | filter(eval(str2expression(ce1_filter))) %>% 60 | view() 61 | 62 | 63 | -------------------------------------------------------------------------------- /shiny/reactive_web_scraping/app.R: -------------------------------------------------------------------------------- 1 | library(DT) 2 | library(palmerpenguins) 3 | library(tidyverse) 4 | 5 | ui <- fluidPage( 6 | 7 | # Application title 8 | titlePanel("Web scraping results"), 9 | 10 | # Sidebar with a slider input for number of bins 11 | sidebarLayout( 12 | sidebarPanel( 13 | actionButton("refresh_data", "Press to refresh") 14 | ), 15 | 16 | # Show a plot of the generated distribution 17 | mainPanel( 18 | DT::DTOutput("table"), 19 | plotOutput("graph") 20 | ) 21 | ) 22 | ) 23 | 24 | # Define server logic required to draw a histogram 25 | server <- function(input, output) { 26 | 27 | reactive_data <- reactive({ 28 | 29 | # call the reactive input here 30 | 31 | input$refresh_data 32 | 33 | # put web scraping stuff in here and finish with a dataframe 34 | # I will sample palmerpenguins to illusrate 35 | 36 | penguins %>% 37 | sample_frac(.5) 38 | }) 39 | 40 | output$table <- renderDT({ 41 | 42 | # as long as the above function returns a dataframe you can just 43 | # call it straight from here 44 | 45 | reactive_data() %>% 46 | group_by(species) %>% 47 | summarise(bill_length = mean(bill_length_mm, na.rm = TRUE)) 48 | }) 49 | 50 | output$graph <- renderPlot({ 51 | 52 | # again if reactive returns dataframe you can plot here 53 | 54 | reactive_data() %>% 55 | ggplot(aes(x = bill_length_mm, y = body_mass_g)) + 56 | geom_point() 57 | }) 58 | } 59 | 60 | # Run the application 61 | shinyApp(ui = ui, server = server) 62 | -------------------------------------------------------------------------------- /zip-files/lsoa-population.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "LSOA population - web scraping a zip file" 3 | author: "NHS-R Community" 4 | date: "12/11/2021" 5 | output: html_document 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | knitr::opts_chunk$set(echo = TRUE) 10 | 11 | library(withr) 12 | library(readxl) 13 | library(tidyverse) 14 | ``` 15 | 16 | #### Background 17 | 18 | Originally published in a NHS-R Community [blog](https://nhsrcommunity.com/blog/using-sf-to-calculate-catchment-areas/) 19 | .by Tom Jemmett 20 | 21 | ## Web scraping 22 | 23 | Download the LSOA population estimates from ons website: for some reason they 24 | provide this download as an excel file in a zip file, so we need to download 25 | the zip then extract the file, but we don't need to keep the zip after. {withr} 26 | handles this temporary like file for us: 27 | 28 | ```{r web-scrape} 29 | if (!file.exists("SAPE22DT2-mid-2019-lsoa-syoa-estimates-unformatted.xlsx")) { 30 | withr::local_file("lsoa_pop_est.zip", { 31 | download.file( 32 | paste0( 33 | "https://www.ons.gov.uk/file?uri=/peoplepopulationandcommunity/", 34 | "populationandmigration/populationestimates/datasets/", 35 | "lowersuperoutputareamidyearpopulationestimates/mid2019sape22dt2/", 36 | "sape22dt2mid2019lsoasyoaestimatesunformatted.zip" 37 | ), 38 | "lsoa_pop_est.zip", 39 | mode = "wb" 40 | ) 41 | unzip("lsoa_pop_est.zip") 42 | }) 43 | } 44 | ``` 45 | 46 | 47 | ```{r read-excel} 48 | lsoa_pop_estimates <- readxl::read_excel( 49 | "SAPE22DT2-mid-2019-lsoa-syoa-estimates-unformatted.xlsx", 50 | "Mid-2019 Persons", 51 | skip = 3 52 | ) %>% 53 | dplyr::select(LSOA11CD = `LSOA Code`, pop = `All Ages`) 54 | ``` 55 | 56 | 57 | ```{r pop-estimates} 58 | head(lsoa_pop_estimates) 59 | ``` 60 | -------------------------------------------------------------------------------- /ggplot/camcoder/02 Download RTT TS data.R: -------------------------------------------------------------------------------- 1 | # 01 Download RTT data.R 2 | 3 | # How to download .XLSX files from a URL into R 4 | 5 | # MAIN WEBSITE FOR THIS INDICATOR 6 | # Consultant-led Referral to Treatment (RTT) waiting times 7 | # https://www.england.nhs.uk/statistics/statistical-work-areas/rtt-waiting-times/ 8 | 9 | # Time series data 10 | # CHROME: Inspect element. Copy outher HTML 11 | # We can find the .csv data by looking at tags in the HTML code 12 | #

England-level time series

13 | #

RTT Overview Timeseries Including Estimates for Missing Trusts Nov22 (XLS, 98K)

' 14 | 15 | # Template to load xlsx file from URL 16 | # urlFile = "https://docs.google.com/spreadsheets/d/1SF0PkBz9BR4yqiQ27Bt5OsD33Y8Rt5lh/edit?usp=sharing&ouid=107152468748636733235&rtpof=true&sd=true" 17 | # xlsFile = "refugios_nayarit.xlsx" 18 | # download.file(url=urlFile, destfile=xlsFile, mode="wb") 19 | 20 | # Check WD directory file system 21 | RTT_TS_data <- function() { 22 | 23 | if(!dir.exists("data")){dir.create("data")} 24 | 25 | # England-level time series 26 | # Download Excel file to a Project sub-folder called "data" 27 | # Created previously using an adhoc project structure function 28 | 29 | xlsFile = "RTT_TS_data.xlsx" 30 | 31 | download.file( 32 | url = 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2023/01/RTT-Overview-Timeseries-Including-Estimates-for-Missing-Trusts-Nov22-XLS-98K-63230.xlsx', 33 | 34 | destfile = here::here("data",xlsFile), 35 | mode ="wb" 36 | ) 37 | 38 | } 39 | # Download RTT data function (no arguments) 40 | RTT_TS_data() -------------------------------------------------------------------------------- /shiny/excelReports/man/run_app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/run_app.R 3 | \name{run_app} 4 | \alias{run_app} 5 | \title{Run the Shiny Application} 6 | \usage{ 7 | run_app( 8 | onStart = NULL, 9 | options = list(), 10 | enableBookmarking = NULL, 11 | uiPattern = "/", 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{onStart}{A function that will be called before the app is actually run. 17 | This is only needed for \code{shinyAppObj}, since in the \code{shinyAppDir} 18 | case, a \code{global.R} file can be used for this purpose.} 19 | 20 | \item{options}{Named options that should be passed to the \code{runApp} call 21 | (these can be any of the following: "port", "launch.browser", "host", "quiet", 22 | "display.mode" and "test.mode"). You can also specify \code{width} and 23 | \code{height} parameters which provide a hint to the embedding environment 24 | about the ideal height/width for the app.} 25 | 26 | \item{enableBookmarking}{Can be one of \code{"url"}, \code{"server"}, or 27 | \code{"disable"}. The default value, \code{NULL}, will respect the setting from 28 | any previous calls to \code{\link[shiny:enableBookmarking]{enableBookmarking()}}. See \code{\link[shiny:enableBookmarking]{enableBookmarking()}} 29 | for more information on bookmarking your app.} 30 | 31 | \item{uiPattern}{A regular expression that will be applied to each \code{GET} 32 | request to determine whether the \code{ui} should be used to handle the 33 | request. Note that the entire request path must match the regular 34 | expression in order for the match to be considered successful.} 35 | 36 | \item{...}{arguments to pass to golem_opts. 37 | See `?golem::get_golem_options` for more details.} 38 | } 39 | \description{ 40 | Run the Shiny Application 41 | } 42 | -------------------------------------------------------------------------------- /kh03/Readme.rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | # Download and Process the KH03 data 6 | 7 | Each NHS Trust has so submit a report containing the amount of beds available and occupied in a month. This report is 8 | called "KH03", and is available (by quarter) from April 2010 onwards. 9 | 10 | The script in this folder will download and process these files. It does not attempt to use the yearly versions which 11 | were available prior to April 2010. 12 | 13 | `{targets}` is used to orchestrate the downloading and processing of files. There are two targets: 14 | 15 | * `kh03_files` goes to the NHS England [Bed Availability and Occupancy][kh03_site] site and find's the available files 16 | to download, using the `{rvest}` package. This target is set to always run, no matter what. 17 | * `kh03_data` then uses the list of files from the `kh03_files` target and will run the function `process_kh03_file()` 18 | for each of the available files. This target will only run for newly added items to the `kh03_files` list. In other 19 | words, we only will download and process each file once. 20 | 21 | We can run the targets pipeline using the following: 22 | 23 | ```{r, results='hide'} 24 | library(targets) 25 | tar_make() 26 | ``` 27 | 28 | Once targets has finished running we can save the data to an Rds/parquet file for easier use outside of this targets 29 | environment. 30 | 31 | ```{r, results='hide'} 32 | suppressMessages({ 33 | library(tidyverse) 34 | library(arrow) 35 | }) 36 | 37 | kh03_data <- tar_read(kh03_data) 38 | 39 | saveRDS(kh03_data, "kh03.Rds") 40 | 41 | kh03_data |> 42 | unnest(by_specialty) |> 43 | write_parquet("kh03.parquet") 44 | ``` 45 | 46 | [kh03_site]: https://www.england.nhs.uk/statistics/statistical-work-areas/bed-availability-and-occupancy/bed-data-overnight/ -------------------------------------------------------------------------------- /shiny/access_html_elements/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(palmerpenguins) 3 | library(plotly) 4 | 5 | ui <- fluidPage( 6 | 7 | shinyjs::useShinyjs(), 8 | 9 | # Application title 10 | titlePanel("Example app"), 11 | 12 | plotlyOutput("penguinPlot"), 13 | verbatimTextOutput("textInfo") 14 | 15 | 16 | ) 17 | 18 | server <- function(input, output) { 19 | 20 | output$penguinPlot <- renderPlotly({ 21 | 22 | p <- penguins %>% 23 | plot_ly(x=~body_mass_g, 24 | y=~bill_length_mm, 25 | frame=~year, 26 | source="mainplot") %>% 27 | add_trace() %>% 28 | event_register(event="plotly_click") 29 | 30 | return(p) 31 | 32 | }) 33 | 34 | output$textInfo <- renderText({ 35 | d <- event_data("plotly_click", source="mainplot") 36 | if (is.null(d)) { 37 | "Click on a point for info" 38 | } else { 39 | # Get info on current year from html using javascript 40 | shinyjs::runjs(" 41 | // There are 4 elements with slider-label as class name, the first one is 42 | // the text on the top RHS of the slider, the other 3 are the slider options 43 | let text = document.getElementsByClassName('slider-label')[0].innerHTML; 44 | // get year out of inner text 45 | text = text.replace('year: ', ''); 46 | // Sends text to input$year_shiny 47 | Shiny.setInputValue('sliderYear', text); 48 | ") 49 | paste0("Information from most recent click:", "\n", 50 | "\n", 51 | "Year: ", input$sliderYear, "\n", 52 | "Body mass: ", d$x, "g", "\n", 53 | "Bill length: ", d$y, "mm") 54 | } 55 | }) 56 | } 57 | 58 | # Run the application 59 | shinyApp(ui = ui, server = server) 60 | 61 | -------------------------------------------------------------------------------- /rmarkdown/rmarkdown_functions_and_functionals/markdown_template.rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Demographic report for `r params$country`" 3 | author: "Jon Minton" 4 | date: "15/03/2022" 5 | output: pdf 6 | params: 7 | code: "GBR_SCO" 8 | country: "Scotland" 9 | --- 10 | 11 | ```{r setup, include=FALSE} 12 | knitr::opts_chunk$set(echo = TRUE) 13 | 14 | pacman::p_load(tidyverse) 15 | 16 | 17 | this_lt <- all_lt %>% 18 | filter(code == params$code) 19 | 20 | other_lt <- all_lt %>% 21 | filter(!(code == params$code)) 22 | 23 | min_year <- min(this_lt$Year) 24 | max_year <- max(this_lt$Year) 25 | 26 | ``` 27 | 28 | # Introduction 29 | 30 | This is an attempt at a template for generating multiple markdown reports using parameters. 31 | 32 | It is based on the information on [the relevant section](https://bookdown.org/yihui/rmarkdown-cookbook/parameterized-reports.html) of the [rmarkdown cookbook](https://bookdown.org/yihui/rmarkdown-cookbook/) website. 33 | 34 | 35 | # Introduction 36 | 37 | `r params$country`, represented in the HMD by the code `r params$code`, has available data for the years `r min_year` to `r max_year`. Its life expectancy at birth over time is shown in red below, with other countries shown in a muted grey for comparison. 38 | 39 | 40 | ```{r, echo = FALSE, fig.width = 8, fig.height = 6} 41 | this_lt %>% 42 | filter(Age == 0) %>% 43 | ggplot(aes(x = Year, y = ex)) + 44 | geom_line( 45 | aes(x = Year, y = ex, group = code), 46 | color = "lightgray", inherit.aes = FALSE, 47 | data = other_lt %>% 48 | filter(Age == 0) 49 | ) + 50 | geom_line(color = "darkred", size = 1.2) + 51 | facet_wrap(~sex) + 52 | labs(x = "Year", y = "Life expectancy at birth", 53 | title = glue::glue("Life expectancy at birth for {params$country}") 54 | ) 55 | 56 | 57 | ``` 58 | 59 | 60 | 61 | -------------------------------------------------------------------------------- /rmarkdown/rmarkdown_functions_and_functionals/readme.md: -------------------------------------------------------------------------------- 1 | === 2 | author: "Jon Minton" 3 | title: "Procedurally generating Rmarkdown reports using functions and functional programming" 4 | date: "6 March 2022" 5 | 6 | === 7 | 8 | # Introduction 9 | 10 | The example here contains a slight enhancement on existing examples for procedurally generating Rmarkdown reports. 11 | 12 | - The R script 13 | - Loads the data required at the outset so it does not have to be loaded each time the Rmarkdown template file is run 14 | - Turns the call to the .rmd template file into a function based on the pattern used in [the rmarkdown cookbook](https://bookdown.org/yihui/rmarkdown-cookbook/parameterized-reports.html) 15 | - Runs the function which calls the .rmd template three ways: 16 | - Once, for a single parameter combination 17 | - For all parameter combinations, using a for loop 18 | - For all parameter combinations, using the `purrr::walk2` function instead of a for loop 19 | - The rmd template: 20 | - Adjusts the title of the report to be specific to the country being profiled 21 | - Presents some very simple in-line summary information for the country of interest 22 | - Shows data for the country of interest with a bold red line, and other countries/populations with lighter grey lines for reference 23 | 24 | 25 | # Usage 26 | 27 | - Create a subdirectory `outputs` 28 | - Make sure dependencies are loaded 29 | - Run the .R file 30 | 31 | You may need to clear the contents of the `outputs` folder between runs 32 | 33 | # Data and data source 34 | 35 | Life expectancies at birth, from lifetables extracted and aggregated from the [Human Mortality Database](https://www.mortality.org/), extracted using the [HMDHFDplus R package](https://cran.r-project.org/web/packages/HMDHFDplus/index.html). 36 | 37 | -------------------------------------------------------------------------------- /ggplot/camcoder/10 Density plot for AE Attendances.R: -------------------------------------------------------------------------------- 1 | # 10 Density plot for A&E Attendanes 2 | library(ggside) 3 | library(tidyverse) 4 | library(tidyquant) 5 | 6 | # Using the AEBYEAR_sel data set for this Density plot 7 | AEBYEAR_sel 8 | 9 | # 1 DENSITY PLOT FOR MAJOR_ATTENDANCES AND SINGLE ESP ATT SCATTERPLOT 10 | AEBYEAR <- AEBYEAR_sel %>% select(period,Major_att,Single_esp_att,Other_att) 11 | AEBYEAR 12 | 13 | 14 | # Plot structure 15 | # X axis (period) 16 | # Y axis (value) 17 | # color (metric) 18 | 19 | # 2. Place both metrics Major_att, Single_esp_att on the same columns (pivot long data set) 20 | Dendata_long<- AEBYEAR %>% 21 | pivot_longer(names_to = "Metrics", 22 | cols = 2:ncol(AEBYEAR)) 23 | Dendata_long 24 | 25 | # 2.1 Add month as new variable to data set 26 | Dendata_months<- Dendata_long %>% 27 | mutate( 28 | Year = format(period, format = "%Y"), 29 | Month = format(period, format = "%b") 30 | ) 31 | Dendata_months 32 | 33 | # 2 Start building the Density plot 34 | # 2.1 Initial GGPLOT displaying metric by date 35 | scatter_plot <- Dendata_months %>% 36 | ggplot(aes(period, value, color = Metrics)) + 37 | ggtitle("Standard ggplot2 scatterplot") + 38 | geom_point(size = 2, alpha = 0.3) 39 | scatter_plot 40 | 41 | 42 | 43 | # 2.2 start building the density plot 44 | library(tidyquant) 45 | 46 | density_plot <- density_Major_att %>% 47 | ggplot(aes(period, value, color = Metrics)) + 48 | ggtitle("AE Attendances by Type.2011-2019") + 49 | geom_point(size = 2, alpha = 0.3) + 50 | 51 | # Adding X axis density plot 52 | geom_xsidedensity( 53 | aes(y = after_stat(density),fill = Metrics), 54 | alpha = 0.5, size = 1, 55 | position = "stack") 56 | 57 | density_plot 58 | -------------------------------------------------------------------------------- /NHSD_Data/nhs-sickness-absence-rates.R: -------------------------------------------------------------------------------- 1 | # National Staff Abscence Rates ---------------------------------------------------------- 2 | library(htmltools) 3 | library(rvest) 4 | library(xml2) 5 | library(dplyr) 6 | 7 | 8 | 9 | 10 | #Specifying the url for desired website to be scraped 11 | url <- paste("https://digital.nhs.uk/data-and-information/publications/statistical/nhs-sickness-absence-rates") 12 | 13 | #Reading the HTML code from the website 14 | webpage <- read_html(url) 15 | 16 | #Using CSS selectors to scrape the publications section 17 | web_data_html <- html_nodes(webpage,'.cta__button') 18 | 19 | #Find the latest publication 20 | web_data <- xml_attrs(web_data_html[[1]]) %>% 21 | data.frame() %>% 22 | head(1) %>% 23 | pull() 24 | 25 | url2 <- paste0("https://digital.nhs.uk",web_data) 26 | 27 | 28 | 29 | #Reading the HTML code from the website 30 | webpage2 <- read_html(url2) 31 | 32 | #Using CSS selectors to scrape the downloads section 33 | #For my purposes I need the NEW_FORMAT_NHS Sickness Absence XLSX file which is number 9 34 | web_data_html2 <- html_nodes(webpage2,'.nhsd-a-box-link')[9] 35 | 36 | #Pull out the full file path 37 | web_data2 <- xml_attrs(web_data_html2[[1]]) %>% 38 | data.frame() %>% 39 | head(1) %>% 40 | pull() 41 | 42 | #Download File 43 | destfile <- "NationalAbsenceRates.xlsx" 44 | curl::curl_download(web_data2, destfile) 45 | 46 | #Read file as normal, here I am getting the monthly nation absence rates for acutes 47 | NationalAbsenceRates <- read_excel(destfile, sheet = "Table 3", skip = 2) |> 48 | select(`...1`, Acute) |> 49 | drop_na() |> 50 | mutate(Date = paste("01",`...1`)) |> #Poorly formatted dates need adjusting 51 | mutate(Date = as.Date(Date, "%d %B %Y")) |> 52 | mutate(Absence = rollmean(Acute, k=12, fill=NA, align = "right")) |> 53 | filter(Date >= '2021-04-01') |> 54 | select(Date, Absence) 55 | 56 | 57 | -------------------------------------------------------------------------------- /targets/_targets.R: -------------------------------------------------------------------------------- 1 | library(targets) 2 | library(tarchetypes) 3 | lapply(list.files("./R", full.names = TRUE), source) 4 | 5 | tar_option_set(packages = c("tidyverse")) 6 | 7 | # Basic example of a targets pipeline, run me with targets::tar_make and visualise me with targets::tar_visnetwork(). 8 | # Load my outputs into you environment using targets::tar_load(everything()) 9 | 10 | tar_plan( 11 | 12 | ################# 13 | ### Motivation### 14 | ################# 15 | 16 | df_some_data = get_data(), 17 | 18 | df_wrangled_data = df_some_data %>% mutate(c=a * 2), 19 | 20 | tar_file(out_file, (function() { 21 | file_name <- 'output_data/wrangled_data.csv' 22 | write_csv2(df_wrangled_data, file_name) 23 | file_name}) () ), 24 | 25 | ################# 26 | ### Gotchas ### 27 | ################# 28 | 29 | # Doesn't know that input is a file and not just a string 30 | # therefore doesn't rerun when the file changes 31 | df_first = read_csv('input_data/first.csv'), 32 | 33 | # Fixed it, tar_file creates a target that reruns when the file contents change 34 | tar_file(file_first, 'input_data/first.csv'), 35 | df_first_fixed = read_csv(file_first), 36 | 37 | # Depends on external state, the function and its inputs don't change 38 | not_the_time = Sys.time(), 39 | 40 | # Fixed it by adding a 'cue' rule that tells it when to rerun 41 | tar_target(the_time, Sys.time(), cue=tar_cue('always')), 42 | 43 | 44 | ################# 45 | ### Branching ### 46 | ################# 47 | 48 | # A directory full of files 49 | tar_files(input_files, list.files('input_data', full.names = TRUE)), 50 | 51 | tar_target(line_counts, length(read_csv(input_files)), pattern = map(input_files)), 52 | 53 | fixed_line_count = 17, 54 | 55 | final_line_count = sum(line_counts) + fixed_line_count, 56 | 57 | ################# 58 | 59 | final = 1 60 | 61 | ) 62 | -------------------------------------------------------------------------------- /optim-with-rmse/README.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Using optim() to produce the best parameter for a 'Synthetic Germany' 3 | author: "Jon Minton" 4 | --- 5 | 6 | # Introduction 7 | 8 | This example shows how the `optim()` function can be used to help select a parameter which minimises a loss function. `optim()` is commonly used under the bonnet to identify maximum likelihood estimates for statistical models. However in this case it is used for something else: to work out the best 'mix' of East and West German life expectancy data to use to make a 'Synthetic Germany' which covers years in which Germany was not unified and so a single population estimate could not be produced. It produces candidate 'synthetic Germanies' by combining a weighted average of life expectancies for East and West Germany. The parameter that can be varied is the proportion of East Germany in the mix (and so by implication the proportion West Germany); and the loss function to minimise is the Root Mean Squared Error (RMSE) between life expectancy estimates for 'synthetic Germany' and *real* Germany over the period 1990 to 2010. 9 | 10 | Two scripts are included: one containing functions, and another containing heavily commented code. 11 | 12 | The heavily commented code works up to the use of `optim()` by first showing how a simple grid-search approach can be used. The grid search approach simply calculates RMSE for each full % share of East Germany possible, from 0% to 100%. 13 | 14 | The heavily commented code makes extensive use of functions and functional programming conventions using the `tidyverse`, and so depends on the `tidyverse` package and paradigms to work, and make sense of, respectively. 15 | 16 | The main script also draws directly from a data file from [another project I have been working on](https://github.com/jonminton/change_in_ex/), which extracts lifetables for all nations within the [Human Mortality Database](https://www.mortality.org) using the `HMDHFDplus` package. 17 | 18 | -------------------------------------------------------------------------------- /shiny/building_reports_from_excel/GRASS per subject.R: -------------------------------------------------------------------------------- 1 | ################################################################### 2 | # Identify the subject, test and class you want to graph # 3 | # using information from the TestScoresDBSep2018.xlsx file # 4 | # and set the values below accordingly # 5 | ################################################################### 6 | 7 | DoAll <- "no" # if "yes" then plots for all subjects will be produced as separate files but in one go 8 | WhichSubject <- "biology" # as per TestScoresDBSep2018.xlsx file 9 | 10 | ############################################### 11 | # Do not alter anything below this line # 12 | ############################################### 13 | 14 | df$marks_perc <- df$marks / df$max_marks * 100 15 | 16 | df$subject <- factor(tolower(df$subject)) 17 | df$test_desc <- factor(tolower(df$test_desc)) 18 | df$name_short <- factor(df$name_short) 19 | df$test_occ_no_f <- factor(paste("Occ", df$test_occ, sep=":")) 20 | 21 | 22 | setwd(paste(grass_directory, "GRASS Plots", sep='/')) 23 | 24 | if(DoAll=="no") { 25 | n <- 1 26 | subjects <- WhichSubject 27 | } 28 | 29 | if(DoAll=="yes") { 30 | n <- length(unique(df$subject)) 31 | subjects <- sort(unique(df$subject)) 32 | } 33 | 34 | for(i in 1:n) { 35 | print(i) 36 | print(paste(unique(df$subject[df$subject==subjects[i]]))) 37 | setwd(paste(grass_directory, "GRASS Plots", subjects[i], sep="/")) 38 | my_file_name <- unique(paste(df$subject[df$subject==subjects[i]])) 39 | adf <- df %>% filter (subject==subjects[i]) 40 | pdf (paste(my_file_name, "pdf", sep='.'), width=15, height=10) 41 | p1 <- ggplot(adf, aes(x=test_occ_no_f, y=marks_perc)) + 42 | geom_boxplot()+ 43 | facet_wrap(class~test_desc)+ 44 | ylab("% Score")+ 45 | xlab("Test Occ")+ 46 | scale_y_continuous(breaks = seq(0, 100, 10), limits=c(0,100))+ 47 | ggtitle(my_file_name) 48 | print(p1) 49 | dev.off() 50 | } 51 | 52 | 53 | 54 | 55 | 56 | -------------------------------------------------------------------------------- /excel_multiple_files_to_one/multiple_excel_files_to_one.R: -------------------------------------------------------------------------------- 1 | suppressPackageStartupMessages(library(rio)) 2 | suppressPackageStartupMessages(library(readxl)) 3 | suppressPackageStartupMessages(library(dplyr)) 4 | suppressPackageStartupMessages(library(purrr)) 5 | suppressPackageStartupMessages(library(data.table)) 6 | 7 | 8 | files <- dir(pattern = "*.xlsx") # in case other file types are in folder 9 | 10 | # base R f 11 | method_lapply <- lapply(files, read_excel) 12 | method_lapply <- do.call(rbind, Map(data.frame, method_lapply)) 13 | 14 | 15 | # purrr, using set_names to identify each source workbook 16 | 17 | method_purrr <- files %>% 18 | set_names() %>% 19 | map_dfr(read_excel, sheet = "Manchester",.id = "source_wb") 20 | 21 | 22 | # for loop and data.table 23 | 24 | filecount <- as.numeric(length(files)) 25 | temp_list <- list() 26 | 27 | for (i in seq_along(files)) { 28 | filename <- files[i] 29 | df <- read_excel(path = filename, sheet = "Manchester") 30 | df$source_wb <- filename 31 | temp_list[[i]] <- df 32 | rm(df) 33 | method_datatable <- data.table::rbindlist(temp_list, fill = TRUE) 34 | } 35 | rm(temp_list);rm(filecount);rm(filename);rm(i) 36 | 37 | 38 | # rio 39 | 40 | method_rio <- import_list(files, 41 | rbind = TRUE, 42 | rbind_label = "source_wb", #optional 43 | sheet = "Manchester") # will read the first sheet by default 44 | 45 | 46 | 47 | 48 | 49 | #read in and combine all worksheets from one file 50 | 51 | path <- "copy2.xlsx" 52 | all_sheets <- path %>% 53 | readxl::excel_sheets() %>% 54 | purrr::set_names() 55 | 56 | # optional - exclude the Targets sheet which is different to the others 57 | all_sheets <- all_sheets[which(!all_sheets %like% 'Targets')] 58 | 59 | # combine the remaining sheets and identify them using .x 60 | all_sheets_df <- map_dfr(all_sheets, 61 | ~ read_excel(path, sheet = .x), 62 | .id = "sheet") 63 | 64 | -------------------------------------------------------------------------------- /shiny/access_html_elements/README.md: -------------------------------------------------------------------------------- 1 | # Accessing HTML elements from shiny 2 | 3 | Sometimes you want to be able to use information from HTML elements which you can't get at using normal shiny ways. 4 | 5 | In this example, we have a simple app with an animated plotly plot which displays a scatter plot for each of three years. 6 | 7 | When clicking on a point in the plot we want to display data on the x and y values, but also on the current year. The x and y values can be obtained from plotly directly by registering the event of clicking on the point using `event_register()` and then using the `event_data()` object to get this information. However, the current year (given by the frame value) is not available. 8 | 9 | We can access the current year directly from the HTML, however, as it is displayed on the slider. This is done using a JavaScript snippet. 10 | 11 | ## What is going on in the JavaScript 12 | 13 | This is the JavaScript snippet: 14 | 15 | ```js 16 | // There are 4 elements with slider-label as class name, the first one is 17 | // the text on the top RHS of the slider, the other 3 are the slider options 18 | let text = document.getElementsByClassName('slider-label')[0].innerHTML; 19 | // get year out of inner text 20 | text = text.replace('year: ', ''); 21 | // Sends text to input$year_shiny 22 | Shiny.setInputValue('sliderYear', text); 23 | ``` 24 | 25 | - The first line finds all the HTML elements with class "slider-label". There are four of these: the first is the text on the top right hand side of the slider; the other three are the slider options below the slider. The inner HTML of the first one is assigned to a new local variable `text`. The inner HTML will be e.g. "year: 2001" 26 | 27 | - The second line gets just the year itself out of this text 28 | 29 | - The third line assigns this to `input$sliderYear`, which can then be accessed from shiny 30 | 31 | 32 | ## Important things to note 33 | 34 | - We must include `shinyjs::useShinyjs()` in the ui in order for `shinyjs::runjs()` to work 35 | 36 | -------------------------------------------------------------------------------- /shiny/excelReports/R/mod_per_test.R: -------------------------------------------------------------------------------- 1 | #' per_test UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList 10 | mod_per_test_ui <- function(id){ 11 | ns <- NS(id) 12 | tagList( 13 | 14 | fluidPage( 15 | # dynamic UI for three choices 16 | 17 | fluidRow( 18 | column(3, uiOutput(ns("which_subjectUI"))), 19 | column(3, uiOutput(ns("which_classUI"))), 20 | column(3, uiOutput(ns("which_test_descUI"))) 21 | ), 22 | 23 | fluidRow( 24 | 25 | downloadButton(ns("download_graphs")), 26 | ) 27 | ) 28 | ) 29 | } 30 | 31 | #' per_test Server Functions 32 | #' 33 | #' @noRd 34 | mod_per_test_server <- function(id, all_data){ 35 | moduleServer( id, function(input, output, session){ 36 | ns <- session$ns 37 | 38 | cleaned_data <- reactive({ 39 | 40 | df <- all_data() 41 | 42 | df$marks_perc <- df$marks / df$max_marks * 100 43 | df$subject <- factor(tolower(df$subject)) 44 | df$test_desc <- factor(tolower(df$test_desc)) 45 | 46 | return(df) 47 | }) 48 | 49 | output$which_subjectUI <- renderUI({ 50 | 51 | choices <- unique(cleaned_data()$subject) 52 | 53 | selectInput(session$ns("which_subject"), "Select subject", 54 | choices = choices) 55 | 56 | }) 57 | 58 | output$which_classUI <- renderUI({ 59 | 60 | choices <- unique(cleaned_data()$class) 61 | 62 | selectInput(session$ns("which_class"), "Select class", 63 | choices = choices) 64 | 65 | }) 66 | 67 | output$which_test_descUI <- renderUI({ 68 | 69 | choices <- unique(cleaned_data()$test_desc) 70 | 71 | selectInput(session$ns("which_test_desc"), "Select test description", 72 | choices = choices) 73 | 74 | }) 75 | 76 | }) 77 | } 78 | -------------------------------------------------------------------------------- /shiny/changingSelection/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(tidyverse) 3 | dta <- datasets::iris 4 | initial_selection <- names(dta)[sapply(dta, class) == "numeric"] 5 | ui <- fluidPage( 6 | titlePanel("Make an association plot"), 7 | sidebarLayout( 8 | sidebarPanel( 9 | selectInput("xvar_selection", 10 | "Choose variables for x axis:", 11 | choices = initial_selection 12 | ), 13 | # selectInput("yvar_selection", 14 | # "Choose variables for y axis:", 15 | # choices = initial_selection 16 | # ), 17 | uiOutput("yvar_ui"), 18 | checkboxInput("mark_species", 19 | "Check to use different symbols/colours for each species" 20 | ) 21 | 22 | ), 23 | mainPanel( 24 | plotOutput("scatterplot")#, 25 | # verbatimTextOutput("show_remaining_selection") 26 | ) 27 | ) 28 | ) 29 | # Define server logic required to draw a histogram 30 | server <- function(input, output) { 31 | 32 | # get_selection <- reactive({ 33 | # dta %>% 34 | # select(input$xvar_selection, input$yvar_selection) 35 | # }) 36 | 37 | get_remaining_selection <- reactive({ 38 | xvar <- input$xvar_selection 39 | 40 | initial_selection[initial_selection != xvar] 41 | }) 42 | 43 | output$scatterplot <- renderPlot({ 44 | req(input$yvar_selection) 45 | 46 | gg <- 47 | dta %>% 48 | ggplot(aes(x = .data[[input$xvar_selection]], y = .data[[input$yvar_selection]])) 49 | 50 | if (input$mark_species) { 51 | gg <- gg + geom_point(aes(shape = Species, colour = Species)) 52 | 53 | } else { 54 | gg <- gg + geom_point() 55 | } 56 | 57 | gg 58 | }) 59 | 60 | # output$show_remaining_selection <- renderText({ 61 | # get_remaining_selection() 62 | # }) 63 | 64 | output$yvar_ui <- renderUI({ 65 | selectInput("yvar_selection", 66 | "Choose variables for y axis:", 67 | choices = get_remaining_selection() 68 | ) 69 | }) 70 | } 71 | # Run the application 72 | shinyApp(ui = ui, server = server) -------------------------------------------------------------------------------- /ggplot/camcoder/01 Download RTT data.R: -------------------------------------------------------------------------------- 1 | ## 01 Download RTT data 2 | 3 | # MAIN WEBSITE FOR THIS INDICATOR 4 | # Consultant-led Referral to Treatment (RTT) waiting times 5 | # https://www.england.nhs.uk/statistics/statistical-work-areas/rtt-waiting-times/ 6 | # FULL month sets of data 7 | # APRIL 2022 Full CSV data file Apr22 (ZIP, 3300K) 8 | # MAY 2022 Full CSV data file May22 (ZIP, 3611K) 9 | # JUNE 2022 Full CSV data file Jun22(ZIP, 3886K) 10 | 11 | # Function to download RTT data from NHS England website 12 | RTTdata <- function() { 13 | 14 | if(!dir.exists("data")){dir.create("data")} 15 | 16 | # Download master.zip file APRIL 2022 d 17 | # And unzip April file as .csv file 18 | download.file( 19 | url = 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2022/06/Full-CSV-data-file-Apr22-ZIP-3300K-57873-1.zip', 20 | destfile = "data/RTTapr22.zip" 21 | ) 22 | unzip(zipfile = "data/RTTapr22.zip",exdir = "data",junkpaths = T) 23 | # Download master .zip file MAY 2022 24 | # And unzip May file as .csv file 25 | download.file( 26 | url = 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2022/07/Full-CSV-data-file-May22-ZIP-3611K-16155.zip', 27 | destfile = "data/RTTmay22.zip" 28 | ) 29 | unzip(zipfile = "data/RTTmay22.zip",exdir = "data",junkpaths = T) 30 | 31 | # Download master .zip file JUNE 2022 32 | # And unzip June file as .csv file 33 | download.file( 34 | url = 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2022/08/Full-CSV-data-file-Jun22ZIP-3886K-68395.zip', 35 | destfile = "data/RTTjun22.zip" 36 | ) 37 | unzip(zipfile = "data/RTTjun22.zip",exdir = "data",junkpaths = T) 38 | 39 | } 40 | 41 | 42 | # Download RTT data function (no arguments) 43 | RTTdata() -------------------------------------------------------------------------------- /create_filter_from_logic_evaluation/Readme.md: -------------------------------------------------------------------------------- 1 | 2 | This script shows how to convert logical values (TRUE/FALSE) into a string which can then be evaluated as an expression using str2expression() 3 | 4 | But why would you want to do this? 5 | 6 | Most data extraction in the NHS reuses the same code chunks and is often repeated to answer different questions. It seemed sensible to replace the copy and paste process with a definition of a search strategy and then logically interpret that. 7 | 8 | e.g search for men over 18 years of age with severe pain attending the ED between x & y who have a raised creatinine 9 | 10 | Defining variables such as: 11 | 12 | ``` 13 | men <- TRUE 14 | min_age <- 18 15 | max_age <- 100 16 | presenting_complaint <- c( 17 | 'Back Pain' 18 | ) 19 | min_date <- '2022-06-01 23:59:59'#'YYYY-MM-DD hh:mm:ss' 20 | max_date <- '2022-06-05 23:59:59'#'YYYY-MM-DD hh:mm:ss' 21 | 22 | ``` 23 | Gets you most of the way to being able to drop these variables into a search strategy and just change a config file to define the search each time. 24 | 25 | However defining a reproducible method for evaluating a clinical event mathematically is a little more complex. 26 | 27 | The approach showin in the [filter_creation](filter_creation.R) script shows how the following variables: 28 | 29 | ``` 30 | ce1_use_filter <- TRUE 31 | ce1_event_name <- 'Troponin Serum' 32 | # This option can also be used to identify pts without this event 33 | ce1_occured <- TRUE 34 | ce1_result_evaluation <- TRUE 35 | 36 | equal_to_ce1_result <- FALSE 37 | greater_than_ce1_result <- FALSE 38 | greater_than_or_equal_to_ce1_result <- TRUE 39 | less_than_ce1_result <- FALSE 40 | less_than_or_equal_to_ce1_result <- FALSE 41 | 42 | ce1_result <- "14" 43 | ``` 44 | Can be used to create the expression 45 | 46 | ``` 47 | ce1_filter <- "EVENT == 'Troponin Serum' & EVENT_RESULT_TXT >=14" 48 | ``` 49 | 50 | Which can then be evaluated locally using: 51 | 52 | ``` 53 | dataframe %>% 54 | filter(eval(str2expression(ce1_filter))) 55 | ``` 56 | 57 | or on a remote database using 58 | 59 | ``` 60 | dataframe %>% 61 | filter(!!parse_expr(ce1_filter)) 62 | ``` 63 | 64 | The script does this using penguin data. 65 | -------------------------------------------------------------------------------- /shiny/excelReports/R/app_ui.R: -------------------------------------------------------------------------------- 1 | #' The application User-Interface 2 | #' 3 | #' @param request Internal parameter for `{shiny}`. 4 | #' DO NOT REMOVE. 5 | #' @import shiny 6 | #' @import shinydashboard 7 | #' @noRd 8 | app_ui <- function(request) { 9 | tagList( 10 | # Leave this function for adding external resources 11 | golem_add_external_resources(), 12 | # Your application UI logic 13 | dashboardPage( 14 | 15 | dashboardHeader(title = "Excel reports"), 16 | dashboardSidebar( 17 | width = 300, 18 | sidebarMenu( 19 | 20 | menuItem("Upload data", 21 | tabName = "upload-data"), 22 | menuItem("Download graphs", 23 | tabName = "download_graphs") 24 | 25 | ) 26 | ), 27 | dashboardBody( 28 | 29 | tabItems( 30 | tabItem(tabName = "upload-data", 31 | mod_upload_data_ui("upload_data_ui_1") 32 | ), 33 | tabItem(tabName = "download_graphs", 34 | h3("Per class"), 35 | mod_per_class_ui("per_class_ui_1"), 36 | 37 | h3("Per student"), 38 | mod_per_student_ui("per_student_ui_1"), 39 | 40 | h3("Per subject"), 41 | mod_per_subject_ui("per_subject_ui_1"), 42 | 43 | h3("Per test"), 44 | mod_per_test_ui("per_test_ui_1") 45 | ) 46 | ) 47 | ) 48 | ) 49 | ) 50 | } 51 | 52 | #' Add external Resources to the Application 53 | #' 54 | #' This function is internally used to add external 55 | #' resources inside the Shiny application. 56 | #' 57 | #' @import shiny 58 | #' @importFrom golem add_resource_path activate_js favicon bundle_resources 59 | #' @noRd 60 | golem_add_external_resources <- function(){ 61 | 62 | add_resource_path( 63 | 'www', app_sys('app/www') 64 | ) 65 | 66 | tags$head( 67 | favicon(), 68 | bundle_resources( 69 | path = app_sys('app/www'), 70 | app_title = 'excelReports' 71 | ) 72 | # Add here other external resources 73 | # for example, you can add shinyalert::useShinyalert() 74 | ) 75 | } 76 | 77 | -------------------------------------------------------------------------------- /Sending_Emails/Sending_Emails.R: -------------------------------------------------------------------------------- 1 | #Sending emails directly from R is a useful addition to your automated workflow 2 | 3 | # Set Up ------------------------------------------------------------------ 4 | 5 | #There are 2 bits of set up to do first 6 | 7 | #1. If using an @nhs.net account ask your IT department to enable smtp on your account 8 | 9 | #2. You need to "tell" R your email address and password 10 | # The best practice for doing this is storing them in you .Renviron file 11 | 12 | #Run the following code to open the file 13 | 14 | usethis::edit_r_environ() 15 | 16 | #Then add your credentials 17 | 18 | EMAIL_ADDRESS = "name.name@nhs.net" 19 | EMAIL_PASSWORD = "This!s@Pa55word" 20 | 21 | #Save and close the file 22 | #These variales can be retrieved using the Sys.getenv() function 23 | 24 | # Send an Email ----------------------------------------------------------- 25 | 26 | #There are a few packages to choose from, below are a couple that have worked for members of the community 27 | #mailR 28 | 29 | library(mailR) 30 | 31 | #update the to, subject, body and file_path as required 32 | 33 | mailR::send.mail( 34 | from = Sys.getenv("EMAIL_ADDRESS"), 35 | to = to, 36 | subject = subject, 37 | body = body, 38 | smtp = list(host.name = "send.nhs.net", 39 | port = 587, 40 | user.name = Sys.getenv("EMAIL_ADDRESS"), 41 | passwd = Sys.getenv("EMAIL_PASSWORD"), 42 | tls = TRUE), 43 | authenticate = TRUE, 44 | send = TRUE, 45 | attach.files = file_path 46 | ) 47 | 48 | #If you have java issues with the mailR package then you can try the emayili package 49 | 50 | library(emayili) 51 | 52 | smtp <- emayili::server(host = "send.nhs.net", 53 | port = 587, 54 | username = Sys.getenv("EMAIL_ADDRESS"), 55 | password = Sys.getenv("EMAIL_PASSWORD")) 56 | 57 | #Set up the email; update the to, subject, body and file_path as required 58 | 59 | email <- emayili::envelope() %>% 60 | emayili::Sys.getenv("EMAIL_ADDRESS") %>% 61 | emayili::to(to) %>% 62 | emayili::subject(subject) %>% 63 | emayili::text(body) %>% 64 | emayili::attachment(file_path) 65 | 66 | #Send the email 67 | 68 | smtp(email, verbose = TRUE) 69 | 70 | #Congratulations! You should now be able to send emails from your nhs.net email! 71 | -------------------------------------------------------------------------------- /ggplot/camcoder/A Using Google fonts in plots.R: -------------------------------------------------------------------------------- 1 | # Source: showtext: Using Fonts More Easily in R Graphs 2 | # https://cran.rstudio.com/web/packages/showtext/vignettes/introduction.html 3 | 4 | library(showtext) 5 | library(here) 6 | library(tidyverse) 7 | here() 8 | 9 | # font_add_google() 10 | font_add_google("Schoolbell", "bell") 11 | font_add_google("Gochi Hand", "gochi") 12 | 13 | 14 | # Fonts I am exploring for maps and charts 15 | font_add_google("Barlow", "Barlow") 16 | font_add_google("Barlow Condensed", "barlow condensed") 17 | font_add_google("Didact Gothic","didact gothic") 18 | 19 | 20 | # Code sample for bell google font 21 | # PLOT 01> plot a histogram using "bell" family font 22 | hist(rnorm(1000),breaks = 30, col = "steelblue", border = "white", 23 | main = "", xlab = "", ylab = "") 24 | showtext_begin() 25 | title("Normal Histogram - bell google font", family = "bell", cex.main = 2) 26 | title(ylab = "Frequency", family = "bell", cex.lab = 2) 27 | text(2, 70, "N = 1000", family = "bell", cex = 2.5) 28 | showtext_end() 29 | 30 | ggsave("bell_font_example.png", width = 10, height = 6) 31 | 32 | # PLOT 02> plot a histogram using "gochi" family font 33 | # Using Family = gochi" 34 | hist(rnorm(1000),breaks = 30, col = "steelblue", border = "white", 35 | main = "", xlab = "", ylab = "") 36 | showtext_begin() 37 | title("Normal Histogram - gochi google font", family = "gochi", cex.main = 2) 38 | title(ylab = "Frequency", family = "gochi", cex.lab = 2) 39 | text(2, 70, "N = 1000", family = "gochi", cex = 2.5) 40 | showtext_end() 41 | 42 | ggsave("plots/bell_font_example.png", width = 10, height = 6) 43 | 44 | # PLOT 03> plot a histogram using "Barlow condensed" family font 45 | # Using Family = "Barlow condensed" 46 | showtext_auto() 47 | 48 | set.seed(123) 49 | hist(rnorm(1000), breaks = 30, col = "steelblue", border = "white", 50 | main = "", xlab = "", ylab = "") 51 | title("Histogram of Normal Numbers- Barlow ", family = "barlow condensed", cex.main = 2) 52 | title(ylab = "Frequency", family = "barlow condensed", cex.lab = 2) 53 | text(2, 70, "N = 1000", family = "barlow condensed", cex = 2.5) 54 | 55 | # PLOT 04> plot a histogram using "didact gothic" family font 56 | # Using Family = "didact gothic" 57 | showtext_auto() 58 | 59 | set.seed(123) 60 | hist(rnorm(1000), breaks = 30, col = "steelblue", border = "white", 61 | main = "", xlab = "", ylab = "") 62 | title("Histogram of Normal Numbers- didact gothic ", family = "didact gothic", cex.main = 2) 63 | title(ylab = "Frequency", family = "didact gothic", cex.lab = 2) 64 | text(2, 70, "N = 1000", family = "didact gothic", cex = 2.5) 65 | -------------------------------------------------------------------------------- /shiny/excelReports/dev/01_start.R: -------------------------------------------------------------------------------- 1 | # Building a Prod-Ready, Robust Shiny Application. 2 | # 3 | # README: each step of the dev files is optional, and you don't have to 4 | # fill every dev scripts before getting started. 5 | # 01_start.R should be filled at start. 6 | # 02_dev.R should be used to keep track of your development during the project. 7 | # 03_deploy.R should be used once you need to deploy your app. 8 | # 9 | # 10 | ######################################## 11 | #### CURRENT FILE: ON START SCRIPT ##### 12 | ######################################## 13 | 14 | ## Fill the DESCRIPTION ---- 15 | ## Add meta data about your application 16 | ## 17 | ## /!\ Note: if you want to change the name of your app during development, 18 | ## either re-run this function, call golem::set_golem_name(), or don't forget 19 | ## to change the name in the app_sys() function in app_config.R /!\ 20 | ## 21 | golem::fill_desc( 22 | pkg_name = "excelReports", # The Name of the package containing the App 23 | pkg_title = "Making school reports with Shiny and golem", # The Title of the package containing the App 24 | pkg_description = "This is a Shiny application that automates school based reporting. 25 | The user can select a class and/ or a student and produce reports based on 26 | their selection", # The Description of the package containing the App 27 | author_first_name = "Chris", # Your First Name 28 | author_last_name = "Beeley", # Your Last Name 29 | author_email = "chris.beeley@gmail.com", # Your Email 30 | repo_url = NULL # The URL of the GitHub Repo (optional) 31 | ) 32 | 33 | ## Set {golem} options ---- 34 | golem::set_golem_options() 35 | 36 | ## Create Common Files ---- 37 | ## See ?usethis for more information 38 | usethis::use_mit_license( "NHS-R" ) # You can set another license here 39 | # usethis::use_readme_rmd( open = FALSE ) 40 | # usethis::use_code_of_conduct() 41 | # usethis::use_lifecycle_badge( "Experimental" ) 42 | # usethis::use_news_md( open = FALSE ) 43 | 44 | ## Use git ---- 45 | usethis::use_git() 46 | 47 | ## Init Testing Infrastructure ---- 48 | ## Create a template for tests 49 | golem::use_recommended_tests() 50 | 51 | ## Use Recommended Packages ---- 52 | golem::use_recommended_deps() 53 | 54 | ## Favicon ---- 55 | # If you want to change the favicon (default is golem's one) 56 | golem::use_favicon() # path = "path/to/ico". Can be an online file. 57 | golem::remove_favicon() 58 | 59 | ## Add helper functions ---- 60 | golem::use_utils_ui() 61 | golem::use_utils_server() 62 | 63 | # You're now set! ---- 64 | 65 | # go to dev/02_dev.R 66 | rstudioapi::navigateToFile( "dev/02_dev.R" ) 67 | 68 | -------------------------------------------------------------------------------- /rmarkdown/rmarkdown_functions_and_functionals/script_to_run_template.R: -------------------------------------------------------------------------------- 1 | 2 | # Code to run the template 3 | 4 | pacman::p_load(tidyverse, here) 5 | 6 | 7 | country_code_df <- tribble( 8 | ~code, ~country, 9 | "AUS", "Australia", 10 | "AUT", "Austria", 11 | "BLR", "Belarus", 12 | "BEL", "Beligium", 13 | "BGR", "Bulgaria", 14 | "CAN", "Canada", 15 | "CHL", "Chile", 16 | "HRV", "Croatia", 17 | "CZE", "Czechia", 18 | "DNK", "Denmark", 19 | "EST", "Estonia", 20 | "FIN", "Finland", 21 | "FRATNP", "France", 22 | "DEUTNP", "Germany", 23 | "GRC", "Greece", 24 | "HUN", "Hungary", 25 | "ISL", "Iceland", 26 | "IRL", "Ireland", 27 | "ISR", "Israel", 28 | "ITA", "Italy", 29 | "JPN", "Japan", 30 | "KOR", "Korea", 31 | "LVA", "Latvia", 32 | "LTU", "Lithuania", 33 | "LUX", "Luxembourg", 34 | "NLD", "Netherlands", 35 | "NZL_NP", "New Zealand", 36 | "NOR", "Norway", 37 | "POL", "Poland", 38 | "PRT", "Portugal", 39 | "RUS", "Russia", 40 | "SVK", "Slovakia", 41 | "SVN", "Slovenia", 42 | "ESP", "Spain", 43 | "SWE", "Sweden", 44 | "CHE", "Switzerland", 45 | "TWN", "Taiwan", 46 | "GBR_NP", "United Kingdom", 47 | "USA", "USA", 48 | "UKR", "Ukraine" 49 | ) 50 | 51 | # Make render function and render for one population 52 | all_lt <- read_rds("https://github.com/JonMinton/change-in-ex/blob/main/data/lifetables.rds?raw=true") 53 | 54 | render_country_report <- function(code, country){ 55 | rmarkdown::render( 56 | here("rmarkdown", "rmarkdown_functions_and_functionals", "markdown_template.rmd"), # this is where the markdown document to use as a template is located 57 | output_dir = here("rmarkdown", "rmarkdown_functions_and_functionals", "outputs"), # This is the output directory 58 | output_file = paste0(code, "-", country, ".html"), # a filename specific to each output generated 59 | params = list(code = code, country = country), # these are the parameters to pass to the .rmd tempalte 60 | envir = parent.frame(), # This ensures the markdown document can 'see' contents created here 61 | output_format = "html_document", 62 | ) 63 | } 64 | 65 | # An example for a single country 66 | 67 | render_country_report(code = "CHE", country = "Switzerland") 68 | 69 | 70 | # Generate for all countries 71 | 72 | 73 | ## using a for loop 74 | 75 | N_rows <- nrow(country_code_df) 76 | 77 | for (i in 1:N_rows){ 78 | this_code <- country_code_df$code[i] 79 | this_country <- country_code_df$country[i] 80 | 81 | render_country_report(code = this_code, country = this_country) 82 | } 83 | 84 | 85 | # Using functional programming and walk2 86 | 87 | country_code_df %>% 88 | mutate( 89 | NULL = walk2(code, country, render_country_report) 90 | ) 91 | 92 | # tmp doesn't really do anything! -------------------------------------------------------------------------------- /shiny/excelReports/R/mod_per_subject.R: -------------------------------------------------------------------------------- 1 | #' per_subject UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList 10 | mod_per_subject_ui <- function(id){ 11 | ns <- NS(id) 12 | tagList( 13 | 14 | fluidPage( 15 | 16 | checkboxInput(ns("all_graphs"), "Return all subjects?"), 17 | 18 | conditionalPanel( 19 | condition = "input.all_graphs==0", ns = ns, 20 | 21 | uiOutput(ns("which_subjectUI")) 22 | ), 23 | 24 | downloadButton(ns("download_graphs")), 25 | ) 26 | ) 27 | } 28 | 29 | #' per_subject Server Functions 30 | #' 31 | #' @noRd 32 | mod_per_subject_server <- function(id, all_data){ 33 | moduleServer( id, function(input, output, session){ 34 | ns <- session$ns 35 | 36 | output$which_subjectUI <- renderUI({ 37 | 38 | choices = unique(all_data()$subject) 39 | 40 | selectInput(session$ns("which_subject"), "Select subject", 41 | choices = choices) 42 | }) 43 | 44 | output$download_graphs <- downloadHandler( 45 | 46 | filename = "graphs.zip", 47 | content = function(file) { 48 | 49 | df <- all_data() 50 | 51 | df$marks_perc <- df$marks / df$max_marks * 100 52 | 53 | df$subject <- factor(tolower(df$subject)) 54 | df$test_desc <- factor(tolower(df$test_desc)) 55 | df$test_occ_no_f <- factor(paste("Occ", df$test_occ, sep=":")) 56 | 57 | 58 | if(input$all_graphs) { 59 | 60 | subjects <- sort(unique(df$subject)) 61 | 62 | } else { 63 | 64 | subjects <- input$which_subject 65 | } 66 | 67 | files <- NULL 68 | 69 | myDir <- tempdir() 70 | 71 | for(i in subjects) { 72 | 73 | my_file_name <- paste0(i, ".pdf") 74 | 75 | adf <- df %>% 76 | dplyr::filter(subject == i) 77 | 78 | pdf(file.path(myDir, my_file_name), width = 15, height = 10) 79 | 80 | p1 <- ggplot2::ggplot(adf, 81 | ggplot2::aes(x = test_occ_no_f, 82 | y = marks_perc)) + 83 | ggplot2::geom_boxplot() + 84 | ggplot2::facet_wrap(class ~ test_desc) + 85 | ggplot2::ylab("% Score") + 86 | ggplot2::xlab("Test Occ") + 87 | ggplot2::scale_y_continuous(breaks = seq(0, 100, 10), 88 | limits = c(0, 100)) + 89 | ggplot2::ggtitle(my_file_name) 90 | print(p1) 91 | 92 | files <- c(my_file_name, files) 93 | dev.off() 94 | } 95 | zip(file, file.path(myDir, files), flags = "-j") 96 | } 97 | ) 98 | }) 99 | } 100 | -------------------------------------------------------------------------------- /rmarkdown/loop_graphs/loop_dataframe_graphs_medicaldata.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Loop graphs in RMarkdown using medicaldata" 3 | author: "Zoë Turner" 4 | date: "04/09/2021" 5 | output: html_document 6 | --- 7 | 8 | # Original RMarkdown 9 | 10 | This example is a copy of the original by [Chris Beeley](https://github.com/nhs-r-community/demos-and-how-tos/blob/main/rmarkdown/loop_graphs/loop_dataframe_graphs.Rmd) which uses the {palmerpenguins} package. Chris and I were contacted by [Peter Higgins](https://twitter.com/ibddoctor) after our discussions about this on [Twitter](https://twitter.com/Letxuga007/status/1433729592896991261) and he shared the code for the package {medicaldata} using the same format Chris had shared. This is is his code within the original RMarkdown layout that Chris had created. 11 | 12 | ```{r setup, include=FALSE} 13 | 14 | knitr::opts_chunk$set(echo = TRUE) 15 | 16 | # install.package("medicaldata") # uncomment to load package from CRAN 17 | 18 | library(medicaldata) 19 | library(tidyverse) 20 | 21 | # load the covid_testing data from the package 22 | 23 | covid <- medicaldata::covid_testing 24 | 25 | # make several datasets 26 | 27 | covid_1 <- covid %>% 28 | filter(clinic_name == "emergency dept") 29 | 30 | covid_2 <- covid %>% 31 | filter(clinic_name == "inpatient ward a") 32 | 33 | covid_3 <- covid %>% 34 | filter(clinic_name == "urgent care center") 35 | 36 | lots_of_tests <- list(covid_1, covid_2, covid_3) 37 | 38 | ``` 39 | 40 | Sometimes you may wish to run the same plotting function on multiple datasets. There's a simple way and a slightly-weird-but-works way. 41 | 42 | Note that this is a contrived example and that this is not the simplest way of doing this particular thing. 43 | 44 | ### Simple 45 | 46 | For this data (unlike for {palmerpenguins}) there are warnings about rows being deleted because of missing values. 47 | 48 | ```{r} 49 | 50 | walk(lots_of_tests, function(x) { 51 | 52 | p <- x %>% 53 | ggplot(aes(ct_result, pan_day)) + 54 | geom_point() + 55 | labs(x = "PCR Result\n(lower threshold cycle # means higher viral load", 56 | y = "Pandemic Day") 57 | 58 | print(p) 59 | }) 60 | ``` 61 | 62 | ### Slightly-weird-but-works 63 | 64 | ```{r} 65 | 66 | walk(paste0("covid_", 1 : 3), function(x) { 67 | 68 | df <- get(x) 69 | 70 | p <- df %>% 71 | ggplot(aes(ct_result, pan_day)) + 72 | geom_point() + 73 | labs(x = "PCR Result\n(lower threshold cycle # means higher viral load", 74 | y = "Pandemic Day") 75 | 76 | print(p) 77 | }) 78 | 79 | ``` 80 | 81 | ### Add a title 82 | 83 | ```{r} 84 | 85 | testgroup_names <- c("Covid tests in ED", "Covid tests in inpatient Ward A", "Covid tests in Urgent Care") 86 | 87 | walk2(lots_of_tests, testgroup_names, function(x, y) { 88 | 89 | p <- x %>% 90 | ggplot(aes(ct_result, pan_day)) + 91 | geom_point() + 92 | ggtitle(y) + 93 | labs(x = "PCR Result\n(lower threshold cycle # means higher viral load)", 94 | y = "Pandemic Day") 95 | 96 | print(p) 97 | }) 98 | 99 | ``` 100 | 101 | -------------------------------------------------------------------------------- /shiny/excelReports/R/mod_per_class.R: -------------------------------------------------------------------------------- 1 | #' per_class UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList 10 | mod_per_class_ui <- function(id){ 11 | ns <- NS(id) 12 | tagList( 13 | 14 | fluidPage( 15 | 16 | uiOutput(ns("which_classUI")), 17 | 18 | downloadButton(ns("download_graphs")), 19 | ) 20 | ) 21 | } 22 | 23 | #' per_class Server Functions 24 | #' 25 | #' @noRd 26 | mod_per_class_server <- function(id, all_data){ 27 | moduleServer( id, function(input, output, session){ 28 | ns <- session$ns 29 | 30 | output$which_classUI <- renderUI({ 31 | 32 | choices <- unique(all_data()$class) 33 | 34 | selectInput(ns("which_class"), "Select class", 35 | choices = choices) 36 | }) 37 | 38 | output$download_graphs <- downloadHandler( 39 | 40 | filename = "graphs.zip", 41 | content = function(file) { 42 | 43 | WhichClass <- input$which_class 44 | 45 | df <- all_data() 46 | 47 | df$marks_perc <- df$marks / df$max_marks * 100 48 | 49 | df$subject <- factor(tolower(df$subject)) 50 | df$test_desc <- factor(tolower(df$test_desc)) 51 | df$name_short <- factor(df$name_short2) 52 | df$test_occ_no_f <- factor(paste("Occ", df$test_occ, sep=":")) 53 | 54 | df <- df[df$class == WhichClass, ] 55 | 56 | admission_numbers <- unique(df$adm_no) 57 | 58 | n_subjects <- length(unique(levels(df$subject))) 59 | n_pupils <- length(unique((df$adm_no))) 60 | 61 | files <- NULL 62 | 63 | myDir = tempdir() 64 | 65 | for (i in 1 : n_pupils) { 66 | xdf <- df[df$adm_no == admission_numbers[i], ] 67 | for(j in 1:n_subjects) { 68 | my_file_name <- 69 | paste0(xdf$name_short[xdf$adm_no==admission_numbers[i]], "_AdmNo_", 70 | xdf$adm_no[xdf$adm_no==admission_numbers[i]], 71 | "_Class_", xdf$class[xdf$adm_no==admission_numbers[i]], ".pdf") 72 | 73 | pdf(file.path(myDir, my_file_name), width = 15, height = 10) 74 | 75 | p1 <- ggplot2::ggplot(xdf, 76 | ggplot2::aes(x = test_occ_no_f, 77 | y = marks_perc, 78 | group = name_short)) + 79 | ggplot2::geom_line() + 80 | ggplot2::geom_point() + 81 | ggplot2::facet_wrap(subject ~ test_desc) + 82 | ggplot2::ylab("% Score") + 83 | ggplot2::xlab("Test Occ") + 84 | ggplot2::scale_y_continuous(breaks = seq(0, 100, 10), 85 | limits = c(0, 100)) + 86 | ggplot2::ggtitle(my_file_name) 87 | print(p1) 88 | 89 | files <- c(my_file_name, files) 90 | dev.off() 91 | } 92 | } 93 | zip(file, file.path(myDir, files), flags = "-j") 94 | } 95 | ) 96 | }) 97 | } 98 | -------------------------------------------------------------------------------- /shiny/building_reports_from_excel/GRASS per test.R: -------------------------------------------------------------------------------- 1 | ################################################################### 2 | # Identify the subject, test and class you want to graph # 3 | # using information from the TestScoresDBSep2018.xlsx file # 4 | # and set the values below accordingly # 5 | ################################################################### 6 | 7 | WhichSubject <- "urdu" # subject name in "" - as per TestScoresDBSep2018.xlsx file 8 | WhichTestDesc <- "summer 2019 exam" # test desc as in "" - as per TestScoresDBSep2018.xlsx file 9 | WhichClass <- "8" # class id in "" - as per TestScoresDBSep2018.xlsx file 10 | 11 | ############################################### 12 | # Do not alter anything below this line # 13 | ############################################### 14 | 15 | df$marks_perc <- df$marks / df$max_marks * 100 16 | df$subject <- factor(tolower(df$subject)) 17 | df$test_desc <- factor(tolower(df$test_desc)) 18 | 19 | WhichSubject <- tolower(WhichSubject) 20 | WhichTestDesc <- tolower(WhichTestDesc) 21 | 22 | df <- df %>% 23 | dplyr::filter(class == WhichClass, 24 | subject == WhichSubject, 25 | test_desc == WhichTestDesc) 26 | 27 | # init 28 | my_file_name <- paste0( 29 | paste("Yr", df$class[df$test_desc==WhichTestDesc], 30 | df$subject[df$test_desc==WhichTestDesc], 31 | df$test_desc[df$test_desc==WhichTestDesc], 32 | "Occ", 33 | max(df$test_occ[df$test_desc==WhichTestDesc]), 34 | max(df$test_date[df$test_desc==WhichTestDesc]), sep = "_"), 35 | ".pdf") 36 | 37 | pdf (paste(my_file_name, "pdf", sep='.'), width=15, height=10) 38 | df$name_short <- factor(df$name_short) 39 | df$test_occ_no_f <- factor(paste("Occ", df$test_occ, sep=":")) 40 | 41 | # plot 1 - boxplot 42 | ggplot(df, aes(x=test_occ_no_f, y=marks_perc))+ 43 | geom_boxplot()+ 44 | ylab("% Score")+ 45 | xlab("Test Occ")+ 46 | scale_y_continuous(breaks = seq(0, 100, 10), limits=c(0,100))+ 47 | ggtitle(unique(paste("Yr", df$year, "Class", df$class, df$subject, df$test_desc, df$test_date, sep=":"))) 48 | 49 | 50 | # plot 2 - facet per pupil 51 | df$name_short <- with(df, factor(name_short, levels = sort(levels(name_short)))) 52 | ggplot(df, aes(x=test_occ_no_f, y=marks_perc, group=name_short))+ 53 | geom_point()+ 54 | geom_line()+ 55 | facet_wrap(~name_short)+ 56 | xlab("Test occasion number")+ 57 | ylab("% Score")+ 58 | scale_y_continuous(breaks = seq(0, 100, 10), limits=c(0,100))+ 59 | ggtitle(unique(paste("Yr", df$year, "Class", df$class, df$subject, df$test_desc, df$test_date, sep=":"))) 60 | 61 | # plot 3 - dot plot 62 | df$name_short <- with(df, factor(name_short, levels = rev(levels(name_short)))) 63 | sdf <- 64 | df %>% 65 | group_by(test_occ_no_f) %>% 66 | summarise(mu=round(mean(marks_perc, na.rm=T),0)) 67 | 68 | ggplot(df, aes(y=name_short, x=marks_perc))+ 69 | geom_point()+ 70 | facet_wrap(~test_occ_no_f)+ 71 | geom_vline(data=sdf,aes(xintercept=mu, group=test_occ_no_f), color='grey', size=1)+ 72 | xlab("% Score")+ 73 | ylab("Pupil Name")+ 74 | scale_x_continuous(breaks = seq(0, 100, 10), limits=c(0,100))+ 75 | ggtitle(unique(paste("Yr", df$year, "Class", df$class, df$subject, df$test_desc, df$test_date, sep=":"))) 76 | 77 | dev.off() 78 | 79 | 80 | 81 | 82 | -------------------------------------------------------------------------------- /shiny/excelReports/dev/02_dev.R: -------------------------------------------------------------------------------- 1 | # Building a Prod-Ready, Robust Shiny Application. 2 | # 3 | # README: each step of the dev files is optional, and you don't have to 4 | # fill every dev scripts before getting started. 5 | # 01_start.R should be filled at start. 6 | # 02_dev.R should be used to keep track of your development during the project. 7 | # 03_deploy.R should be used once you need to deploy your app. 8 | # 9 | # 10 | ################################### 11 | #### CURRENT FILE: DEV SCRIPT ##### 12 | ################################### 13 | 14 | stop() # in case I run all by accident 15 | 16 | # Engineering 17 | 18 | usethis::use_pipe() 19 | 20 | ## Dependencies ---- 21 | ## Add one line by package you want to add as dependency 22 | usethis::use_package( "ggplot2" ) 23 | usethis::use_package( "readxl" ) 24 | usethis::use_package( "datamods" ) 25 | usethis::use_package( "shinydashboard" ) 26 | 27 | ## Add modules ---- 28 | ## Create a module infrastructure in R/ 29 | golem::add_module( name = "upload_data" ) # Name of the module 30 | golem::add_module( name = "per_class" ) # Name of the module 31 | golem::add_module( name = "per_student" ) # Name of the module 32 | golem::add_module( name = "per_subject" ) # Name of the module 33 | golem::add_module( name = "per_test" ) # Name of the module 34 | 35 | ## Add helper functions ---- 36 | ## Creates fct_* and utils_* 37 | golem::add_fct( "helpers" ) 38 | golem::add_utils( "helpers" ) 39 | 40 | ## External resources 41 | ## Creates .js and .css files at inst/app/www 42 | golem::add_js_file( "script" ) 43 | golem::add_js_handler( "handlers" ) 44 | golem::add_css_file( "custom" ) 45 | 46 | ## Add internal datasets ---- 47 | ## If you have data in your package 48 | usethis::use_data_raw( name = "my_dataset", open = FALSE ) 49 | 50 | ## Tests ---- 51 | ## Add one line by test you want to create 52 | usethis::use_test( "app" ) 53 | 54 | # Documentation 55 | 56 | ## Vignette ---- 57 | usethis::use_vignette("excelReports") 58 | devtools::build_vignettes() 59 | 60 | ## Code Coverage---- 61 | ## Set the code coverage service ("codecov" or "coveralls") 62 | usethis::use_coverage() 63 | 64 | # Create a summary readme for the testthat subdirectory 65 | covrpage::covrpage() 66 | 67 | ## CI ---- 68 | ## Use this part of the script if you need to set up a CI 69 | ## service for your application 70 | ## 71 | ## (You'll need GitHub there) 72 | usethis::use_github() 73 | 74 | # GitHub Actions 75 | usethis::use_github_action() 76 | # Chose one of the three 77 | # See https://usethis.r-lib.org/reference/use_github_action.html 78 | usethis::use_github_action_check_release() 79 | usethis::use_github_action_check_standard() 80 | usethis::use_github_action_check_full() 81 | # Add action for PR 82 | usethis::use_github_action_pr_commands() 83 | 84 | # Travis CI 85 | usethis::use_travis() 86 | usethis::use_travis_badge() 87 | 88 | # AppVeyor 89 | usethis::use_appveyor() 90 | usethis::use_appveyor_badge() 91 | 92 | # Circle CI 93 | usethis::use_circleci() 94 | usethis::use_circleci_badge() 95 | 96 | # Jenkins 97 | usethis::use_jenkins() 98 | 99 | # GitLab CI 100 | usethis::use_gitlab_ci() 101 | 102 | # You're now set! ---- 103 | # go to dev/03_deploy.R 104 | rstudioapi::navigateToFile("dev/03_deploy.R") 105 | 106 | -------------------------------------------------------------------------------- /ggplot/camcoder/14 Sparkline OECD CPI.R: -------------------------------------------------------------------------------- 1 | ## ORIGINGAL CHART FROM WEBSITE 2 | # http://motioninsocial.com/tufte/ 3 | 4 | ## Sparklines in ggplot2 5 | # DATA: OECD Inflation (CPI) 6 | 7 | # 1. Load required packages 8 | pacman::p_load(here,tidyverse,ggthemes,reshape,RCurl,janitor) 9 | 10 | # 2. Get data into R 11 | OECD_files <- list.files(path = "./data/OECD", pattern = "csv$") 12 | OECD_files 13 | 14 | OECD_DATA <-read.table(here("data","OECD", "OECD_CPI_selected_countries.csv"), 15 | header =TRUE, sep =',',stringsAsFactors =TRUE) %>% 16 | clean_names() 17 | OECD_DATA 18 | 19 | # 3. Subset data to include just a set of countries 20 | names(OECD_DATA) 21 | 22 | location_freq <- OECD_DATA %>% 23 | select(location) %>% 24 | group_by(location) %>% 25 | summarise(freq = n()) %>% 26 | arrange(freq) 27 | location_freq 28 | 29 | min(OECD_DATA$time) 30 | 31 | # Subset data just for these countries G20 (G-20), 32 | # Japan (JPN), United Kingdom (GBR), United states (USA), Australia (AUS) . 33 | Subset <-c("G-20","JPN","GBR","USA","AUS") 34 | OECD_subset <- OECD_DATA %>% filter(location %in% Subset) 35 | 36 | OECD_subset <- OECD_subset %>% select(time,country = location, value) 37 | OECD_subset 38 | 39 | Min_year <- min(OECD_subset$time) 40 | Min_year 41 | # [1] 1974 42 | Max_year <- max(OECD_subset$time) 43 | Max_year 44 | # [1] 2022 45 | head(OECD_subset) 46 | names(OECD_subset) 47 | 48 | # 4. Compute reference points (min, max, latest) Inflation CPI values for each country 49 | minv <- group_by(OECD_subset, country) %>% slice(which.min(value)) 50 | maxv <- group_by(OECD_subset, country) %>% slice(which.max(value)) 51 | endv <- group_by(OECD_subset, country) %>% filter(time == max(time)) 52 | 53 | quartv <- OECD_subset %>% group_by(country) %>% 54 | summarize(quart1 = quantile(value, 0.25), 55 | quart2 = quantile(value, 0.75)) %>% 56 | right_join(OECD_subset) 57 | 58 | # 5. Build plot to include Inflation CPI min max and latest values for selected countries 59 | ggplot(OECD_subset, aes(x=time, y=value)) + 60 | facet_grid(country ~ ., scales = "free_y") + 61 | ggtitle("Inflation, consumer price index (CPI) selected countries. 1974-2022") + 62 | geom_line(size=0.3) + 63 | geom_point(data = minv, col = 'red') + 64 | geom_point(data = maxv, col = 'blue') + 65 | geom_point(data = endv, col = 'purple') + 66 | geom_text(data = minv, aes(label = value), vjust = -1) + 67 | geom_text(data = maxv, aes(label = value), vjust = 2.5) + 68 | geom_text(data = endv, aes(label = value), hjust = 0, nudge_x = 1) + 69 | geom_text(data = endv, aes(label = country), hjust = 0, nudge_x = 5) + 70 | expand_limits(x = max(OECD_subset$time) + (0.25 * (max(OECD_subset$time) - min(OECD_subset$time)))) + 71 | scale_x_continuous(breaks = seq(1960, 2025, 5)) + 72 | scale_y_continuous(expand = c(0,25)) + 73 | theme_minimal() + 74 | theme( 75 | axis.title=element_blank(), axis.text.y = element_blank(), 76 | axis.ticks = element_blank(), strip.text = element_blank(), 77 | legend.position="none", 78 | panel.spacing = unit(0.1, "lines"), 79 | strip.text.x = element_text(size = 8), 80 | plot.title = element_text(size=14) 81 | ) 82 | 83 | ggsave("plots/04 Sparkline chart OECD CPI test.png", width = 6, height = 4) 84 | 85 | 86 | 87 | -------------------------------------------------------------------------------- /example_chloropleth_ICB_map/example ICB map.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Example map using new NHS boundaries" 3 | output: html_document 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | 8 | 9 | knitr::opts_chunk$set(echo = TRUE) 10 | options(width = 1200) 11 | 12 | 13 | library(shiny) 14 | library(leaflet) 15 | library(RColorBrewer) 16 | library(readr) #TO READ URL 17 | library(tidyverse) #JOINING FUNCTIONS 18 | library(sf) #TO READ MAPPING BOUNDARIES 19 | library(geojsonio) 20 | library(spatialEco) 21 | library(leaflet.extras) 22 | 23 | 24 | 25 | # Load a map - taken from https://geoportal.statistics.gov.uk/search?collection=Dataset&sort=name&tags=all(BDY_ICB%2CJUL_2022) 26 | 27 | map1 <- geojsonio::geojson_read("Integrated_Care_Boards_(July_2022)_EN_BGC.geojson", what = "sp") 28 | 29 | 30 | # Link some data using the same codes - this is a file that is ICB22CD and some data. 31 | listareas <- read.csv("C:/Users/aporter1/OneDrive - NHS England/listareas.csv") 32 | 33 | 34 | # create a random value to colour the systems in... 35 | listareas$colourvalue <- sample (100, size= nrow(listareas), replace = TRUE) 36 | 37 | 38 | #merge the data into one file - linking the two data sets. it's a bit funky as merging a polygons frame. 39 | map1@data <- merge(x=map1@data,y=listareas,by.x="ICB22CD",by.y="ICB22CD",all.x=TRUE) 40 | 41 | # Set a colour palette function. Approximates NHS colours using Blues! 42 | pal <- colorBin(palette=brewer.pal(n = 6, name = "Blues"),listareas$colourvalue, bins=5) 43 | 44 | 45 | # create hover over labels 46 | labels <- sprintf( 47 | "%s
Size %g", 48 | map1@data$ICB22NM.x, map1@data$Shape__Area.x 49 | ) %>% lapply(htmltools::HTML) 50 | 51 | 52 | 53 | ``` 54 | 55 | ## Example Map, using Leaflet, and new ICB boundary files 56 | 57 | This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see . 58 | 59 | When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this: 60 | 61 | # Your first map 62 | 63 | ```{r 101, echo=FALSE} 64 | 65 | leaflet(map1, height=900, width=1200) %>% 66 | addTiles() %>% 67 | addPolygons( 68 | fillColor = ~pal(map1@data$colourvalue), 69 | weight = 0.4, #BORDER LINE THICKNESS 70 | opacity = 1, 71 | color = "white", 72 | dashArray = "3", 73 | fillOpacity = 0.7, 74 | highlightOptions = highlightOptions( 75 | weight = 0.4, #HIGHLIGHTED BORDER LINE THICKNESS 76 | color = "#666", 77 | dashArray = "", 78 | fillOpacity = 0.7, 79 | bringToFront = TRUE), label = labels, 80 | labelOptions = labelOptions( 81 | style = list("font-weight" = "normal", padding = "3px 8px"), 82 | textsize = "15px", 83 | direction = "auto")) %>% 84 | addLegend(pal = pal, values = seq(1:5), opacity = 0.7, 85 | title = "New NHS ICB example map", 86 | position = "bottomright") %>% 87 | addLabelOnlyMarkers(listareas$LONG, listareas$LAT, label = ~as.character(listareas$ICB22NM), labelOptions = labelOptions(noHide = T, direction = 'top', textOnly = T)) %>% 88 | addFullscreenControl() 89 | ``` 90 | 91 | 92 | 93 | -------------------------------------------------------------------------------- /kh03/kh03.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(readxl) 3 | library(rvest) 4 | library(progress) 5 | library(lubridate) 6 | 7 | get_kh03_filelist <- function() { 8 | url <- paste( 9 | "https://www.england.nhs.uk", 10 | "statistics", 11 | "statistical-work-areas", 12 | "bed-availability-and-occupancy", 13 | "bed-data-overnight", 14 | sep = "/" 15 | ) 16 | 17 | read_html(url) |> 18 | html_nodes("a") |> 19 | keep(~html_text(.x) |> str_detect("NHS organisations in England, Quarter.*XLS")) |> 20 | map(\(.x) { 21 | url <- html_attr(.x, "href") 22 | quarter <- html_text(.x) |> 23 | str_replace("^.*Quarter (.), (.{7}).*$", "\\2 Q\\1") 24 | 25 | list(url = url, quarter = quarter) 26 | }) |> 27 | rev() 28 | } 29 | 30 | process_kh03_file <- function(x) { 31 | url <- x[[1]]$url 32 | quarter <- x[[1]]$quarter 33 | 34 | if (quarter >= "2013-14 Q4") { 35 | file_extension <- ".xlsx" 36 | skip_rows <- 14 37 | } else { 38 | file_extension <- ".xls" 39 | skip_rows <- if (quarter >= "2010-11 Q3") 13 else 3 40 | } 41 | 42 | filename <- withr::local_tempfile(fileext = file_extension) 43 | download.file(url, filename, quiet = TRUE, mode = "wb") 44 | 45 | overall <- read_excel(filename, "NHS Trust by Sector", skip = 17, col_names = c( 46 | "year", "period_end", "skip_1", "org_code", "org_name", "skip_2", 47 | "available_general_and_acute", "available_learning_disabilities", "available_maternity", "available_mental_illness", 48 | "skip_3", "skip_4", 49 | "occupied_general_and_acute", "occupied_learning_disabilities", "occupied_maternity", "occupied_mental_illness", 50 | "skip_5", "skip_6", "skip_7", "skip_8", "skip_9", "skip_10" 51 | )) |> 52 | select(-matches("skip_\\d+")) |> 53 | pivot_longer(-(year:org_name)) |> 54 | separate(name, c("type", "specialty_group"), extra = "merge") |> 55 | drop_na(value) |> 56 | pivot_wider(names_from = type, values_from = value) 57 | 58 | by_specialty <- read_excel(filename, "Occupied by Specialty", skip = skip_rows) |> 59 | select(-1, -2, -3, -5) |> 60 | rename(org_code = 1) |> 61 | drop_na(org_code) |> 62 | pivot_longer(-org_code, names_to = "specialty", values_to = "occupied") |> 63 | separate(specialty, c("specialty_code", "specialty_name"), extra = "merge") 64 | 65 | specialty_groups <- list( 66 | "maternity" = c("501"), 67 | "learning_disabilities" = c("700"), 68 | "mental_illness" = c("710", "711", "712", "713", "715") 69 | ) |> 70 | enframe("specialty_group", "specialty_code") |> 71 | unnest(specialty_code) |> 72 | right_join(distinct(by_specialty, specialty_code), by = "specialty_code") |> 73 | mutate(across(specialty_group, replace_na, "general_and_acute")) |> 74 | arrange(specialty_code) 75 | 76 | overall |> 77 | rename(available_total = available, occupied_total = occupied) |> 78 | filter(available_total > 0 | occupied_total > 0) |> 79 | inner_join(specialty_groups, by = "specialty_group") |> 80 | inner_join(by_specialty, by = c("org_code", "specialty_code")) |> 81 | filter(occupied > 0) |> 82 | group_nest(across(year:occupied_total), .key = "by_specialty") |> 83 | mutate( 84 | period_start = as.Date(paste("1", period_end, str_sub(year, 1, 4)), "%d %B %Y") %m-% months(2), 85 | period_end = period_start %m+% months(3) %m-% days(1), 86 | quarter = quarter, 87 | year = NULL 88 | ) |> 89 | relocate(quarter, period_start, .before = period_end) 90 | } 91 | -------------------------------------------------------------------------------- /shiny/excelReports/R/mod_per_student.R: -------------------------------------------------------------------------------- 1 | #' per_student UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList 10 | mod_per_student_ui <- function(id){ 11 | ns <- NS(id) 12 | tagList( 13 | 14 | fluidPage( 15 | 16 | checkboxInput(ns("all_graphs"), "Return all students?"), 17 | 18 | conditionalPanel( 19 | condition = "input.all_graphs==0", ns = ns, 20 | 21 | uiOutput(ns("which_studentUI")) 22 | ), 23 | 24 | downloadButton(ns("download_graphs")), 25 | ) 26 | ) 27 | } 28 | 29 | #' per_student Server Functions 30 | #' 31 | #' @noRd 32 | mod_per_student_server <- function(id, all_data){ 33 | moduleServer( id, function(input, output, session){ 34 | ns <- session$ns 35 | 36 | output$which_studentUI <- renderUI({ 37 | 38 | choices = unique(all_data()$adm_no) 39 | 40 | selectInput(session$ns("which_student"), "Select student", 41 | choices = choices) 42 | }) 43 | 44 | output$download_graphs <- downloadHandler( 45 | 46 | filename = "graphs.zip", 47 | content = function(file) { 48 | 49 | df <- all_data() 50 | 51 | df$marks_perc <- df$marks/df$max_marks*100 52 | 53 | df$subject <- factor(tolower(df$subject)) 54 | df$test_desc <- factor(tolower(df$test_desc)) 55 | df$name_short <- factor(df$name_short2) 56 | df$test_occ_no_f <- factor(paste("Occ", df$test_occ, sep=":")) 57 | 58 | 59 | if(input$all_graphs) { 60 | 61 | admission_numbers <- sort(unique(all_data()$adm_no)) 62 | 63 | } else { 64 | 65 | admission_numbers <- input$which_student 66 | } 67 | 68 | files <- NULL 69 | 70 | myDir <- tempdir() 71 | 72 | for(i in admission_numbers) { 73 | my_file_name <- paste(df$name_short[df$adm_no == i], 74 | "_AdmNo_", df$adm_no[df$adm_no == i], 75 | "_Class_", df$class[df$adm_no == i], 76 | ".pdf") 77 | adf <- df %>% 78 | dplyr::filter(adm_no == i) 79 | 80 | pdf(file.path(myDir, my_file_name), width = 15, height = 10) 81 | 82 | p1 <- ggplot2::ggplot(df[df$class == unique(adf$class),], 83 | ggplot2::aes(x = test_occ_no_f, y = marks_perc)) + 84 | ggplot2::geom_boxplot() + 85 | ggplot2::geom_point(data = adf, 86 | ggplot2::aes(x = test_occ_no_f, 87 | y = marks_perc, 88 | group = test_desc), 89 | col = 'red') + 90 | ggplot2::facet_wrap(subject ~ test_desc) + 91 | ggplot2::ylab("% Score") + 92 | ggplot2::xlab("Test Occ") + 93 | ggplot2::scale_y_continuous(breaks = seq(0, 100, 10), 94 | limits = c(0, 100)) + 95 | ggplot2::ggtitle(my_file_name) 96 | 97 | print(p1) 98 | 99 | files <- c(my_file_name, files) 100 | dev.off() 101 | } 102 | zip(file, file.path(myDir, files), flags = "-j") 103 | } 104 | ) 105 | }) 106 | } 107 | -------------------------------------------------------------------------------- /ggplot/camcoder/08 Attendances by type same plot.R: -------------------------------------------------------------------------------- 1 | # 08 AE Attendances by type same plot 2 | 3 | # We start building our new plot based on the "AE_Att_year" 4 | # The data set for all attendances from 2011 up to 2014 5 | 6 | library(tidyverse) 7 | 8 | # This AE_Att_year was created in "07 AE chart facet wrap by month.R" script 9 | # in section 2: # 2. Create variable to display year 10 | AE_Att_year 11 | names(AE_Att_year) 12 | table(AE_Att_year$Year) 13 | 14 | # 1. Subset data from AE_Att_year to include just 2011-2018 data 15 | # TS Year on year plot comparison 16 | 17 | Subset <-c(2011,2012,2013,2014,2015,2016,2017,2018) 18 | 19 | Att_full_years <- AE_Att_year %>% filter(Year %in% Subset) 20 | Att_full_years 21 | 22 | check <- Att_full_years %>% distinct(Year) 23 | check 24 | 25 | # Rename Att_full_years into AEBYEAR 26 | AEBYEAR <- Att_full_years 27 | 28 | rm(list=ls()[!(ls()%in%c('AE_Att_year','Att_full_years', 'AEBYEAR'))]) 29 | 30 | 31 | # 1 Start designing a long data set to have one column 32 | # for each type of Attendances: 33 | names(AEBYEAR) 34 | 35 | # [1] "period" "type_1_departments_major_a_e" 36 | # [3] "type_2_departments_single_specialty" "type_3_departments_other_a_e_minor_injury_unit" 37 | # [5] "total_attendances" "Year" 38 | # [7] "Month" "Monthl" 39 | 40 | head(AEBYEAR) 41 | 42 | library(tidyverse) 43 | 44 | AEBYEAR_sel <- AEBYEAR %>% 45 | select( 46 | period, 47 | Major_att = type_1_departments_major_a_e , 48 | Single_esp_att = type_2_departments_single_specialty, 49 | Other_att = type_3_departments_other_a_e_minor_injury_unit, 50 | total_att = total_attendances) 51 | AEBYEAR_sel 52 | 53 | # 1.1 Pivot long the initial data set 54 | AEBYEAR_long<- AEBYEAR_sel %>% 55 | pivot_longer(names_to = "Metrics", 56 | cols = 2:ncol(AEBYEAR_sel)) 57 | AEBYEAR_long 58 | 59 | # 2.1 Display using facet_wrap AE Attendances by Metric one metric on each chart 60 | # facet_wrap() by Metric 61 | 62 | names(AEBYEAR_long) 63 | # [1] "period" "Metrics" "value" 64 | 65 | AEM_FACET_METRIC<- AEBYEAR_long %>% 66 | 67 | select(period,Metrics,value) %>% 68 | ggplot(aes(x = period, y = value,group = Metrics, colour = Metrics)) + 69 | geom_line(size=1, linetype=1) + 70 | 71 | labs(title = "A&E Attendances in England by Type", 72 | subtitle ="Attendances by type by year 2011-2018", 73 | # Change X and Y axis labels 74 | x = "Period", 75 | y = "Type I Attendances") + 76 | theme_light() + 77 | facet_wrap(~ Metrics) + 78 | # Apply format to sub-title 79 | theme( 80 | plot.subtitle = element_text( 81 | size =10, colour = "darkorange1", face = "bold") 82 | ) 83 | 84 | AEM_FACET_METRIC 85 | 86 | ggsave("plots/13_AE_Attendances_facet_wrap.png", width = 6, height = 4) 87 | 88 | # 2.2 Display four AE Attendanves metrics on same chart using colour = Metric 89 | AEM_SINGLE_PLOT <- AEBYEAR_long %>% 90 | select(period,Metrics,value) %>% 91 | ggplot(aes(x = period, y = value,group = Metrics, colour = Metrics)) + 92 | geom_line(size=1, linetype=1) + 93 | labs(title = "A&E Attendances in England by Type", 94 | subtitle ="Type 1,2,3 and Total Atendances. 2011-2018", 95 | # Change X and Y axis labels 96 | x = "Period", 97 | y = "Attendances") + 98 | theme_light() + 99 | 100 | # Apply format to sub-title 101 | theme( 102 | plot.subtitle = element_text( 103 | size =10, colour = "cornflowerblue", face = "bold") 104 | ) 105 | 106 | AEM_SINGLE_PLOT 107 | 108 | 109 | ggsave("plots/14_AE_Attendances_by_type.png", width = 10, height = 6) -------------------------------------------------------------------------------- /ggplot/camcoder/13 Spaghetti plot OECD CPI 1974_2022.R: -------------------------------------------------------------------------------- 1 | # CPI Consumer price index 2 | 3 | # OECD Indicators 4 | # Inflation (CPI) 5 | # Inflation measured by consumer price index (CPI) is defined as the change in the prices of a basket of goods and services that are typically purchased by specific groups of households 6 | # Downloaded data from 7 | # https://data.oecd.org/price/inflation-cpi.htm 8 | 9 | OECD_Inflation_CPI.csv 10 | 11 | # 1. Load required packages 12 | pacman::p_load(readxl,here,dplyr,janitor) 13 | 14 | OECD_files <- list.files(path = "./data/OECD", pattern = "csv$") 15 | OECD_files 16 | 17 | 18 | # [1] "OECD_Inflation_CPI.csv" 19 | 20 | # 2. Read in data 21 | library(here) 22 | library(janitor) 23 | library(tidyverse) 24 | 25 | OECD_DATA <-read.table(here("data","OECD", "OECD_CPI_selected_countries.csv"), 26 | header =TRUE, sep =',',stringsAsFactors =TRUE) %>% 27 | clean_names() 28 | OECD_DATA 29 | 30 | # 3. Subset data to include just 31 | names(OECD_DATA) 32 | 33 | [1] "location" "indicator" "subject" "measure" "frequency" "time" "value" 34 | [8] "flag_codes" 35 | 36 | location_freq <- OECD_DATA %>% 37 | select(location) %>% 38 | group_by(location) %>% 39 | summarise(freq = n()) %>% 40 | arrange(freq) 41 | 42 | location_freq 43 | 44 | min(OECD_DATA$time) 45 | 46 | # Subset data just for these countries (Canada (CAN), France(FRA),G20 (G-20), Germany (DEU), 47 | # Italy (ITA) , Japan (JPN), United Kingdom (GBR), United states (USA), Australia (AUS) . 48 | Subset <-c("CAN","FRA","G-20","DEU","ITA","JPN","GBR","USA","AUS") 49 | 50 | OECD_subset <- OECD_DATA %>% filter(location %in% Subset) 51 | OECD_subset 52 | 53 | Min_period <- min(OECD_subset$time) 54 | Min_period 55 | # [1] 1974 56 | Max_period <- max(OECD_subset$time) 57 | Max_period 58 | # [1] 2022 59 | head(OECD_subset) 60 | 61 | # New data set 62 | # Variables 63 | 64 | OECD_plot <- OECD_subset 65 | 66 | names(OECD_plot) 67 | head(OECD_plot) 68 | [1] "location" "indicator" "subject" "measure" "frequency" "time" "value" 69 | [8] "flag_codes" 70 | 71 | OECD_plot %>% 72 | ggplot( aes(x=time, y=value, group=location, fill=location)) + 73 | geom_area() + 74 | scale_colour_viridis_d(option = "plasma") + 75 | theme(legend.position="none") + 76 | ggtitle("Inflation, consumer price index (CPI) selected countries. 1974-2022") + 77 | theme_minimal() + 78 | theme( 79 | legend.position="none", 80 | panel.spacing = unit(0.1, "lines"), 81 | strip.text.x = element_text(size = 8), 82 | plot.title = element_text(size=14) 83 | ) + 84 | facet_wrap(~location) 85 | OECD_plot 86 | 87 | 88 | ggsave("01 Consumer price index 1974-2022.png", width = 10, height = 6) 89 | 90 | # Turn the above plot into a spaghetti plot 91 | 92 | tmp <- OECD_plot %>% 93 | mutate(location2=location) 94 | 95 | 96 | tmp %>% 97 | ggplot( aes(x=time, y=value)) + 98 | geom_line( data=tmp %>% dplyr::select(-location), aes(group=location2), color="grey", linewidth=0.5, alpha=0.5) + 99 | geom_line( aes(color=location), color="#69b3a2", linewidth=1.2 )+ 100 | scale_colour_viridis_d(option = "plasma") + 101 | theme_minimal() + 102 | theme( 103 | legend.position="none", 104 | plot.title = element_text(size=14), 105 | panel.grid = element_blank() 106 | ) + 107 | ggtitle("A spaghetti chart of consumer price index (CPI) selected countries. 1974-2022") + 108 | facet_wrap(~location) 109 | 110 | ggsave("02 Spaguetti chart inflation selected countries.png", width = 10, height = 6) 111 | 112 | -------------------------------------------------------------------------------- /statistics/summary_stats.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Summary statistics and 95% CIs" 3 | author: "Chris Beeley" 4 | date: "16/12/2021" 5 | output: html_document 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | 10 | knitr::opts_chunk$set(echo = TRUE) 11 | 12 | ``` 13 | 14 | How to calculate summary statistics using the inbuilt mtcars dataset, and use the calculation to plot column charts featuring error bars using either stderr or 95% confidence intervals 15 | 16 | This submission was made by the committer on behalf of the excellent [Daniel Weiand](https://twitter.com/send2dan) 17 | 18 | ```{r} 19 | 20 | library(dplyr) 21 | library(ggplot2) 22 | 23 | #calculate summary statistics using summary() 24 | mtcars %>% 25 | select(where(is.numeric)) %>% 26 | summary() 27 | 28 | ``` 29 | 30 | ```{r} 31 | 32 | #create stderr function 33 | stderr <- function(x, na.rm=TRUE) { 34 | if (na.rm) x <- na.omit(x) 35 | sqrt(var(x)/length(x)) 36 | } 37 | 38 | #calculate summary statistics using summarise() and across() and n/mean/min/median/max/sd/stderr 39 | # stderr <- function(x, na.rm=TRUE) { 40 | # if (na.rm) x <- na.omit(x) 41 | # sqrt(var(x)/length(x)) 42 | # } 43 | mtcars %>% 44 | group_by(cyl) %>% 45 | mutate( 46 | across(mpg, 47 | list( 48 | n = ~ n(), 49 | mean = ~ mean(.x, na.rm = TRUE), 50 | min = ~ min(.x, na.rm = TRUE), 51 | median = ~ median(.x, na.rm = TRUE), 52 | max = ~ max(.x, na.rm = TRUE), 53 | sd = ~ sd(.x, na.rm = TRUE), 54 | stderr = ~ stderr(.x)), 55 | .names = NULL)) %>% 56 | select(starts_with("mpg")) %>% 57 | summarise(mean = mean(mpg_mean), 58 | min = mean(mpg_min), 59 | median = mean(mpg_median), 60 | max = mean(mpg_max), 61 | sd = mean(mpg_sd), 62 | stderr = mean(mpg_stderr)) %>% 63 | #create column chart with error bars (using stderr) 64 | ggplot(aes(cyl, mean))+ 65 | geom_col(na.rm = TRUE)+ 66 | geom_errorbar(aes(ymin = mean-stderr, ymax = mean+stderr), position = "dodge", width = 0.25) 67 | 68 | ``` 69 | 70 | ```{r} 71 | 72 | # create MEAN column chart with error bars (using 95% confidence intervals) 73 | require(PHEindicatormethods) 74 | 75 | mtcars %>% 76 | filter(!is.na(cyl)) %>% 77 | group_by(cyl) %>% 78 | #use phe_mean() 79 | phe_mean(x = mpg, #field name from data containing the values to calculate the means for 80 | type = "full", #defines the data and metadata columns to be included in output; can be "value", "lower", "upper", "standard" (for all data) or "full" (for all data and metadata); quoted string; default = "full" 81 | confidence = 0.95) %>% #required level of confidence expressed as a number between 0.9 and 1 82 | #create column chart with error bars (using 95% CI calculated using phe_mean()) 83 | ggplot(aes(cyl, value))+ 84 | geom_col(na.rm = TRUE)+ 85 | geom_errorbar(aes(ymin = lowercl, ymax = uppercl), position = "dodge", width = 0.25) 86 | 87 | ``` 88 | 89 | 90 | ```{r} 91 | 92 | # create PROPORTION column chart with error bars (using 95% confidence intervals) 93 | 94 | require(PHEindicatormethods) 95 | 96 | mtcars %>% 97 | group_by(cyl) %>% 98 | summarise(n = n(), 99 | sum = sum(n)) %>% 100 | mutate(sum = sum(n)) %>% 101 | #phe_proportion() 102 | phe_proportion(x = n, #numerator 103 | n = sum, #denominator 104 | type = "full", #defines the data and metadata columns to be included in output; can be "value", "lower", "upper", "standard" (for all data) or "full" (for all data and metadata); quoted string; default = "full" 105 | confidence = 0.95, #required level of confidence expressed as a number between 0.9 and 1 106 | multiplier = 100) %>% #the multiplier used to express the final values (eg 100 = percentage); numeric; default 1 107 | #create column chart with error bars (using 95% CI calculated using phe_proportion()) 108 | ggplot(aes(cyl, value))+ 109 | geom_col(na.rm = TRUE)+ 110 | geom_errorbar(aes(ymin = lowercl, ymax = uppercl), position = "dodge", width = 0.25) 111 | ``` 112 | 113 | -------------------------------------------------------------------------------- /shiny/simpleGrandTour/app.R: -------------------------------------------------------------------------------- 1 | #Example of linking two plotly outputs 2 | 3 | # Jon Minton 4 | 5 | # I'm going to start with the example in section 17.1 of Sievert's book, then adapt to two plots 6 | # https://plotly-r.com/linking-views-with-shiny.html 7 | library(shiny) 8 | library(plotly) 9 | 10 | 11 | ui <- fluidPage( 12 | selectizeInput( 13 | inputId = "cities", 14 | label = "Select a city", 15 | choices = unique(txhousing$city), 16 | selected = "Abilene", 17 | multiple = TRUE 18 | ), 19 | plotlyOutput(outputId = "main_plot"), 20 | plotlyOutput(outputId = "sub_plot"), 21 | hr(), 22 | verbatimTextOutput("hover"), 23 | verbatimTextOutput("click") 24 | ) 25 | 26 | server <- function(input, output, ...) { 27 | make_main_plot <- reactive({ 28 | plot_ly( 29 | txhousing, x = ~date, y = ~median, 30 | customdata = ~city, # This allows the city corresponding to the curveNumber to be passed 31 | source = "main" # Added this so can distinguish from clicks/interactions with subplot 32 | ) %>% 33 | filter(city %in% input$cities) %>% 34 | group_by(city) %>% 35 | add_lines() %>% 36 | layout(title = "Main plot") 37 | }) 38 | 39 | output$main_plot <- renderPlotly({ 40 | p <- make_main_plot() 41 | 42 | p %>% event_register("plotly_selecting") 43 | }) 44 | 45 | output$hover <- renderPrint({ 46 | d <- event_data("plotly_hover", source = "main") 47 | if (is.null(d)) "Hover events appear here (unhover to clear)" else d 48 | }) 49 | 50 | output$click <- renderPrint({ 51 | d <- event_data("plotly_click", source = "main") 52 | if (is.null(d)) "Click events appear here (double-click to clear)" else d 53 | }) 54 | 55 | output$sub_plot <- renderPlotly({ 56 | d <- event_data("plotly_click", source = "main") 57 | req(d) 58 | 59 | this_time <- d$x 60 | this_city <- d$customdata 61 | this_year <- floor(this_time) 62 | this_month <- ((this_time - this_year) * 12) %>% round(0) 63 | 64 | p_time_varying <- 65 | txhousing %>% 66 | filter( 67 | city == this_city 68 | ) %>% 69 | plot_ly(x = ~date, y = ~median) %>% 70 | add_lines() %>% 71 | add_markers( 72 | data = txhousing %>% 73 | filter( 74 | city == this_city, 75 | year == this_year, 76 | month == this_month 77 | ) 78 | ) %>% 79 | layout(margin = list(r = 30), # set right margin 80 | showlegend = FALSE, 81 | title = "Time varying subplot" 82 | ) 83 | 84 | p_place_varying <- 85 | txhousing %>% 86 | filter( 87 | year == this_year, 88 | month == this_month 89 | ) %>% 90 | mutate( 91 | selected_city = city == this_city 92 | ) %>% 93 | plot_ly( 94 | x = ~median, 95 | y = ~forcats::fct_reorder(city, median), 96 | symbol = ~selected_city, 97 | 98 | color = ~selected_city, 99 | colors = c(`FALSE` = 'black', `TRUE` = 'red') 100 | ) %>% 101 | add_markers() %>% 102 | layout(margin = list(l = 30), # set left margin 103 | yaxis = list(side = "right"), 104 | showlegend = FALSE, 105 | title = "Place varying subplot") 106 | 107 | subplot( 108 | p_time_varying, p_place_varying, nrows = 1 109 | ) %>% 110 | layout( 111 | margin = list(pad = 25), 112 | title = "Subplot", 113 | annotations = list( 114 | list( 115 | x = 0.20, y = 1.0, 116 | xref = "paper", yref = "paper", 117 | xanchor = "centre", 118 | yanchor = "bottom", 119 | showarrow = FALSE, 120 | text = "Time varying" 121 | ), 122 | list( 123 | x = 0.80, y = 1.0, 124 | xref = "paper", yref = "paper", 125 | xanchor = "centre", 126 | yanchor = "bottom", 127 | showarrow = FALSE, 128 | text = "Place varying" 129 | ) 130 | ) 131 | ) %>% 132 | config(displayModeBar = FALSE) 133 | }) 134 | } 135 | 136 | shinyApp(ui, server) 137 | -------------------------------------------------------------------------------- /ggplot/camcoder/05 Tidy up downloaded AE data.R: -------------------------------------------------------------------------------- 1 | # 05 Tidy up downloaded AE data.R 2 | 3 | # 1. Load required packages 4 | pacman::p_load(readxl,here,dplyr,janitor) 5 | 6 | # Check existing files in data project folder 7 | 8 | Excel_files_xls <- list.files(path = "./data", pattern = "xls$") 9 | Excel_files_xls 10 | 11 | Excel_files_xlsx <- list.files(path = "./data", pattern = "xlsx$") 12 | Excel_files_xlsx 13 | 14 | # [1] "AE_England_data.xls" "RTT_TS_data.xls" 15 | 16 | # 2. Import AE Excel data into R 17 | # From file AE_England_data.xls 18 | 19 | # This is an .xls file extension, Excel 97-Excel 2003 Workbook 20 | 21 | # 2.1 Check first how many sheets the AE data has 22 | here() 23 | 24 | AE_tabs <- excel_sheets(here("data","AE_England_data.xls")) 25 | AE_tabs 26 | 27 | # [1] "Activity" "Performance" 28 | 29 | # We read in data from Excel using READXL package 30 | # From "readxl" package we use the read_excel function to read in data from Excel file 31 | 32 | # Parameters 33 | # sheet = number [Number of sheet to be imported] 34 | # skiep = number [Number of rows from the top of the file to be skipped when importing data into Excel] 35 | # range = "C10:F18" [Range of rows from a specific sheet to be Imported into R] 36 | # na = "" [How missing values are defined in the input file "-", "#" ] 37 | 38 | # To obtain cleansed data from the original file formatting setup, we must skip some rows from the top of the file 39 | 40 | # Also we make use of the clean_names() from janitor package to obtain clear variable names 41 | 42 | 43 | # 2.2 Skip first rows of data containing Notes and file description information in the original .xls file 44 | 45 | # We start now importing the data by cleaning out the redundant text rows 46 | # from the original input .xls file 47 | #- We want to import data from the First sheet “Activity”/ Sheet =1 48 | #- We also need to skip 17 rows to obtain the right column variable values 49 | #- We need to bear in mind that the first 4 rows are A&E Attendances and the from row 5 on wards are A&E Admissions 50 | 51 | 52 | # Skip certain rows of data: 53 | AE_data<- read_excel( 54 | here("data", "AE_England_data.xls"), 55 | sheet = 1, skip =17) %>% 56 | clean_names() 57 | AE_data 58 | 59 | names(AE_data) 60 | 61 | # Example: How to select rows of data 62 | # Import only "Type 1 Departments- Major A&E" A&E Attendances data into R 63 | 64 | AE_data_Type1_ATT <- read_excel(here("data","AE_England_data.xls"), 65 | sheet = 1,skip =17, range = "C18:D123",na = "") 66 | AE_data_Type1_ATT 67 | 68 | # 3. Subset original imported AE_data set to Keep A&E Attendances 69 | # From file AE_England_data.xls 70 | AE_data_subset<- read_excel( 71 | here("data", "AE_England_data.xls"), 72 | sheet = 1, skip =17) %>% 73 | clean_names() %>% 74 | select( 75 | "x1", 76 | "period", 77 | "type_1_departments_major_a_e", 78 | "type_2_departments_single_specialty", 79 | "type_3_departments_other_a_e_minor_injury_unit", 80 | "total_attendances" 81 | ) 82 | AE_data_subset 83 | 84 | # 4. Rename variables in preparation for creating a ggplot2 plot 85 | # 4.1 First we remove X1 extra variable 86 | AE_data_plot <- AE_data_subset %>% 87 | select(-x1) 88 | AE_data_plot 89 | 90 | # 4.2 Then we rename remaining variables to shorten their names 91 | 92 | # SUbset Attendances data to produce our first plot 93 | AE_plot_prep <- AE_data_plot %>% 94 | select( 95 | period, 96 | type_1_Major_att = type_1_departments_major_a_e, 97 | type_2_Single_esp_att = type_2_departments_single_specialty, 98 | type_3_other_att = type_3_departments_other_a_e_minor_injury_unit, 99 | total_att = total_attendances 100 | 101 | ) 102 | AE_plot_prep 103 | 104 | # Save AE Attendances variables in a new data set 105 | AEATT_plot <- AE_plot_prep -------------------------------------------------------------------------------- /ggplot/camcoder/03 Import Excel data into R.R: -------------------------------------------------------------------------------- 1 | # 03 Import Excel data into R.R 2 | 3 | # Load required packages at once (readxl,here,dplyr,janitor) 4 | 5 | library(readxl) 6 | library(here) 7 | library(dplyr) 8 | library(janitor) 9 | 10 | 11 | # Added "where_am_i" across all instances an absolute path is required 12 | where_am_i <- here::here() 13 | 14 | excel_file <- list.files (paste0(where_am_i,"/ggplot2-visualizations/data"),pattern = "xlsx$") 15 | excel_file 16 | 17 | # [1] "RTT_TS_data.xlsx" 18 | excel_tabs <- excel_sheets(paste0(where_am_i,"/ggplot2-visualizations/data/RTT_TS_data.xlsx")) 19 | excel_tabs 20 | 21 | # We read in data from Excel using {readxl} package 22 | # From {readxl} package we use the read_excel function to read in data from Excel file 23 | 24 | # Parameters 25 | # sheet = number [Number of sheet to be imported] 26 | # skip = number [Number of rows from the top of the file to be skipped when importing data into Excel] 27 | # range = "C10:F18" [Range of rows from a specific sheet to be Imported into R] 28 | # na = "" [How missing values are defined in the input file "-", "#" ] 29 | 30 | # Two examples 31 | # Skip certain rows of data: 32 | # Myocardial_infarction <- read_excel( 33 | # here("data", "CCG_1.17_I01968_D.xlsx"), 34 | # sheet = 3, skip =13) %>% 35 | # clean_names() 36 | # How to select rows of data 37 | #Tab10202in <- read_excel(here("Input_files",DataA),sheet = 1,range = "C10:F18",skip = 1,na = "") 38 | 39 | ### Importing our main RTT data 40 | 41 | # There are 9 Rows of data in the Excel file we downloaded from the URL 42 | # File name "RTT_TS_data.xlsx" 43 | # skip = 9 44 | 45 | # Let's try to import it just by specifying the number of rows to omit 46 | 47 | 48 | 49 | # 1-3 First get the File name we want to import 50 | excel_file <- list.files (paste0(where_am_i,"/ggplot2-visualizations/data"),pattern = "xlsx$") 51 | excel_file 52 | # [1] "RTT_TS_data.xlsx" 53 | 54 | # 2-3 Then get the Tab names to choose which one to import (with multi tab files) 55 | excel_tabs <- excel_sheets(paste0(where_am_i,"/ggplot2-visualizations/data/RTT_TS_data.xlsx")) 56 | excel_tabs 57 | #[1] "Full Time Series" 58 | 59 | # Start applying all these parameters to our function 60 | RTT_Data <- read_excel(paste0(where_am_i,"/ggplot2-visualizations/data/RTT_TS_data.xlsx"),sheet = "Full Time Series") 61 | RTT_Data 62 | 63 | # 1. Add argument to skip first 10 rows of data 64 | # So this will get us the right Table headings 65 | RTT_Data <- read_excel(paste0(where_am_i,"/ggplot2-visualizations/data/RTT_TS_data.xlsx"),sheet = "Full Time Series", 66 | skip = 10) 67 | RTT_Data 68 | 69 | names(RTT_Data) 70 | 71 | # 2.Add na argument to get rid of missing values na = "-" 72 | # In this particular example, missing values are defined by "-" character 73 | # Try to adjust the spaces for the missing values 74 | RTT_Data <- read_excel(paste0(where_am_i,"/ggplot2-visualizations/data/RTT_TS_data.xlsx"),sheet = "Full Time Series", 75 | skip = 10 , na = "-") 76 | 77 | RTT_Data 78 | 79 | # 3. Use {Janitor} package to get clear names using "clear_names()"function 80 | # This file worked fine and solves: 81 | # a. Importing null values from original file defined as "-" 82 | # b. Cleaning original variable names using clean_names() function from Janitor package 83 | RTT_Data <- read_excel(paste0(where_am_i,"/ggplot2-visualizations/data/RTT_TS_data.xlsx"),sheet = "Full Time Series", 84 | skip = 10 , na = "-") %>% 85 | clean_names() 86 | 87 | RTT_Data 88 | # Try to capture that missing value better 89 | Variable_names <- names(RTT_Data) 90 | Variable_names 91 | 92 | # 4. As we can see we have plenty of variables, we will start by subsetting them and keeping just TWO 93 | 94 | # x2 that will correspond to "Date" and "Total waiting(Mil)" That corresponds to Total figure of incomplete pathways or waiting list 95 | RTT_data_sub <- RTT_Data %>% 96 | select(x2,total_waiting_mil) 97 | RTT_data_sub 98 | 99 | # Now rename the variable appropriately 100 | TT_data <- RTT_data_sub %>% select(Date = x2, Total_waiting = total_waiting_mil) 101 | RTT_data 102 | 103 | # We can also remote null values using drop_na() function rom tidyr package 104 | # From {dplyr} package we can use na.omit() function 105 | RTT_data <- RTT_data_sub %>% 106 | select(Date = x2, Total_waiting_M = total_waiting_mil) %>% 107 | na.omit() 108 | RTT_data 109 | 110 | # Check how the data looks like 111 | install.packages("tidyverse",dependencies = TRUE) 112 | library(tidyverse) 113 | 114 | RTT_data_plot <- RTT_data %>% 115 | ggplot(X = Date, Y = Total_waiting_M, aes()) + 116 | geom_line() -------------------------------------------------------------------------------- /ggplot/camcoder/11 Density plot Major Single AE Attendances.R: -------------------------------------------------------------------------------- 1 | # 10 Density plot for A&E Attendanes 2 | library(ggside) 3 | library(tidyverse) 4 | library(tidyquant) 5 | 6 | # Using the AEBYEAR_sel data set for this Density plot 7 | AEBYEAR_sel 8 | 9 | names(AEBYEAR_sel) 10 | names(Att_facet) 11 | head(Att_facet) 12 | 13 | # 1 DENSITY PLOT FOR MAJOR_ATTENDANCES AND SINGLE ESP ATT SCATTERPLOT 14 | MAJORSING <- AEBYEAR_sel %>% select(period,Major_att,Single_esp_att,Other_att ) 15 | MAJORSING 16 | 17 | 18 | # > MAJORSING 19 | # A tibble: 96 × 4 20 | #period Major_att Single_esp_att Other_att 21 | # 22 | # 1 2011-01-01 00:00:00 1133881. 51585. 542331. 23 | #2 2011-02-01 00:00:00 1053707. 51249. 494408. 24 | #3 2011-03-01 00:00:00 1225222. 57900. 580319. 25 | #4 2011-04-01 00:00:00 1197213. 54042. 593120. 26 | #5 2011-05-01 00:00:00 1221687. 57067 594941. 27 | #6 2011-06-01 00:00:00 1168468. 54739. 562210 28 | #7 2011-07-01 00:00:00 1211066. 56204. 597690. 29 | #8 2011-08-01 00:00:00 1135801. 51890. 570417. 30 | #9 2011-09-01 00:00:00 1162143. 52329. 566738. 31 | #10 2011-10-01 00:00:00 1200708. 54447. 593757. 32 | 33 | # 2 Create variable for Moths, we are going to display Attendances by Month for 2011 34 | Att_months <- MAJORSING %>% 35 | mutate( 36 | Year = format(period, format = "%Y"), 37 | Month = format(period, format = "%b") 38 | ) 39 | Att_months 40 | 41 | # Plot structure 42 | # X axis (period) 43 | # Y axis (value) 44 | # color (metric) 45 | 46 | # 2 Start building the Density plot 47 | # 2.1 Initial GGPLOT displaying metric by date 48 | scatter_plot <- Att_months %>% 49 | ggplot(aes(period, Major_att, color = Major_att)) + 50 | ggtitle("AE Major attendances. 2011-2019") + 51 | geom_point(size = 2, alpha = 0.3) 52 | scatter_plot 53 | 54 | # 2.2 start building the density plot 55 | library(tidyquant) 56 | 57 | # Test including X axis density plot 58 | 59 | # a. Subset variables 60 | Att_months_long <- Att_months %>% 61 | select(period,Year,Month, Major_att, Single_esp_att, Other_att) 62 | Att_months_long 63 | 64 | # b. Pivot long the data 65 | Att_months_pivotl <- Att_months_long %>% 66 | pivot_longer( 67 | cols = Major_att:Other_att, 68 | names_to = c("Metrics"), 69 | values_to = "count" 70 | ) 71 | Att_months_pivotl 72 | 73 | # Build a standard scatterplot 74 | scatter_plot01 <- Att_months_pivotl %>% 75 | ggplot(aes(period, count, Metrics, color = Metrics)) + 76 | ggtitle("AE Major attendances. 2011-2019") + 77 | geom_point(size = 2, alpha = 0.3) 78 | scatter_plot01 79 | 80 | ggsave("plots/19_A&E_Attendances_normal_scatterplot.png", width = 6, height = 4) 81 | 82 | 83 | 84 | # 3 Start building density plot 85 | # 86 | Att_months_pivotl1<-Att_months_pivotl %>% 87 | mutate(Yearin = as.integer(Year)) 88 | Att_months_pivotl1 89 | 90 | 91 | Norma_scatter_plot <- Att_months %>% 92 | ggplot(aes(Major_att, Single_esp_att, Metrics, color = Month)) + 93 | ggtitle("AE Major attendances. 2011-2019") + 94 | geom_point(size = 2, alpha = 0.3) 95 | Norma_scatter_plot 96 | 97 | # 3.1 Scatter plot plus X axis density plot 98 | Desity_plot01 <- Att_months %>% 99 | ggplot(aes(Major_att, Single_esp_att, Metrics, color = Month)) + 100 | ggtitle("AE Major attendances. 2011-2019") + 101 | geom_point(size = 2, alpha = 0.3) + 102 | 103 | # Adding density plot for X axis 104 | geom_xsidedensity( 105 | aes(y = after_stat(density),fill = Month), 106 | alpha = 0.5, size = 1, 107 | position = "stack") 108 | 109 | Desity_plot01 110 | 111 | ggsave("plots/20_A&E_Attendances_X_axis_density_plot.png", width = 6, height = 4) 112 | 113 | 114 | # 3.2 Scatter plot plus Y axis density plot 115 | 116 | Desity_plot02 <- Att_months %>% 117 | ggplot(aes(Major_att, Single_esp_att, Metrics, color = Month)) + 118 | ggtitle("AE Major attendances. 2011-2019") + 119 | geom_point(size = 2, alpha = 0.3) + 120 | 121 | # Adding density plot for X axis 122 | geom_xsidedensity( 123 | aes(y = after_stat(density),fill = Month), 124 | alpha = 0.5, size = 1, 125 | position = "stack") + 126 | 127 | # Adding density plot for Y axis 128 | 129 | geom_ysidedensity( 130 | aes(x = after_stat(density),fill = Month), 131 | alpha = 0.5, size = 1, 132 | position = "stack") 133 | 134 | Desity_plot02 135 | 136 | ggsave("plots/21_A&E_Attendances_X_axis_Y_axis_density_plot.png", width = 6, height = 4) 137 | 138 | -------------------------------------------------------------------------------- /ggplot/camcoder/12 Raincloud chart AE Attendances_test.R: -------------------------------------------------------------------------------- 1 | # 12 Raincloud chart AE Attendances 2 | 3 | # Load required packages at once (readxl,here,dplyr,janitor) 4 | pacman::p_load(readxl,here,tidyverse,janitor) 5 | 6 | 7 | # Load England AE Attendances 8 | # Import (Type 1, Type 2 and Type 3 AE Attendances) 9 | AE_ATT <- read_excel(here("data","AE_England_data.xls"), 10 | sheet = 1,skip =17, range = "C18:G123",na = "") %>% 11 | clean_names() 12 | 13 | AE_ATT 14 | 15 | names(AE_ATT) 16 | 17 | # [1] "period" 18 | # [2] "type_1_departments_major_a_e" 19 | # [3] "type_2_departments_single_specialty" 20 | # [4] "type_3_departments_other_a_e_minor_injury_unit" 21 | # [5] "total_attendances" 22 | 23 | AE_ATT <- AE_ATT %>% 24 | select( 25 | Period = period, 26 | Major_att = type_1_departments_major_a_e , 27 | Single_spec_att = type_2_departments_single_specialty, 28 | Other_att = type_3_departments_other_a_e_minor_injury_unit 29 | 30 | ) 31 | AE_ATT 32 | 33 | # Create variable for year 34 | 35 | AE_ATT <- AE_ATT %>% 36 | mutate( 37 | year = as.numeric(format(Period, "%Y")) 38 | ) 39 | AE_ATT 40 | 41 | AE_ATT_arrange <- AE_ATT %>% 42 | select(Period,year,Major_att,Single_spec_att,Other_att) 43 | AE_ATT_arrange 44 | 45 | # Prep.1 Pivot long the initial data set 46 | AE_ATT_long<- AE_ATT_arrange %>% 47 | pivot_longer(names_to = "Metrics", 48 | cols = 3:ncol(AE_ATT_arrange)) 49 | AE_ATT_long 50 | 51 | 52 | # Prep.2 Group value by year and Metric 53 | AE_ATT_long_year <- AE_ATT_long %>% 54 | select(year,Metrics,value) %>% 55 | group_by(year,Metrics) %>% 56 | summarise(Value = sum(value)) 57 | AE_ATT_long_year 58 | 59 | ## Start building raincloud plot 60 | 61 | 62 | ## 1. MAJOR ATTENDANCES RAINCLOUD 63 | 64 | 65 | # Filter data to account for 2010-2014 years 66 | 67 | # 1.1 Create boilerplate chart for value by period split by Metrics 68 | 69 | # Include all years in the visualization 70 | AE_ATT_sel_major <- AE_ATT_long %>% select(year,Metrics,value) 71 | 72 | AE_ATT_sel_major 73 | names(AE_ATT_sel_major) 74 | 75 | # Include all years in the visualization 76 | # Subset data for 2010-2014 period 77 | AE_ATT_period <- AE_ATT_long %>% select(year,Metrics,value) %>% 78 | filter(Metrics == "Major_att" & 79 | (year == 2010 | year == 2011 |year == 2012 | year == 2013 ) 80 | ) %>% 81 | select(year,value) 82 | AE_ATT_period 83 | 84 | 85 | 86 | # 1.2 Add Raincloud visualization 87 | 88 | MAJOR_ATT <- ggplot(AE_ATT_sel_major,aes(x = factor(year), y = value, 89 | fill = factor(year))) + 90 | # Include half-violin from {ggdist} package 91 | # Function: stat_halfeye() from ggdist package 92 | ggdist::stat_halfeye( 93 | adjust = 0.5, 94 | justification = -.2, 95 | .width = 0, 96 | point_colour = NA 97 | ) + 98 | # Function: geom_boxplot() from ggplot package 99 | geom_boxplot( 100 | width = .12, 101 | outlier.color = NA, 102 | alpha = 0.5 103 | 104 | ) 105 | # DOTS chart. Function: stat_dots() from ggdis package 106 | ggdist::stat_dots( 107 | side = "left", # left orientation 108 | justification = 1.1, 109 | binwidth = .25 110 | 111 | ) 112 | MAJOR_ATT 113 | 114 | # 2. Improve plot layout feel and look 115 | # functions: scale_fill_tq(), theme_tq() 116 | # Improve theme and plot layout 117 | library(tidyquant) 118 | 119 | 120 | MAJOR_ATT_layout <- ggplot(AE_ATT_sel_major,aes(x = factor(year), y = value, 121 | fill = factor(year))) + 122 | # Include half-violin from {ggdist} package 123 | # Function: stat_halfeye() from ggdist package 124 | ggdist::stat_halfeye( 125 | adjust = 0.5, 126 | justification = -.2, 127 | .width = 0, 128 | point_colour = NA 129 | ) + 130 | # Function: geom_boxplot() from ggplot package 131 | geom_boxplot( 132 | width = .12, 133 | outlier.color = NA, 134 | alpha = 0.5 135 | 136 | ) + 137 | # DOTS chart. Function: stat_dots() from ggdis package 138 | ggdist::stat_dots( 139 | side = "left", # left orientation 140 | justification = 1.1, 141 | binwidth = .25 142 | 143 | ) + 144 | # Improve theme and plot layout 145 | # library(tidyquant) 146 | scale_fill_tq() + 147 | theme_tq() + # Apply theme 148 | labs ( 149 | title = "Raincloud plot", 150 | subtitle = "Major A&E Attendances. England 2010-2019", 151 | x = "Major Attendances", 152 | y = "Years", 153 | fill = "Years" 154 | ) + 155 | coord_flip() ## Flip coordinates 156 | 157 | 158 | 159 | MAJOR_ATT_layout 160 | 161 | 162 | 163 | 164 | 165 | scale_fill_tq() + 166 | theme_tq() + # Apply theme 167 | labs ( 168 | title = "Raincloud plot", 169 | subtitle = "Major A&E Attendances. England 2010-2019", 170 | x = "Major Attendances", 171 | y = "Years", 172 | fill = "Years" 173 | ) + 174 | coord_flip() ## Flip coordinates 175 | 176 | -------------------------------------------------------------------------------- /ggplot/camcoder/12 Raincloud chart AE Attendances.R: -------------------------------------------------------------------------------- 1 | # 12 Raincloud chart AE Attendances 2 | 3 | # Reference: ggdist: Make a Raincloud Plot to Visualize Distribution in ggplot2 | R-bloggers 4 | # https://www.r-bloggers.com/2021/07/ggdist-make-a-raincloud-plot-to-visualize-distribution-in-ggplot2/ 5 | 6 | # Load required packages at once (readxl,here,dplyr,janitor) 7 | pacman::p_load(readxl,here,tidyverse,janitor) 8 | 9 | 10 | # Load England AE Attendances 11 | # Import (Type 1, Type 2 and Type 3 AE Attendances) 12 | AE_ATT <- read_excel(here("data","AE_England_data.xls"), 13 | sheet = 1,skip =17, range = "C18:G123",na = "") %>% 14 | clean_names() 15 | 16 | AE_ATT 17 | 18 | names(AE_ATT) 19 | 20 | # [1] "period" 21 | # [2] "type_1_departments_major_a_e" 22 | # [3] "type_2_departments_single_specialty" 23 | # [4] "type_3_departments_other_a_e_minor_injury_unit" 24 | # [5] "total_attendances" 25 | 26 | AE_ATT <- AE_ATT %>% 27 | select( 28 | Period = period, 29 | Major_att = type_1_departments_major_a_e , 30 | Single_spec_att = type_2_departments_single_specialty, 31 | Other_att = type_3_departments_other_a_e_minor_injury_unit 32 | 33 | ) 34 | AE_ATT 35 | 36 | # Create variable for year 37 | 38 | AE_ATT <- AE_ATT %>% 39 | mutate( 40 | year = as.numeric(format(Period, "%Y")) 41 | ) 42 | AE_ATT 43 | 44 | AE_ATT_arrange <- AE_ATT %>% 45 | select(Period,year,Major_att,Single_spec_att,Other_att) 46 | AE_ATT_arrange 47 | 48 | # Prep.1 Pivot long the initial data set 49 | AE_ATT_long<- AE_ATT_arrange %>% 50 | pivot_longer(names_to = "Metrics", 51 | cols = 3:ncol(AE_ATT_arrange)) 52 | AE_ATT_long 53 | 54 | 55 | # Prep.2 Group value by year and Metric 56 | AE_ATT_long_year <- AE_ATT_long %>% 57 | select(year,Metrics,value) %>% 58 | group_by(year,Metrics) %>% 59 | summarise(Value = sum(value)) 60 | AE_ATT_long_year 61 | 62 | 63 | ## Start building raincloud plot 64 | 65 | ## 1. MAJOR ATTENDANCES RAINCLOUD 66 | # Filter data to account for 2010-2014 years 67 | 68 | # 1.1 Create boilerplate chart for value by period split by Metrics 69 | 70 | # Include all years in the visualization 71 | AE_ATT_sel_major <- AE_ATT_long %>% select(year,Metrics,value) 72 | 73 | AE_ATT_sel_major 74 | names(AE_ATT_sel_major) 75 | 76 | # Include all years in the visualization 77 | # Subset data for 2010-2014 period 78 | AE_ATT_period <- AE_ATT_long %>% select(year,Metrics,value) %>% 79 | filter(Metrics == "Major_att" & 80 | (year == 2010 | year == 2011 |year == 2012 | year == 2013 ) 81 | ) %>% 82 | select(year,value) 83 | AE_ATT_period 84 | 85 | table(AE_ATT_period$year) 86 | 87 | # 1.2 Create Raincloud visualization for 2010=2014 period 88 | 89 | MAJOR_ATT <- ggplot(AE_ATT_period,aes(x = factor(year), y = value, 90 | fill = factor(year))) + 91 | # Include half-violin from {ggdist} package 92 | # Function: stat_halfeye() from ggdist package 93 | ggdist::stat_halfeye( 94 | adjust = 0.5, 95 | justification = -.2, 96 | .width = 0, 97 | point_colour = NA 98 | ) + 99 | # Function: geom_boxplot() from ggplot package 100 | geom_boxplot( 101 | width = .12, 102 | outlier.color = NA, 103 | alpha = 0.5 104 | 105 | ) + 106 | 107 | # DOTS chart. Function: stat_dots() from ggdis package 108 | ggdist::stat_dots( 109 | side = "left", # left orientation 110 | justification = 1.1, 111 | binwidth = .25 112 | 113 | ) 114 | MAJOR_ATT 115 | 116 | # 2. Improve plot layout feel and look 117 | # functions: scale_fill_tq(), theme_tq() 118 | # Improve theme and plot layout 119 | library(tidyquant) 120 | 121 | MAJOR_ATT_layout <- ggplot(AE_ATT_period,aes(x = factor(year), y = value, 122 | fill = factor(year))) + 123 | # Include half-violin from {ggdist} package 124 | # Function: stat_halfeye() from ggdist package 125 | ggdist::stat_halfeye( 126 | adjust = 0.5, 127 | justification = -.2, 128 | .width = 0, 129 | point_colour = NA 130 | ) + 131 | # Function: geom_boxplot() from ggplot package to be used 132 | geom_boxplot( 133 | width = .12, 134 | outlier.color = NA, 135 | alpha = 0.5 136 | 137 | ) + 138 | 139 | # DOTS chart. Function: stat_dots() from ggdis package 140 | ggdist::stat_dots( 141 | side = "left", # left orientation 142 | justification = 1.1, 143 | binwidth = .25 144 | 145 | ) + 146 | # Improve theme and plot layout 147 | # library(tidyquant) 148 | scale_fill_tq() + 149 | theme_tq() + # Apply theme 150 | labs ( 151 | title = "Major A&E Attendances. England 2010-2013", 152 | subtitle = "Raincloud plot example", 153 | x = "Years", 154 | y = "Major Attendances", 155 | fill = "Years" 156 | ) + 157 | coord_flip() ## Flip coordinates 158 | 159 | MAJOR_ATT_layout 160 | 161 | ggsave("plots/24_AE_Attendances_Raincloud_chart.png", width = 6, height = 4) 162 | -------------------------------------------------------------------------------- /ggplot/camcoder/13 01 Spaghetti plot OECD CPI 1974_2022.R: -------------------------------------------------------------------------------- 1 | # CPI Consumer price index 2 | 3 | # OECD Indicators 4 | # Inflation (CPI) 5 | # Inflation measured by consumer price index (CPI) is defined as the change in the prices of a basket of goods and services that are typically purchased by specific groups of households 6 | # Downloaded data from 7 | # https://data.oecd.org/price/inflation-cpi.htm 8 | 9 | # OECD_Inflation_CPI.csv 10 | 11 | # 1. Load required packages 12 | pacman::p_load(readxl,here,dplyr,janitor) 13 | 14 | OECD_files <- list.files(path = "./data/OECD", pattern = "csv$") 15 | OECD_files 16 | 17 | # [1] "OECD_Inflation_CPI.csv" 18 | # 2. Read in data 19 | library(here) 20 | library(janitor) 21 | library(tidyverse) 22 | 23 | OECD_DATA <-read.table(here("data","OECD", "OECD_CPI_selected_countries.csv"), 24 | header =TRUE, sep =',',stringsAsFactors =TRUE) %>% 25 | clean_names() 26 | OECD_DATA 27 | 28 | # 3. Subset data to include just 29 | names(OECD_DATA) 30 | 31 | #[1] "location" "indicator" "subject" "measure" "frequency" "time" "value" 32 | #[8] "flag_codes" 33 | 34 | location_freq <- OECD_DATA %>% 35 | select(location) %>% 36 | group_by(location) %>% 37 | summarise(freq = n()) %>% 38 | arrange(freq) 39 | 40 | location_freq 41 | 42 | min(OECD_DATA$time) 43 | 44 | # Subset data just for these countries (Canada (CAN), France(FRA),G20 (G-20), Germany (DEU), 45 | # Italy (ITA) , Japan (JPN), United Kingdom (GBR), United states (USA), Australia (AUS) . 46 | Subset <-c("CAN","FRA","G-20","DEU","ITA","JPN","GBR","USA","AUS") 47 | 48 | OECD_subset <- OECD_DATA %>% filter(location %in% Subset) 49 | OECD_subset 50 | 51 | Min_period <- min(OECD_subset$time) 52 | Min_period 53 | # [1] 1974 54 | Max_period <- max(OECD_subset$time) 55 | Max_period 56 | # [1] 2022 57 | head(OECD_subset) 58 | 59 | # New data set 60 | # Variables 61 | 62 | OECD_plot <- OECD_subset 63 | 64 | names(OECD_plot) 65 | head(OECD_plot) 66 | #[1] "location" "indicator" "subject" "measure" "frequency" "time" "value" 67 | #[8] "flag_codes" 68 | 69 | OECD_plot %>% 70 | ggplot( aes(x=time, y=value, group=location, fill=location)) + 71 | geom_area() + 72 | scale_colour_viridis_d(option = "plasma") + 73 | theme(legend.position="none") + 74 | ggtitle("Inflation, consumer price index (CPI) selected countries. 1974-2022") + 75 | theme_minimal() + 76 | theme( 77 | legend.position="none", 78 | panel.spacing = unit(0.1, "lines"), 79 | strip.text.x = element_text(size = 8), 80 | plot.title = element_text(size=14) 81 | ) + 82 | facet_wrap(~location) 83 | OECD_plot 84 | 85 | 86 | ggsave("01 Consumer price index 1974-2022.png", width = 10, height = 6) 87 | 88 | # Turn the above plot into a spaghetti plot 89 | 90 | tmp <- OECD_plot %>% 91 | select(location,indicator,subject,measure,frequency,time,value,flag_codes) %>% 92 | mutate(location2=location) 93 | 94 | tmp2 <-tmp 95 | 96 | tmp2 %>% 97 | ggplot(aes(x=time, y=value)) + 98 | geom_line( data = tmp2 %>% dplyr::select(-location), aes(group=location2), color="grey", size=0.5, alpha=0.5) + 99 | geom_line( aes(color=location), color="#69b3a2", size=1.2 )+ 100 | scale_colour_viridis_d(option = "plasma") + 101 | theme_minimal() + 102 | theme( 103 | legend.position="none", 104 | plot.title = element_text(size=14), 105 | panel.grid = element_blank() 106 | ) + 107 | ggtitle("A spaghetti chart of consumer price index (CPI) selected countries. 1974-2022") + 108 | facet_wrap(~location) 109 | 110 | ggsave("02 Spaguetti chart inflation selected countries.png", width = 10, height = 6) 111 | 112 | # Include latest value 113 | Subset <-c("G-20","JPN","GBR","AUS") 114 | OECD_subset <- OECD_DATA %>% filter(location %in% Subset) 115 | 116 | OECD_subset <- OECD_subset %>% select(time,country = location, value) 117 | OECD_subset 118 | 119 | endv <- group_by(OECD_subset, country) %>% filter(time == max(time)) 120 | 121 | # Plot including latest value and country name next to it 122 | 123 | tmp_plt <- OECD_subset %>% 124 | select(location = country,time,value) %>% 125 | mutate(location2=location) 126 | 127 | tmp_plt2 <-tmp_plt 128 | 129 | tmp_plt2 %>% 130 | ggplot(aes(x=time, y=value)) + 131 | geom_line( data = tmp_plt2 %>% dplyr::select(-location), aes(group=location2), color="grey", size=0.5, alpha=0.5) + 132 | geom_line( aes(color=location), color="#69b3a2", size=1.2 )+ 133 | # Adding end value (most recent value with country name) 134 | geom_point(data = endv, col = 'purple') + 135 | geom_text(data = endv, aes(label = value), hjust = 0, nudge_x = 1, size =1.8) + 136 | geom_text(data = endv, aes(label = country), hjust = 0, nudge_x = 5, size =1.8) + 137 | expand_limits(x = max(OECD_subset$time) + (0.50 * (max(OECD_subset$time) - min(OECD_subset$time)))) + 138 | scale_colour_viridis_d(option = "plasma") + 139 | theme_minimal() + 140 | theme( 141 | legend.position="none", 142 | plot.title = element_text(size=14), 143 | panel.grid = element_blank()) + 144 | # ggtitle("A spaghetti chart of consumer price index (CPI) selected countries. 1974-2022") + 145 | labs ( 146 | title = "A spaghetti chart of consumer price index (CPI) selected countries. 1974-2022", 147 | subtitle = "Latest value highlighted by purple dot") + 148 | facet_wrap(~location) 149 | 150 | ggsave("03 Spaguetti chart inflation selected countries recent value.png", width = 10, height = 6) 151 | 152 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, caste, color, religion, or sexual 10 | identity and orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the overall 26 | community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or advances of 31 | any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email address, 35 | without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards of 42 | acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies when 54 | an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail address, 56 | posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at nhs.rcommunity@nhs.net. 63 | All complaints will be reviewed and investigated promptly and fairly. 64 | 65 | All community leaders are obligated to respect the privacy and security of the 66 | reporter of any incident. 67 | 68 | ## Enforcement Guidelines 69 | 70 | Community leaders will follow these Community Impact Guidelines in determining 71 | the consequences for any action they deem in violation of this Code of Conduct: 72 | 73 | ### 1. Correction 74 | 75 | **Community Impact**: Use of inappropriate language or other behavior deemed 76 | unprofessional or unwelcome in the community. 77 | 78 | **Consequence**: A private, written warning from community leaders, providing 79 | clarity around the nature of the violation and an explanation of why the 80 | behavior was inappropriate. A public apology may be requested. 81 | 82 | ### 2. Warning 83 | 84 | **Community Impact**: A violation through a single incident or series of 85 | actions. 86 | 87 | **Consequence**: A warning with consequences for continued behavior. No 88 | interaction with the people involved, including unsolicited interaction with 89 | those enforcing the Code of Conduct, for a specified period of time. This 90 | includes avoiding interactions in community spaces as well as external channels 91 | like social media. Violating these terms may lead to a temporary or permanent 92 | ban. 93 | 94 | ### 3. Temporary Ban 95 | 96 | **Community Impact**: A serious violation of community standards, including 97 | sustained inappropriate behavior. 98 | 99 | **Consequence**: A temporary ban from any sort of interaction or public 100 | communication with the community for a specified period of time. No public or 101 | private interaction with the people involved, including unsolicited interaction 102 | with those enforcing the Code of Conduct, is allowed during this period. 103 | Violating these terms may lead to a permanent ban. 104 | 105 | ### 4. Permanent Ban 106 | 107 | **Community Impact**: Demonstrating a pattern of violation of community 108 | standards, including sustained inappropriate behavior, harassment of an 109 | individual, or aggression toward or disparagement of classes of individuals. 110 | 111 | **Consequence**: A permanent ban from any sort of public interaction within the 112 | community. 113 | 114 | ## Attribution 115 | 116 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 117 | version 2.1, available at 118 | . 119 | 120 | Community Impact Guidelines were inspired by 121 | [Mozilla's code of conduct enforcement ladder][https://github.com/mozilla/inclusion]. 122 | 123 | For answers to common questions about this code of conduct, see the FAQ at 124 | . Translations are available at . 125 | 126 | [homepage]: https://www.contributor-covenant.org 127 | -------------------------------------------------------------------------------- /optim-with-rmse/R/make_synthetic_germany_functions.R: -------------------------------------------------------------------------------- 1 | # Functions for creating a synthetic Germany and selecting the optimal share of East and West Germany to produce it 2 | 3 | # Background: The Human Mortality Database (HMD) includes life expectancy data for Germany (DEUT), East Germany 4 | # (DEUTE) and West Germany (DEUTW). Of course there are no population data for Germany prior to reunification, 5 | # but there are separate population data maintained for East and West German populations post-reunification. 6 | 7 | # This means DEUTE, DEUTW, and DEUT are reported for a number of common years. 8 | 9 | # The aim of this code is to produce a 'Synthetic Germany' for years prior to reunification. This 'Synthetic Germany' 10 | # is based on a weighted average of East and West German population data. The weighting between these two populations 11 | # is a parameter to determine based on an objective or loss function. 12 | # A objective/loss function is a function that, given one or more numeric inputs (which can be varied), produces 13 | # a single numeric output. The aim is to select the input that minimises the value returned by the function. 14 | 15 | # In this case, the input is the share of a value from the east german series (and so by implication the share 16 | # of West Germany as well), and the output to try to minimise is the root-mean-square-error (RMSE) between the 17 | # observed life expectancy value from Germany as a whole, and the implied/simulated life expectancy value for 18 | # a synthetic Germany with the proposed East/West Germany share. 19 | 20 | 21 | # The following function makes a synthetic germany series with a particular east germany share (p_east) 22 | # The inputs east_germany and west_germany need to be vectors of the the same length. 23 | # Additionally the proposed value p_east needs to be between 0 and 1. 24 | 25 | make_synthetic_population <- function(east_series, west_series, p_east){ 26 | stopifnot("Series are of different lengths" = length(east_series) == length(west_series)) 27 | stopifnot("Proportion out of possible bounds" = between(p_east, 0, 1)) 28 | 29 | east_series * p_east + west_series * (1 - p_east) 30 | } 31 | 32 | # The following function compares a proposed synthetic germany series against the referenced/observed values 33 | # The series need to be of the same length to allow them to be pairwise compared. 34 | 35 | # The arguments to what can be one of "RMSE', 'abs', and 'rel' 36 | # - The match.arg function checks that the input to this argument is one of the three valid inputs. 37 | # - the default argument for what is RMSE 38 | 39 | compare_synthetic_to_reference <- function(synthetic, reference, what = c("RMSE", "abs", "rel")){ 40 | stopifnot("Synthetic and reference are different lengths" = length(synthetic) == length(reference)) 41 | 42 | what <- match.arg(what) 43 | 44 | if (what == "RMSE"){ 45 | out <- (synthetic - reference)^2 %>% 46 | mean() %>% 47 | .^(1/2) 48 | return(out) 49 | } else if (what == "abs"){ 50 | return(synthetic - reference) 51 | } else if (what == "rel"){ 52 | out <- (synthetic - reference)/reference 53 | return(out) 54 | } else { 55 | stop("Wrong what argument (which should have been caught earlier") 56 | } 57 | NULL 58 | } 59 | 60 | 61 | # The following function wraps up the two previous functions, including a default proposed p_east share of 0.2 (20%) 62 | 63 | # It includes a number of checks that the inputs are of the expected format, and a function within which pulls 64 | # the columns and rows of interest to populate each series. 65 | 66 | compare_series_get_rmse <- function(data, p_east = 0.20, 67 | east_label = "DEUTE", west_label = "DEUTW", ref_label = "DEUTNP", 68 | comp_period = c(1990, 2010)) 69 | { 70 | 71 | stopifnot("data is not a dataframe" = "data.frame" %in% class(e0_e65) ) 72 | stopifnot("proportion not valid" = between(p_east, 0, 1) ) 73 | stopifnot("comp_period not a range" = length(comp_period) == 2 ) 74 | stopifnot("comp_period values not valid" = comp_period %>% is.numeric() %>% all() ) 75 | 76 | # Get the series 77 | extract_series <- function(data = data, code_label, comp_period){ 78 | data %>% 79 | filter(code == code_label) %>% 80 | filter(between(year, comp_period[1], comp_period[2])) %>% 81 | arrange(year) %>% 82 | pull(ex) 83 | } 84 | 85 | 86 | message("getting East series") 87 | east_series <- extract_series(data, east_label, comp_period) 88 | message("getting West series") 89 | west_series <- extract_series(data, west_label, comp_period) 90 | message("getting reference series") 91 | ref_series <- extract_series(data, ref_label, comp_period) 92 | 93 | stopifnot("East/West series lengths differ" = length(east_series) == length(west_series)) 94 | stopifnot("Ref series length differs from EastWest" = length(ref_series) == length(east_series)) 95 | 96 | message("creating synthetic population and calculating RMSE") 97 | 98 | rmse <- make_synthetic_population(east_series, west_series, p_east = p_east) %>% 99 | compare_synthetic_to_reference(reference = ref_series) 100 | 101 | stopifnot("rmse failed: not length 1" = length(rmse) == 1) 102 | stopifnot("rmse failed: not right class" = class(rmse) == "numeric") 103 | 104 | rmse 105 | } 106 | 107 | # The following function (with a function inside it!) runs the optim function and packs the inputs 108 | # in the way that optim expects. 109 | 110 | 111 | run_optim <- function(data){ 112 | pack_for_optim <- function(par, data){ 113 | p_east <- par["p_east"] 114 | data %>% compare_series_get_rmse(p_east = p_east) 115 | } 116 | optim( 117 | par = c(p_east = 0.5), 118 | fn = pack_for_optim, data = data, 119 | lower = 0, upper = 1, 120 | method = "L-BFGS-B" 121 | ) 122 | } 123 | -------------------------------------------------------------------------------- /ggplot/camcoder/07 AE chart facet wrap by month.R: -------------------------------------------------------------------------------- 1 | # 07 AE Attendances facet_wrap 2 | 3 | # This script will provide a matrix of plots by month 4 | 5 | library(tidyverse) 6 | library(gridExtra) 7 | 8 | # We can clean our workspace to keep just a set of variables 9 | rm(list=ls()[!(ls()%in%c('AE_data_plot'))]) 10 | 11 | # Kepep just attendances from the original data set 12 | 13 | # Looking into the previous R Script: 14 | # 05 Tidy up downloaded AE data.R 15 | 16 | # 3. Subset original imported AE_data set to Keep A&E Attendances 17 | # From file AE_England_data.xls 18 | 19 | # Import only "Type 1 Departments- Major A&E" A&E Attendances data into R 20 | 21 | # AE_data_subset<- read_excel( 22 | # here("data", "AE_England_data.xls"), 23 | # sheet = 1, skip =17) %>% 24 | # clean_names() %>% 25 | # select( 26 | # "x1", 27 | # "period", 28 | # "type_1_departments_major_a_e", 29 | # "type_2_departments_single_specialty", 30 | # "type_3_departments_other_a_e_minor_injury_unit", 31 | # "total_attendances" 32 | # ) 33 | # AE_data_subset 34 | 35 | # AE_plot_prep <- AE_data_plot %>% 36 | # select( 37 | # period, 38 | # type_1_Major_att = type_1_departments_major_a_e, 39 | # type_2_Single_esp_att = type_2_departments_single_specialty, 40 | # type_3_other_att = type_3_departments_other_a_e_minor_injury_unit, 41 | # total_att = total_attendances 42 | # ) 43 | # AE_plot_prep 44 | 45 | # 1. Rename data set with sensible name 46 | 47 | AE_Attendances <- AE_data_plot 48 | 49 | names(AE_Attendances) 50 | 51 | # 2. Create variable to display year 52 | library(tidyverse) 53 | 54 | 55 | AE_Att_year <- AE_Attendances %>% 56 | mutate( 57 | Year = format(period, format = "%Y"), 58 | Month = format(period, format = "%m"), 59 | Monthl = months(as.Date(period)) 60 | ) 61 | 62 | AE_Att_year 63 | 64 | ## 3. Rename main variables 65 | 66 | AE_Att_monthp <- AE_Att_year %>% 67 | select( 68 | period, 69 | type_1_Major_att = type_1_departments_major_a_e, 70 | type_2_Single_esp_att = type_2_departments_single_specialty, 71 | type_3_other_att = type_3_departments_other_a_e_minor_injury_unit, 72 | total_att = total_attendances, 73 | Monthl 74 | ) 75 | 76 | AE_Att_monthp 77 | 78 | ## 4. Find out which years have full set of months of data 79 | # month.abb[month] 80 | 81 | # Extract Month and Year from period date variable 82 | 83 | Att_Full_year <- AE_Att_monthp %>% 84 | mutate( 85 | Year = format(period, format = "%Y"), 86 | Month = format(period, format = "%b") 87 | ) 88 | Att_Full_year 89 | 90 | # Turn month into a FACTOR to get the right month order in plots 91 | Att_Full_year_f <- Att_Full_year %>% mutate(Monthf = factor(Month, levels = month.abb)) 92 | 93 | 94 | # Check number of rows per year 95 | Records_year <-Att_Full_year_f %>% 96 | select(Year) %>% 97 | group_by(Year) %>% 98 | count() 99 | Records_year 100 | 101 | # 1 2010 5 102 | # 2 2011 12 103 | # 3 2012 12 104 | # 4 2013 12 105 | # 5 2014 12 106 | # 6 2015 12 107 | # 7 2016 12 108 | # 8 2017 12 109 | # 9 2018 12 110 | # 10 2019 4 111 | 112 | # 5. Subset then just for complete years (2011,2012,2013,2014,2015,2016,2017,2018) 113 | 114 | Subset <-c(2011,2012,2013,2014,2015,2016,2017,2018) 115 | 116 | Att_full_years <- Att_Full_year_f %>% filter(Year %in% Subset) 117 | Att_full_years 118 | 119 | check <- Att_full_years %>% distinct(Year) 120 | check 121 | 122 | head(Att_full_years) 123 | 124 | # 6. CREATE FACET_WRAP plots by month for each year 125 | # facet_wrap(~Monthl, labeller = label_wrap_gen(width = 20)) 126 | 127 | # Subset variables for Facet_plot 128 | 129 | Att_facet <- Att_full_years %>% select(period,type_1_Major_att,Year,Monthf) 130 | Att_facet 131 | 132 | # Minimal facet_wrap to work with my data 133 | # Split facets by Year (group = year) 134 | # ggplot(aes (x = Month, y = type_1_Major_att, group = year)) 135 | 136 | # # Turn month into a FACTOR to get the right month order in plots 137 | 138 | AE_att_wrap_year <- Att_facet %>% 139 | select(type_1_Major_att,Year,Monthf) %>% 140 | ggplot(aes(x = Monthf, y = type_1_Major_att,group = Year)) + 141 | geom_line(color="#0072CE", size=1, linetype=1) + 142 | facet_wrap(~ Year) 143 | AE_att_wrap_year 144 | 145 | # Add title and subtitle to the above wrapped plot 146 | AE_att_wrap_year <- Att_facet %>% 147 | select(type_1_Major_att,Year,Monthf) %>% 148 | ggplot(aes(x = Monthf, y = type_1_Major_att,group = Year)) + 149 | geom_line(color="#0072CE", size=1, linetype=1) + 150 | facet_wrap(~ Year) + 151 | labs(title = "A&E Attendances in England: Type 1 Departments - Major A&E", 152 | subtitle ="Type I attendances by month by year. 2011-2018", 153 | # Change X and Y axis labels 154 | x = "Period", 155 | y = "Type I Attendances") + 156 | theme_light() 157 | AE_att_wrap_year 158 | 159 | ggsave("plots/11_AE_Attendances_facet_wrap.png", width = 6, height = 4) 160 | 161 | # Apply format to title and subtitles in facet_wrap plots 162 | 163 | 164 | AE_att_wrap_formatted <- Att_facet %>% 165 | select(type_1_Major_att,Year,Monthf) %>% 166 | ggplot(aes(x = Monthf, y = type_1_Major_att,group = Year)) + 167 | geom_line(color="#0072CE", size=1, linetype=1) + 168 | facet_wrap(~ Year) + 169 | labs(title = "A&E Attendances in England: Type 1 Departments - Major A&E", 170 | subtitle ="Type I attendances by month by year. 2011-2018", 171 | # Change X and Y axis labels 172 | x = "Period", 173 | y = "Type I Attendances") + 174 | theme_light() + 175 | 176 | theme( 177 | axis.ticks = element_blank(), 178 | # A value of “plot” means the titles/caption are aligned to the entire plot 179 | # Apply format to title plot 180 | plot.title.position = "plot", 181 | plot.title = element_text(margin = margin (b=10), colour = "dodgerblue2", face = "bold"), # Skyblue1 colour 182 | # Apply format to sub-title 183 | plot.subtitle = element_text( 184 | size =8, colour = "deepskyblue2", face = "bold") 185 | ) 186 | 187 | AE_att_wrap_formatted 188 | 189 | ggsave("plots/12_AE_Attendances_facet_wrap.png", width = 6, height = 4) 190 | 191 | 192 | -------------------------------------------------------------------------------- /ggplot/camcoder/09 Attendances by year geom_smooth.R: -------------------------------------------------------------------------------- 1 | # 09 AE Attendances_by_year_geom_smooth 2 | 3 | library(tidyverse) 4 | 5 | # Load England AE Attendances 6 | 7 | AE_data_Type1_ATT <- read_excel(here::here("data","AE_England_data.xls"), 8 | sheet = 1,skip =17, range = "C18:D123",na = "") 9 | AE_data_Type1_ATT 10 | 11 | # 3. Subset original imported AE_data set to Keep A&E Attendances 12 | # From file AE_England_data.xls 13 | AE_data_subset<- read_excel( 14 | here::here("data", "AE_England_data.xls"), 15 | sheet = 1, skip =17) %>% 16 | clean_names() %>% 17 | select( 18 | "x1", 19 | "period", 20 | "type_1_departments_major_a_e", 21 | "type_2_departments_single_specialty", 22 | "type_3_departments_other_a_e_minor_injury_unit", 23 | "total_attendances" 24 | ) 25 | AE_data_subset 26 | 27 | # 4. Rename variables in preparation for creating a ggplot2 plot 28 | # 4.1 First we remove X1 extra variable 29 | AE_data_plot <- AE_data_subset %>% 30 | select(-x1) 31 | AE_data_plot 32 | 33 | AE_Attendances <- AE_data_plot 34 | 35 | AE_Att_year <- AE_Attendances %>% 36 | mutate( 37 | Year = format(period, format = "%Y"), 38 | Month = format(period, format = "%m"), 39 | Monthl = months(as.Date(period)) 40 | ) 41 | 42 | AE_Att_year 43 | 44 | AE_Att_monthp <- AE_Att_year %>% 45 | select( 46 | period, 47 | type_1_Major_att = type_1_departments_major_a_e, 48 | type_2_Single_esp_att = type_2_departments_single_specialty, 49 | type_3_other_att = type_3_departments_other_a_e_minor_injury_unit, 50 | total_att = total_attendances, 51 | Monthl 52 | ) 53 | 54 | AE_Att_monthp 55 | 56 | Att_Full_year <- AE_Att_monthp %>% 57 | mutate( 58 | Year = format(period, format = "%Y"), 59 | Month = format(period, format = "%b") 60 | ) 61 | Att_Full_year 62 | 63 | # Turn month into a FACTOR to get the right month order in plots 64 | Att_Full_year_f <- Att_Full_year %>% mutate(Monthf = factor(Month, levels = month.abb)) 65 | 66 | 67 | # Check number of rows per year 68 | Records_year <-Att_Full_year_f %>% 69 | select(Year) %>% 70 | group_by(Year) %>% 71 | count() 72 | Records_year 73 | 74 | # Subset variables for Facet_plot 75 | Subset <-c(2011,2012,2013,2014,2015,2016,2017,2018) 76 | 77 | Att_full_years <- Att_Full_year_f %>% filter(Year %in% Subset) 78 | Att_full_years 79 | 80 | Att_facet <- Att_full_years %>% select(period,type_1_Major_att,Year,Monthf) 81 | Att_facet 82 | 83 | 84 | ## Create new data set [AEBYEAR_sel] for further charts 85 | # From this data set: Att_Full_year_f 86 | 87 | # Output: AEBYEAR_sel 88 | # Input: Att_Full_year_f 89 | 90 | names(Att_Full_year_f) 91 | AEBYEAR_sel <- Att_Full_year_f %>% 92 | select( 93 | period, 94 | Major_att = type_1_Major_att, 95 | Single_esp_att = type_2_Single_esp_att, 96 | Other_att = type_3_other_att, 97 | total_att, 98 | Monthf, 99 | Year) 100 | AEBYEAR_sel 101 | 102 | # > MAJORSING 103 | # A tibble: 96 × 4 104 | #period Major_att Single_esp_att Other_att 105 | # 106 | # 1 2011-01-01 00:00:00 1133881. 51585. 542331. 107 | #2 2011-02-01 00:00:00 1053707. 51249. 494408. 108 | #3 2011-03-01 00:00:00 1225222. 57900. 580319. 109 | #4 2011-04-01 00:00:00 1197213. 54042. 593120. 110 | 111 | 112 | 113 | AE_att_wrap_formatted <- Att_facet %>% 114 | select(type_1_Major_att,Year,Monthf) %>% 115 | ggplot(aes(x = Monthf, y = type_1_Major_att,group = Year)) + 116 | geom_line(color="#0072CE", size=1, linetype=1) + 117 | facet_wrap(~ Year) + 118 | labs(title = "A&E Attendances in England: Type 1 Departments - Major A&E", 119 | subtitle ="Type I attendances by month by year. 2011-2018", 120 | # Change X and Y axis labels 121 | x = "Period", 122 | y = "Type I Attendances") + 123 | theme_light() + 124 | 125 | theme( 126 | axis.ticks = element_blank(), 127 | # A value of “plot” means the titles/caption are aligned to the entire plot 128 | # Apply format to title plot 129 | plot.title.position = "plot", 130 | plot.title = element_text(margin = margin (b=10), colour = "dodgerblue2", face = "bold"), # Skyblue1 colour 131 | # Apply format to sub-title 132 | plot.subtitle = element_text( 133 | size =8, colour = "deepskyblue2", face = "bold") 134 | ) 135 | 136 | AE_att_wrap_formatted 137 | 138 | 139 | ggsave("plots/15_AE_Attendances_facet_wrap.png", width = 6, height = 4) 140 | 141 | 142 | 143 | # We can add colour to these facet plots by metric 144 | # Display each line on a different colour for each year 145 | # 146 | AE_att_wrap_colour <- Att_facet %>% 147 | select(type_1_Major_att,Year,Monthf) %>% 148 | ggplot(aes(x = Monthf, y = type_1_Major_att,group = Year,colour = Year)) + 149 | # Line colour defined by Metric variable 150 | geom_line(size=1, linetype=1) + 151 | facet_wrap(~ Year) + 152 | labs(title = "A&E Attendances in England: Type 1 Departments - Major A&E", 153 | subtitle ="Type I attendances by month by year. 2011-2018", 154 | # Change X and Y axis labels 155 | x = "Period", 156 | y = "Type I Attendances") + 157 | theme_light() + 158 | 159 | theme( 160 | axis.ticks = element_blank(), 161 | # A value of “plot” means the titles/caption are aligned to the entire plot 162 | # Apply format to title plot 163 | plot.title.position = "plot", 164 | plot.title = element_text(margin = margin (b=10), colour = "dodgerblue2", face = "bold"), # Skyblue1 colour 165 | # Apply format to sub-title 166 | plot.subtitle = element_text( 167 | size =8, colour = "deepskyblue2", face = "bold") 168 | ) 169 | 170 | AE_att_wrap_colour 171 | 172 | ggsave("plots/16_AE_Attendances_facet_wrap_colour.png", width = 6, height = 4) 173 | 174 | 175 | # Display each line on a different colour for each year 176 | # Add also a geom_smooth(span = 0.1,se = TRUE, size = 0.8) to the plot 177 | 178 | AE_att_wrapy_smooth<- Att_facet %>% 179 | select(type_1_Major_att,Year,Monthf) %>% 180 | ggplot(aes(x = Monthf, y = type_1_Major_att,group = Year)) + 181 | geom_line(color="#0072CE", size=1, linetype=1) + 182 | facet_wrap(~ Year) + 183 | geom_smooth(se = TRUE, colour ="darkorchid1") 184 | 185 | AE_att_wrapy_smooth 186 | 187 | ggsave("plots/17_AE_Attendances_facet_wrap_geom.png", width = 6, height = 4) 188 | 189 | 190 | AE_att_wrap_colouryear <- Att_facet %>% 191 | select(type_1_Major_att,Year,Monthf) %>% 192 | ggplot(aes(x = Monthf, y = type_1_Major_att,group = Year,colour = Year)) + 193 | # Line colour defined by Metric variable 194 | geom_line(size=1, linetype=1) + 195 | facet_wrap(~ Year) + 196 | # Include smooth line colour darkorchid 197 | geom_smooth(se = TRUE, colour ="darkorchid1") + 198 | labs(title = "A&E Attendances in England: Type 1 Departments - Major A&E", 199 | subtitle ="Type I attendances by month by year. 2011-2018", 200 | # Change X and Y axis labels 201 | x = "Period", 202 | y = "Type I Attendances") + 203 | theme_light() + 204 | 205 | theme( 206 | axis.ticks = element_blank(), 207 | # A value of “plot” means the titles/caption are aligned to the entire plot 208 | # Apply format to title plot 209 | plot.title.position = "plot", 210 | plot.title = element_text(margin = margin (b=10), colour = "dodgerblue2", face = "bold"), # Skyblue1 colour 211 | # Apply format to sub-title 212 | plot.subtitle = element_text( 213 | size =10, colour = "chartreuse4", face = "bold") 214 | ) 215 | 216 | AE_att_wrap_colouryear 217 | 218 | ggsave("plots/18_AE_Attendances_facet_wrap_colour.png", width = 6, height = 4) 219 | --------------------------------------------------------------------------------