Merge branch 'devel' of https://github.com/lcolladotor/cshl_rstats_ge…

…nome_scale_2024 into devel

03_recount3_intro.R

@@ -1,9 +1,9 @@
-## ----'start', message=FALSE-----------------------------------------------------------
+## ----'start', message=FALSE------------------------------------------------
 ## Load recount3 R package
 library("recount3")
 
 
-## ----'quick_example'------------------------------------------------------------------
+## ----'quick_example'-------------------------------------------------------
 ## Lets download all the available projects
 human_projects <- available_projects()
 
@@ -23,7 +23,7 @@ rse_gene_SRP009615
 lobstr::obj_size(rse_gene_SRP009615)
 
 
-## ----"interactive_display", eval = FALSE----------------------------------------------
+## ----"interactive_display", eval = FALSE-----------------------------------
 ## ## Explore available human projects interactively
 ## proj_info_interactive <- interactiveDisplayBase::display(human_projects)
 ## ## Choose only 1 row in the table, then click on "send".
@@ -34,15 +34,15 @@ lobstr::obj_size(rse_gene_SRP009615)
 ## rse_gene_interactive <- create_rse(proj_info_interactive)
 
 
-## ----"tranform_counts"----------------------------------------------------------------
+## ----"tranform_counts"-----------------------------------------------------
 ## We'll compute read counts, which is what most downstream software
 ## uses.
 ## For other types of transformations such as RPKM and TPM, use
 ## transform_counts().
 assay(rse_gene_SRP009615, "counts") <- compute_read_counts(rse_gene_SRP009615)
 
 
-## ----"expand_attributes"--------------------------------------------------------------
+## ----"expand_attributes"---------------------------------------------------
 ## Lets make it easier to use the information available for this study
 ## that was provided by the original authors of the study.
 rse_gene_SRP009615 <- expand_sra_attributes(rse_gene_SRP009615)

07_model_variable_selection.R

@@ -1,4 +1,4 @@
-## ----download_data, warning=FALSE, message=FALSE--------------------------------------
+## ----download_data, warning=FALSE, message=FALSE---------------------------
 ## Load the container package for this type of data
 library("SummarizedExperiment")
 
@@ -31,7 +31,7 @@ rse_gene_filt <- rse_gene_filt[
 ]
 
 
-## ----CCA, message=FALSE, warning=FALSE, out.height=7, out.width=7---------------------
+## ----CCA, message=FALSE, warning=FALSE-------------------------------------
 library("variancePartition")
 library("pheatmap")
 
@@ -52,7 +52,7 @@ pheatmap(
 )
 
 
-## ----message=FALSE, warning=FALSE-----------------------------------------------------
+## ----message=FALSE, warning=FALSE------------------------------------------
 library("ggplot2")
 library("cowplot")
 
@@ -162,43 +162,43 @@ corr_plots <- function(sample_var1, sample_var2, sample_color) {
 }
 
 
-## ----message=FALSE, warning=FALSE-----------------------------------------------------
+## ----message=FALSE, warning=FALSE------------------------------------------
 ## Correlation plot for Group and plate
 p <- corr_plots("Group", "plate", NULL)
 p + theme(plot.margin = unit(c(1, 5.5, 1, 5.5), "cm"))
 
 
-## ----message=FALSE, warning=FALSE-----------------------------------------------------
+## ----message=FALSE, warning=FALSE------------------------------------------
 ## Correlation plot for overallMapRate and rRNA_rate
 p <- corr_plots("overallMapRate", "rRNA_rate", "Group")
 p + theme(plot.margin = unit(c(2, 3.5, 2, 3.5), "cm"))
 
 
-## ----message=FALSE, warning=FALSE-----------------------------------------------------
+## ----message=FALSE, warning=FALSE------------------------------------------
 ## Correlation plot for overallMapRate and plate
 p <- corr_plots("plate", "overallMapRate", NULL)
 p + theme(plot.margin = unit(c(2, 5, 2, 5), "cm"))
 
 
-## ----message=FALSE, warning=FALSE-----------------------------------------------------
+## ----message=FALSE, warning=FALSE------------------------------------------
 ## Correlation plot for overallMapRate and flowcell
 p <- corr_plots("flowcell", "overallMapRate", NULL)
 p + theme(plot.margin = unit(c(2, 5, 2, 5), "cm"))
 
 
-## ----message=FALSE, warning=FALSE-----------------------------------------------------
+## ----message=FALSE, warning=FALSE------------------------------------------
 ## Correlation plots for sum and detected
 p <- corr_plots("sum", "detected", "Group")
 p + theme(plot.margin = unit(c(2, 3.5, 2, 3.5), "cm"))
 
 
-## ----message=FALSE, warning=FALSE-----------------------------------------------------
+## ----message=FALSE, warning=FALSE------------------------------------------
 p <- corr_plots("Group", "flowcell", NULL)
 plots <- plot_grid(p)
 plots + theme(plot.margin = unit(c(0.5, 5, 0.5, 5), "cm"))
 
 
-## ----message=FALSE, warning=FALSE, eval=FALSE-----------------------------------------
+## ----message=FALSE, warning=FALSE, eval=FALSE------------------------------
 ## ## Fit a linear mixed model (LMM) that takes continuous variables as fixed effects and categorical variables as random effects
 ## 
 ## varPartAnalysis <- function(formula) {
@@ -219,7 +219,7 @@ plots + theme(plot.margin = unit(c(0.5, 5, 0.5, 5), "cm"))
 ## }
 
 
-## ----message=FALSE, warning=FALSE, eval=FALSE-----------------------------------------
+## ----message=FALSE, warning=FALSE, eval=FALSE------------------------------
 ## #####  Fit model with all variables  #####
 ## 
 ## # sum, detected, and ERCCsumLogErr are not included as they are in very different scales!
@@ -233,7 +233,7 @@ plots + theme(plot.margin = unit(c(0.5, 5, 0.5, 5), "cm"))
 ## )
 
 
-## ----message=FALSE, warning=FALSE, eval=FALSE-----------------------------------------
+## ----message=FALSE, warning=FALSE, eval=FALSE------------------------------
 ## #####  Fit model without correlated variables  #####
 ## 
 ## ## Pup plots without overallMapRate and plate
@@ -248,7 +248,7 @@ plots + theme(plot.margin = unit(c(0.5, 5, 0.5, 5), "cm"))
 ## )
 
 
-## ----message=FALSE, warning=FALSE, eval=FALSE-----------------------------------------
+## ----message=FALSE, warning=FALSE, eval=FALSE------------------------------
 ## library("rlang")
 ## 
 ## ## Plot of gene expression lognorm counts vs. sample variable
@@ -331,7 +331,7 @@ plots + theme(plot.margin = unit(c(0.5, 5, 0.5, 5), "cm"))
 ## }
 
 
-## ----message=FALSE, warning=FALSE, eval=FALSE-----------------------------------------
+## ----message=FALSE, warning=FALSE, eval=FALSE------------------------------
 ## ## Function to plot gene expression vs sample variable data for top 3 most affected genes
 ## 
 ## plot_gene_expr_sample <- function(sample_var) {
@@ -347,7 +347,7 @@ plots + theme(plot.margin = unit(c(0.5, 5, 0.5, 5), "cm"))
 ## }
 
 
-## ----message=FALSE, warning=FALSE, eval=FALSE-----------------------------------------
+## ----message=FALSE, warning=FALSE, eval=FALSE------------------------------
 ## ## Plots for top affected genes by 'overallMapRate'
 ## plots <- plot_gene_expr_sample("overallMapRate")
 ## plots + theme(plot.margin = unit(c(3, 1, 2, 3), "cm"))
@@ -365,7 +365,7 @@ plots + theme(plot.margin = unit(c(0.5, 5, 0.5, 5), "cm"))
 ## plots + theme(plot.margin = unit(c(3, 1, 2, 3), "cm"))
 
 
-## ----exercise1_varPart, message=FALSE, warning=FALSE, echo=FALSE, eval=FALSE----------
+## ----exercise1_varPart, message=FALSE, warning=FALSE, echo=FALSE, eval=FALSE----
 ## ## Solution
 ## 
 ## ## Gene ID
@@ -405,7 +405,7 @@ plots + theme(plot.margin = unit(c(0.5, 5, 0.5, 5), "cm"))
 ## plot
 
 
-## ----exercise2_varPart, message=FALSE, warning=FALSE, echo=FALSE, eval=FALSE----------
+## ----exercise2_varPart, message=FALSE, warning=FALSE, echo=FALSE, eval=FALSE----
 ## ## Solution
 ## 
 ## ## Gene ID

10_biocthis_intro.R

@@ -1 +1,56 @@
+## ----"initial_weekday_praise"----------------------------------------------
+weekday_praise <- function(date = Sys.Date()) {
+    date <- as.Date(date)
+    date_weekday <- weekdays(date)
+    paste0(date_weekday, ": ", praise::praise())
+}
+weekday_praise()
+weekday_praise("2024-06-09")
+
+
+## ----"weekday_praise_full_function"----------------------------------------
+#' Praise a weekday
+#'
+#' Given a date, figure out which weekday it was, then write a positive
+#' message.
+#'
+#' @param date A `base::Date` object or a `character()` in a format that can be
+#' converted to a `base::Date` object with `base::as.Date()`.
+#'
+#' @importFrom praise praise
+#' @export
+#' @examples
+#'
+#' ## Praise the current weekday
+#' weekday_praise()
+#'
+#' ## Praise the date we started teaching
+#' weekday_praise("2024-06-09")
+#'
+#' ## Praise the current weekday in a reproducible way
+#' set.seed(20240610)
+#' weekday_praise()
+#'
+#' ## Verify that it's reproducible
+#' set.seed(20240610)
+#' weekday_praise()
+weekday_praise <- function(date = Sys.Date()) {
+    date <- as.Date(date)
+    date_weekday <- weekdays(date)
+    paste0(date_weekday, ": ", praise::praise())
+}
+
+
+## ----"weekday_praise_tests"------------------------------------------------
+library("testthat")
+
+## Verify that we get the result we wanted
+set.seed(20240610)
+expect_equal(weekday_praise("2024-06-09"), "Sunday: You are wondrous!")
+
+## Verify that we get an error if the input is not correct
+expect_error(weekday_praise("240609"))
+
+## Should work for a vector input
+expect_equal(length(weekday_praise(c("2024-06-09", "2024-06-10"))), 2L)
 

10_biocthis_intro.Rmd

@@ -38,16 +38,84 @@ involved in.
 
 ## Live demo
 
-Here is the live demo result https://github.com/lcolladotor/cshl2023pkg/ with
+Here is the live demo result https://github.com/lcolladotor/cshl2024pkg/ with
 its companion documentation website at
-https://lcolladotor.github.io/cshl2023pkg/ from 2023.
+https://lcolladotor.github.io/cshl2024pkg/. You might also want to check the
+2023 version at https://github.com/lcolladotor/cshl2024pkg/.
 
 Check the git commit history at
-https://github.com/lcolladotor/cshl2023pkg/commits/devel and the GitHub Actions
-history at https://github.com/lcolladotor/cshl2023pkg/actions. We can see at
-https://app.codecov.io/gh/lcolladotor/cshl2023pkg the _code coverage_ results
+https://github.com/lcolladotor/cshl2024pkg/commits/devel and the GitHub Actions
+history at https://github.com/lcolladotor/cshl2024pkg/actions. We can see at
+https://app.codecov.io/gh/lcolladotor/cshl2024pkg the _code coverage_ results
 for this demonstration package.
 
+### Example function
+
+Let's have a function to work with: `weekday_praise()`.
+
+```{r "initial_weekday_praise"}
+weekday_praise <- function(date = Sys.Date()) {
+    date <- as.Date(date)
+    date_weekday <- weekdays(date)
+    paste0(date_weekday, ": ", praise::praise())
+}
+weekday_praise()
+weekday_praise("2024-06-09")
+```
+
+Here's the full code for the function and its documentation.
+
+```{r "weekday_praise_full_function"}
+#' Praise a weekday
+#'
+#' Given a date, figure out which weekday it was, then write a positive
+#' message.
+#'
+#' @param date A `base::Date` object or a `character()` in a format that can be
+#' converted to a `base::Date` object with `base::as.Date()`.
+#'
+#' @importFrom praise praise
+#' @export
+#' @examples
+#'
+#' ## Praise the current weekday
+#' weekday_praise()
+#'
+#' ## Praise the date we started teaching
+#' weekday_praise("2024-06-09")
+#'
+#' ## Praise the current weekday in a reproducible way
+#' set.seed(20240610)
+#' weekday_praise()
+#'
+#' ## Verify that it's reproducible
+#' set.seed(20240610)
+#' weekday_praise()
+weekday_praise <- function(date = Sys.Date()) {
+    date <- as.Date(date)
+    date_weekday <- weekdays(date)
+    paste0(date_weekday, ": ", praise::praise())
+}
+```
+
+Here's a test for our function too.
+
+```{r "weekday_praise_tests"}
+library("testthat")
+
+## Verify that we get the result we wanted
+set.seed(20240610)
+expect_equal(weekday_praise("2024-06-09"), "Sunday: You are wondrous!")
+
+## Verify that we get an error if the input is not correct
+expect_error(weekday_praise("240609"))
+
+## Should work for a vector input
+expect_equal(length(weekday_praise(c("2024-06-09", "2024-06-10"))), 2L)
+```
+
+
+
 ## Community
 
 For more materials on R/Bioconductor package development check http://contributions.bioconductor.org/.

index.R

@@ -1,4 +1,4 @@
-## ----install, eval = FALSE----------------------------------------------------------
+## ----install, eval = FALSE-------------------------------------------------
 ## ## For installing Bioconductor packages
 ## if (!requireNamespace("BiocManager", quietly = TRUE)) {
 ##     install.packages("BiocManager")
@@ -45,7 +45,7 @@
 ## )
 
 
-## ----session_packages, eval = TRUE, message = FALSE---------------------------------
+## ----session_packages, eval = TRUE, message = FALSE------------------------
 ## Load the package at the top of your script
 library("sessioninfo")
 
@@ -100,13 +100,13 @@ library("Polychrome")
 library("spatialLIBD")
 
 
-## ----session_info-------------------------------------------------------------------
+## ----session_info----------------------------------------------------------
 ## Reproducibility information
 options(width = 120)
 session_info()
 proc.time()
 
 
-## ----"check_curl"-------------------------------------------------------------------
+## ----"check_curl"----------------------------------------------------------
 curl::curl_version()