Initial commit

01_advanced.R

@@ -0,0 +1,66 @@
+library(shiny)
+library(dplyr)
+library(tidyr)
+library(ggplot2)
+
+expr_table <- read.table("expression_matrix_w_metadata.txt", sep = ",", header = TRUE, stringsAsFactors = FALSE)
+metacols <- grep("^ENSG", colnames(expr_table), invert = TRUE, value = TRUE)
+
+allgenes <- read.table("mart_export.txt", sep = "\t", header = TRUE, stringsAsFactors = FALSE)
+allgenes <- allgenes[allgenes$ensId %in% colnames(expr_table),]
+lookuptable <- unstack(allgenes)
+
+ui <- fluidPage(
+
+  titlePanel("Immune Cell Gene Expression Data"),
+
+  sidebarLayout(
+    sidebarPanel(
+      selectizeInput("ingene", "Choose a gene:", choices = sort(allgenes$symbol), selected = "HBB"),
+      helpText(h4("Data source:")),
+      helpText("Linsley PS, Speake C, Whalen E, Chaussabel D.", em("Copy number loss of the interferon gene cluster in                     melanomas is linked to reduced T cell infiltrate and poor patient prognosis."), 
+               "PLoS One 2014 Oct 14;9(10):e109760."),
+      a(href = "https://www.ncbi.nlm.nih.gov/pubmed/25314013", "On PubMed"), br(),
+      a(href = "https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=GSE60424", "On GEO")
+    ),  
+    mainPanel(
+      plotOutput("theplot"),
+      helpText("Expression values were normalized using the TMM (trimmed mean of m-value) method.",
+               "This means that counts have been normalized by library size but not gene length.", 
+               "Plot shows Tukey boxplots: whiskers extend to the highest/lowest value within the ",
+               "box limit +/- 1.5 * IQR. Samples beyond that range are plotted as points.")
+    )
+  )
+)
+
+server <- function(input, output) {
+
+    output$theplot <- renderPlot({
+        req(input$ingene)
+
+        ens <- lookuptable[[input$ingene]]
+        gene <- input$ingene
+
+        tinyframe <- expr_table[,c(ens, metacols)]
+        tinyframe <- tinyframe %>% gather(variable, value, one_of(ens))
+        p <- ggplot(tinyframe, aes(x = variable, y = value, color = cellType)) + 
+          ggtitle(paste0(gene, " expression by cell type across conditions")) +
+          geom_boxplot() +
+          ylab("Normalized Counts") +
+          theme(axis.text.x = element_blank(), 
+                axis.ticks.x = element_blank(), 
+                axis.title.x = element_blank())
+
+        if (length(ens) > 1) {
+          p <- p + facet_grid(variable ~ diseaseStatus, scales = "free_y")
+        } else { 
+          p <- p + facet_grid(~ diseaseStatus)
+        }
+        return(p)
+    })
+
+}
+
+# Run the application 
+shinyApp(ui = ui, server = server)
+

01_simple.R

@@ -0,0 +1,25 @@
+library(shiny)
+
+
+ui <- fluidPage(
+
+  fluidRow(
+    column(width = 12,
+           textInput("textinputlabel", "What's up?"),
+           textOutput("newtext")
+
+    )
+  )
+)
+
+server <- function(input, output) {
+
+    output$newtext <- renderText({
+      toupper(input$textinputlabel)
+    })
+
+}
+
+# Run the application 
+shinyApp(ui = ui, server = server)
+

02_advanced.R

@@ -0,0 +1,5 @@
+library(profvis)
+
+# Run the application 
+profvis(runApp("01_advanced.R"))
+

02_simple.R

@@ -0,0 +1,45 @@
+library(shiny)
+library(ggplot2)
+library(dplyr)
+library(tidyr)
+
+ui <- fluidPage(
+
+  fluidRow(
+    column(width = 12,
+           sliderInput("sample_count", "How many times should we sample each population?",
+                       value = 10,
+                       min = 1,
+                       max = 500),
+           plotOutput("sample_plot"),
+           tableOutput("sample_table")
+    )
+  )
+)
+
+server <- function(input, output) {
+
+    sample_dat <- reactive({
+      data.frame("rowid" = paste0("row", seq(1,input$sample_count)),
+                 "thicc bois" = rnorm(input$sample_count, 0, 1),
+                 "chonkers" = rnorm(input$sample_count, 0.2, 1),
+                 stringsAsFactors = FALSE,
+                 check.names = FALSE) %>%
+        gather(population, measurement, -rowid)
+    })
+
+    output$sample_plot <- renderPlot({
+      ggplot(sample_dat(), aes(x = population, y = measurement, fill = population)) +
+        geom_boxplot() +
+        geom_point(position = position_jitterdodge(0.5)) +
+        theme(axis.text = element_text(size = rel(2)),
+              axis.title = element_text(size = rel(2)),
+              legend.text = element_text(size = rel(1.5)),
+              legend.title = element_text(size = rel(1.5)))
+    })
+
+}
+
+# Run the application 
+shinyApp(ui = ui, server = server)
+

03_advanced.R

@@ -0,0 +1,100 @@
+library(shiny)
+library(dplyr)
+library(tidyr)
+library(ggplot2)
+library(RSQLite)
+
+conn <- dbConnect(RSQLite::SQLite(), "GSE60424.db")
+choosenames <- dbGetQuery(conn, "SELECT symbol
+                          FROM identifiers i
+                          INNER JOIN expr e
+                          ON i.ensId = e.genenames;")
+choosenames <- choosenames[[1]]
+dbDisconnect(conn)
+
+ui <- fluidPage(
+
+  titlePanel("Immune Cell Gene Expression Data"),
+
+  sidebarLayout(
+    sidebarPanel(
+      selectizeInput("ingene", "Choose a gene:", choices = NULL, selected = NULL),
+      helpText(h4("Data source:")),
+      helpText("Linsley PS, Speake C, Whalen E, Chaussabel D.", em("Copy number loss of the interferon gene cluster in                     melanomas is linked to reduced T cell infiltrate and poor patient prognosis."), 
+               "PLoS One 2014 Oct 14;9(10):e109760."),
+      a(href = "https://www.ncbi.nlm.nih.gov/pubmed/25314013", "On PubMed"), br(),
+      a(href = "https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=GSE60424", "On GEO")
+    ),  
+    mainPanel(
+      plotOutput("theplot"),
+      helpText("Expression values were normalized using the TMM (trimmed mean of m-value) method.",
+               "This means that counts have been normalized by library size but not gene length.", 
+               "Plot shows Tukey boxplots: whiskers extend to the highest/lowest value within the ",
+               "box limit +/- 1.5 * IQR. Samples beyond that range are plotted as points.")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+  updateSelectizeInput(session, "ingene", choices = choosenames, selected = "HBB", server = TRUE)
+
+  makeTinyframe <- function(gene, dbpath){
+    conn <- dbConnect(RSQLite::SQLite(), dbpath)
+    meta <- dbGetQuery(conn, "SELECT * FROM meta;")
+    exprquery <- sprintf("SELECT i.symbol, e.*
+                         FROM identifiers i
+                         JOIN expr e
+                         ON i.ensId = e.genenames
+                         WHERE i.symbol == %s;", shQuote(gene))
+    expr <- dbGetQuery(conn, exprquery)
+    dbDisconnect(conn)
+
+    rownames(expr) <- expr$genenames
+    togene <- expr[,grep("lib", colnames(expr), invert = TRUE)]
+    expr <- expr[,grep("lib", colnames(expr))]
+    expr <- t(expr)
+
+    tinyframe <- merge(meta, expr, by.x = "library", by.y = 0)
+    tinyframe <- tinyframe %>% 
+      gather(gene, TPM, starts_with("ENS")) %>%
+      merge(., togene, by.x = "gene", by.y = "genenames") %>%
+      rename(genename = symbol)
+    return(tinyframe)
+
+  }
+
+  makePlot <- function(tinyframe){
+
+    printgene <- unique(tinyframe$genename)
+
+    p <- ggplot(tinyframe, aes(x = genename, y = TPM, color = celltype)) + 
+      ggtitle(paste0(printgene, " expression by cell type across conditions")) +
+      geom_boxplot() +
+      theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(), axis.title.x = element_blank())
+
+    if (length(unique(tinyframe$gene)) > 1) {
+      p <- p + facet_grid(variable ~ disease_status, scales = "free_y")
+    } else { 
+      p <- p + facet_grid(~ disease_status)
+    }
+    return(p)
+  }
+
+  inputgene <- reactive({
+    validate(
+      need(input$ingene != "", "Please select a gene")
+    )
+    input$ingene
+  })
+
+  output$theplot <- renderPlot({
+    tf <- makeTinyframe(inputgene(), "GSE60424.db")
+    makePlot(tf)
+  })
+
+}
+
+# Run the application 
+shinyApp(ui = ui, server = server)
+

03_simple.R

@@ -0,0 +1,57 @@
+library(shiny)
+library(ggplot2)
+library(dplyr)
+library(tidyr)
+
+ui <- fluidPage(
+
+  fluidRow(
+    column(width = 12,
+           sliderInput("sample_count", "How many times should we sample each population?",
+                       value = 10,
+                       min = 1,
+                       max = 500),
+           plotOutput("sample_plot"),
+           textOutput("sample_result")
+    )
+  )
+)
+
+server <- function(input, output) {
+
+    sample_dat <- reactive({
+      data.frame("rowid" = paste0("row", seq(1,input$sample_count)),
+                 "thicc bois" = rnorm(input$sample_count, 0, 1),
+                 "chonkers" = rnorm(input$sample_count, 0.2, 1),
+                 stringsAsFactors = FALSE,
+                 check.names = FALSE)
+    })
+
+    output$sample_plot <- renderPlot({
+      sample_dat()  %>%
+        gather(population, measurement, -rowid) %>%
+      ggplot(aes(x = population, y = measurement, fill = population)) +
+        geom_boxplot() +
+        geom_point(position = position_jitterdodge(0.5)) +
+        theme(axis.text = element_text(size = rel(2)),
+              axis.title = element_text(size = rel(2)),
+              legend.text = element_text(size = rel(1.5)),
+              legend.title = element_text(size = rel(1.5)))
+    })
+
+    output$sample_result <- renderText({
+      p <- t.test(sample_dat()[["thicc bois"]], 
+             sample_dat()[["chonkers"]], 
+             paired = FALSE)[["p.value"]]
+      if(p >= 0.05){
+        paste("p-value = ", p)
+      } else {
+        paste("p-value = ", p, "*")
+      }
+    })
+
+}
+
+# Run the application 
+shinyApp(ui = ui, server = server)
+

04_simple.R

@@ -0,0 +1,64 @@
+library(shiny)
+library(ggplot2)
+library(dplyr)
+library(tidyr)
+
+ui <- fluidPage(
+
+  fluidRow(
+    column(width = 12,
+           actionButton("do_sample", "Moar!"),
+           plotOutput("sample_plot"),
+           textOutput("sample_result")
+    )
+  )
+)
+
+server <- function(input, output) {
+
+    sample_count <- reactiveVal(10)
+
+    observeEvent(input$do_sample,{
+      x <- sample_count() + 10
+      sample_count(x)
+    })
+
+    sample_dat <- reactive({
+      tmp <- sample_count()
+      data.frame("rowid" = paste0("row", seq(1, tmp)),
+                 "thicc bois" = rnorm(tmp, 0, 1),
+                 "chonkers" = rnorm(tmp, 0.2, 1),
+                 stringsAsFactors = FALSE,
+                 check.names = FALSE)
+    })
+
+    output$sample_plot <- renderPlot({
+      sample_dat()  %>%
+        gather(population, measurement, -rowid) %>%
+      ggplot(aes(x = population, y = measurement, fill = population)) +
+        geom_boxplot() +
+        geom_point(position = position_jitterdodge(0.5)) +
+        ggtitle(paste0("You sampled ", nrow(sample_dat()), " absolute units")) +
+        theme(axis.text = element_text(size = rel(2)),
+              axis.title = element_text(size = rel(2)),
+              legend.text = element_text(size = rel(1.5)),
+              legend.title = element_text(size = rel(1.5)),
+              plot.title = element_text(size = rel(2)))
+    })
+
+    output$sample_result <- renderText({
+      p <- t.test(sample_dat()[["thicc bois"]],
+             sample_dat()[["chonkers"]],
+             paired = FALSE)[["p.value"]]
+      if(p >= 0.05){
+        paste("p-value = ", p)
+      } else {
+        paste("p-value = ", p, "*")
+      }
+    })
+
+}
+
+# Run the application 
+shinyApp(ui = ui, server = server)
+