R/genetic_disease_explore.R
In lharris421/gdexpl: Explore Genes Linked to Diseases and Diseases Linked to Genes
Defines functions
genetic_disease_explore
Documented in
genetic_disease_explore
#' @title Explore Gene-Disease Associations
#'
#' @description This is a Shiny Gadget that allows the user to easily explore gene associated with certain diseases and vice versa.
#' The user is able to either have a chromoMap built or have a data table produced. The chromoMap has a number of preset diseases that can be
#' explored based on ICD-9 coding. In the future, I plan on expanding the selection possibilities. After the user creates a chromoMap, they will
#' also be able to explore genes and related diseases that appear in the chromoMap. Genes are identified by their geneid which is a Universal number
#' that identifies genes. If the user knows what gene or genes they wish to explore, they may also specify them manually without running a chromoMap.
#' Multiple genes should be seperated by a comma and unreconized genes will produce a connection warning but will not stop the Gadget. In either use case
#' the user may save the necesssary files to reproduce the chromoMap or data table or may have (and specify the name) th object saved to their Global
#' Enviornment upon hitting 'done'. Note, hitting cancel will stop the app and kill any messages but will objects already saved will not be aborted.
#' @param ... (optional)
#' The ... take a number of styling options for the chromomap. The options are canvas_height (Numeric), canvas_width (Numeric), chr_color (Character String), anno_col (Character String), chr_width (Numeric), ch_gap (Numeric), labels (T/F).
#' @param inputValue1
#' For shiny gadget
#' @param inputValue2
#' For shiny gadget
#'
#' @export
#'
#' @import magrittr
#' @import chromoMap
#' @import glue
#' @import readr
#' @import rvest
#' @import stringr
#' @import tibble
#' @import xml2
#' @import dplyr
#' @import htmlwidgets
#' @import miniUI
#' @import shiny
#' @import shinyjs
#'
#' @return A number of different objects or files in and outside of R depending on selections
#' in the gadget. It can return data files, messages, and R objects. Data files for the chromoMap include an annotation file (.txt) and styling file (.rds)
#' Data files for the gene to disease tab can be outputted as a .csv. They can lso be saved to the R global enviornment with a user specified name.
#' The chromomap will be saved as a list, the gene to disease data will be saved as a table. During useage and upon completion, messages will
#' be produced in the console to inform the user of the processes happening on the backend.
#' @examples
#' \dontrun{
#' genetic_disease_explore()
#' }
#'
#' @details
#' Directions: Run the function.
#'
#' 1. You can then select a disease and click "Create Chromomap." You may also proceed directly to
#' the gene-disease table where you can specify genes you want to explore if you know their ids. You will also need to
#' select the columns you'd like to use. If this is the case and you have more than one geneid, then seperate others with
#' commas. Click "Create Gene Table
#'
#' 2. After running the chromoMap, you will also be able to select these genes for the disease-gene table. If this is the case
#' make sure you select the map selection.
#'
#' 3. Proceed to chromosome or gene table page. In either page you can output the dataset as a file or to R. If
#' you choose to output to R, you must set an object name - follow proper conventions- or the default will be used.
#'
#' 4. Click 'Done'
#'
#' Note: Clicking "Cancel" will stop the Gadget and produce and error, but it will not undo already saved files.
genetic_disease_explore <- function(inputValue1, inputValue2, ...) {
chromosomes <- gdexpl::chromosomes
readr::write_delim(chromosomes, "chromosomes.txt", delim = "\t",
col_names = F)
cols <- colnames(readr::read_tsv("https://www.disgenet.org/api/gda/gene/1081?source=CURATED&min_score=0&max_score=1&format=tsv"))
cols <- cols[which(cols != "geneid")]
rV <- NULL
## Cleaned disease data to load into function
cleaned_res <- diseases
in_widget <- cleaned_res$icd9
names(in_widget) <- cleaned_res$cleaned_res
## Preset values for getting data later
database <- "CURATED"
score <- c(0,1)
## UI minipage body ----
ui <- miniUI::miniPage(
shinyjs::useShinyjs(),
## A bit of shiny::HTML to change the default color of buttons
shiny::tags$head(
shiny::tags$style(shiny::HTML('#chromo{background-color:orange}')),
shiny::tags$style(shiny::HTML('#table{background-color:orange}')),
shiny::tags$style(shiny::HTML('#chrom_r{background-color:orange}')),
shiny::tags$style(shiny::HTML('#table_r{background-color:orange}')),
shiny::tags$style(shiny::HTML('#table_csv{background-color:orange}')),
shiny::tags$style(shiny::HTML('#chrom_r_save{background-color:orange}'))
),
miniUI::gadgetTitleBar("Disease-Gene Linkage Exploration"),
miniUI::miniTabstripPanel(id = "main",
miniUI::miniTabPanel("Select Options", icon = shiny::icon("sliders"),
miniUI::miniContentPanel(
shiny::selectizeInput("disease", "Select Disease", in_widget),
shiny::actionButton("chromo", "Create Chromomap", color = "blue"),
shiny::br(),shiny::hr(),
shiny::fillRow(
shiny::fillCol(
shiny::uiOutput("geneuiu"),
shiny::uiOutput("geneuim"),
shiny::uiOutput("geneinput"),
shiny::actionButton("table", "Create Gene Table")
),
shiny::fillCol(
shiny::selectizeInput("cols", "Select Columns for Data Table", choice = cols, multiple = T)
)
)
)
),
miniUI::miniTabPanel(title = "Chromomap", value = "tab2", icon = shiny::icon("align-left"),
miniUI::miniContentPanel(
shiny::tags$div(id = "r1",
shiny::tags$h3("Please select output options on the 'Select Options' tab")
),
chromoMap::chromoMapOutput("chrom"),
shiny::fluidRow(
shiny::column(width = 6,
shiny::uiOutput("chrom_r_download_name"),
shiny::uiOutput("chrom_r_to_r")),
shiny::column(width = 6,
shiny::br(), shiny::hr(),
shiny::uiOutput("chrom_r_download"))),
shiny::br()
)
),
miniUI::miniTabPanel("Gene to Diseases Table", icon = shiny::icon("table"),
miniUI::miniContentPanel(
shiny::tags$div(id = "r2",
shiny::tags$h3("Please select output options on the 'Select Options' tab")
),
shiny::tableOutput("gene_table"),
shiny::fluidRow(
shiny::column(width = 6,
shiny::uiOutput("table_r_download_name"),
shiny::uiOutput("table_r_download")),
shiny::column(width = 6,
shiny::br(),shiny::hr(),
shiny::uiOutput("table_csv_download"))),
shiny::br()
))
)
)
server <- function(input, output, session) {
to_scrape <- NULL
output$geneuiu <- renderUI({textInput("user", "Enter a Gene ID", "123, 456, 789")})
# When the Done button is clicked, return a value
observeEvent(input$chromo, {
shinyjs::hide("r1")
disease <- input$disease
url <- glue::glue("http://www.disgenet.org/api/gda/disease/icd9cm/{disease}?source={database}&min_score={score[1]}&max_score={score[2]}&format=tsv")
gene_info <- list(readr::read_tsv(url), disease)
to_scrape <- unique(gene_info[[1]]$geneid)
output$geneuim <- renderUI({shiny::selectizeInput("gene", "or Select Gene",
to_scrape,
multiple = T)})
output$geneinput <- renderUI({radioButtons("useromap", "Manual Input or Input Gene(s) from Map",
c("Manual", "Map"))})
output$chrom_r_download <- renderUI({shiny::actionButton("chrom_r", "Save Chromomap Annotations (.txt) and settings (.rds)")})
output$chrom_r_download_name <- renderUI({textInput("chrom_r_name", "Object Name", value = "chromomap")})
output$chrom_r_to_r <- renderUI({shiny::actionButton("chrom_r_save", "Save Chromomap to R")})
## Create URL
urls <- sapply(to_scrape, function(x) {glue::glue("https://www.ncbi.nlm.nih.gov/gene/{x}")}, USE.NAMES = F)
## Preallocate space
start <- numeric(length(urls))
end <- numeric(length(urls))
chromosome <- character(length(urls))
## Scrape and obtain data
for (i in 1:length(urls)) {
web_page <- xml2::read_html(urls[i])
html_data <- rvest::html_nodes(web_page, 'tr:nth-child(1) td:nth-child(5)')
text <- rvest::html_text(html_data)
if (length(text) == 0) {
start[i] <- 0
end[i] <- 0
chromosome[i] <- 0
next
}
start[i] <- stringr::str_extract(text, "(?<=[(])\\d*")
end[i] <- stringr::str_extract(text, "(?<=\\.\\.)\\d*")
html_data_2 <- rvest::html_nodes(web_page, 'tr:nth-child(1) td:nth-child(4)')
text_2 <- rvest::html_text(html_data_2)
chromosome[i] <- text_2[1]
## Give the user an update
print(glue::glue("Getting data for Gene {to_scrape[i]} ({i} of {length(start)})"))
}
## Create gene table and save it for function reference
anno <- tibble::as_tibble(cbind(unique(gene_info[[1]]$geneid), as.character(chromosome), start, end)) %>%
dplyr::filter(chromosome %in% as.character(c(1:22, "X", "Y"))) %>%
dplyr::filter(chromosome != 0)
anno_name <- glue::glue("annotation_{stringr::str_remove_all(names(in_widget)[which(in_widget == as.numeric(input$disease))], ' |,')}.txt")
write.table(anno, file = anno_name, sep = "\t", quote = F,
col.names = F, row.names = F)
my_name <- stringr::str_remove_all(names(in_widget)[which(in_widget == as.numeric(input$disease))], ' |,')
title <- glue::glue("Genes associates with {cleaned_res[as.character(cleaned_res$icd9) == gene_info[[2]], 'cleaned_res']}")
atts <- list(...)
## Load in attributes for the chromomap and supply defaults if not specified
canvas_height <- ifelse(is.null(atts[["canvas_height"]]), 800, atts[["canvas_height"]])
canvas_width <- ifelse(is.null(atts[["canvas_width"]]), 750, atts[["canvas_width"]])
chr_color <- ifelse(is.null(atts[["chr_color"]]), c("lightblue"), atts[["chr_color"]])
anno_col <- ifelse(is.null(atts[["anno_col"]]), c("black"), atts[["anno_col"]])
chr_width <- ifelse(is.null(atts[["chr_width"]]), 8, atts[["chr_width"]])
ch_gap <- ifelse(is.null(atts[["ch_gap"]]), 4, atts[["ch_gap"]])
labels <- ifelse(is.null(atts[["labels"]]), F, atts[["labels"]])
## Write otu data an attributes, specify specific names so different outputs can be made if necessary
settings <- list(canvas_height, canvas_width, chr_color, anno_col, chr_width, ch_gap, labels, title, my_name)
names(settings) <- c("canvas_height", "canvas_width", "chr_color", "anno_col", "chr_width", "ch_gap", "labels", "title", "my_name")
my_env <- environment()
assign("settings", settings, envir = parent.env(my_env))
## Create Chromomap
chrom <- chromomap_2_shiny("chromosomes.txt", data.files = anno_name,
canvas_height = canvas_height,
canvas_width = canvas_width,
chr_color = chr_color,
anno_col = anno_col,
chr_width = chr_width,
ch_gap = ch_gap,
title = title,
labels = labels)
my_env <- environment()
assign("chromo", chrom, envir = parent.env(my_env))
output$chrom <- chromoMap::renderChromoMap({
chrom
})
})
observeEvent(input$table, {
shinyjs::hide("r2")
output$table_r_download <- renderUI({shiny::actionButton("table_r", "Save Table to R")})
output$table_r_download_name <- renderUI({textInput("table_r_name", "Object Name", value = "table_output")})
output$table_csv_download <- renderUI({shiny::actionButton("table_csv", "Save Table to CSV")})
uom <- ifelse(is.null(input$useromap), "yes", input$useromap)
switch <- !(uom == "Manual" | uom == "yes")
if (switch) {
genes <- input$gene
if (length(genes) > 1) {
all_genes <- list()
for (i in 1:length(genes)) {
gene_id <- genes[i]
gene_disease <- readr::read_tsv(glue::glue("https://www.disgenet.org/api/gda/gene/{gene_id}?source=CURATED&min_score=0&max_score=1&format=tsv"))
all_genes[[i]] <- gene_disease
}
gene_res <- do.call(rbind, all_genes)
} else {
gene_id <- input$gene
gene_disease <- readr::read_tsv(glue::glue("https://www.disgenet.org/api/gda/gene/{gene_id}?source=CURATED&min_score=0&max_score=1&format=tsv"))
gene_res <- gene_disease
}
} else {
if (stringr::str_detect(input$user, ",")) {
genes <- as.numeric(unlist(stringr::str_split(stringr::str_remove_all(input$user, " "), ",")))
all_genes_1 <- list()
for (i in 1:length(genes)) {
gene_id <- genes[i]
my_url <- glue::glue("https://www.disgenet.org/api/gda/gene/{gene_id}?source=CURATED&min_score=0&max_score=1&format=tsv")
gene_disease <- tryCatch(readr::read_tsv(my_url),
error = function(cond) {
close(url(my_url))
return(NULL)},
warning = function(cond) {
close(url(my_url))
return(NULL)})
all_genes_1[[i]] <- gene_disease
}
gene_res <- do.call(rbind, all_genes_1)
} else {
gene_id <- as.numeric(stringr::str_remove_all(input$user, " "))
gene_disease <- readr::read_tsv(glue::glue("https://www.disgenet.org/api/gda/gene/{gene_id}?source=CURATED&min_score=0&max_score=1&format=tsv"))
gene_res <- gene_disease
}
}
gene_res <- gene_res %>%
dplyr::mutate(geneid = as.integer(geneid))
gene_res <- gene_res %>%
dplyr::filter(!is.na(disease_class)) %>%
dplyr::select("geneid", input$cols)
genes <- paste(unique(gene_res$geneid), collapse = "")
my_env <- environment()
assign("gene_res", gene_res, envir = parent.env(my_env))
assign("genes", genes, envir = parent.env(my_env))
output$gene_table <- renderTable(gene_res)
})
observeEvent(input$chrom_r, {
settings_name <- glue::glue("settings_{stringr::str_remove_all(names(in_widget)[which(in_widget == as.numeric(input$disease))], ' |,')}.rds")
saveRDS(settings, settings_name)
d_name <- names(in_widget)[which(in_widget == as.numeric(input$disease))]
my_env <- environment()
rV <- get("rV", envir = parent.env(my_env))
rV <- append(rV, glue::glue("Annotation and settings files for {d_name} has been saved"))
assign("rV", rV, envir = parent.env(my_env))
print("Save successful")
})
observeEvent(input$chrom_r_save, {
assign(input$chrom_r_name, chromo, envir = globalenv())
d_name <- names(in_widget)[which(in_widget == as.numeric(input$disease))]
my_env <- environment()
rV <- get("rV", envir = parent.env(my_env))
rV <- append(rV, glue::glue("Chromomap for {d_name} has been saved to R"))
assign("rV", rV, envir = parent.env(my_env))
print("Save successful, chromomap will be avalible in R after pressing 'done'")
})
observeEvent(input$table_r, {
assign(input$table_r_name, gene_res, envir = globalenv())
my_env <- environment()
rV <- get("rV", envir = parent.env(my_env))
rV <- append(rV, glue::glue("Data file for {genes} has been saved to R"))
assign("rV", rV, envir = parent.env(my_env))
print("Save successful and will be useable after clicking 'done'")
})
observeEvent(input$table_csv, {
readr::write_csv(gene_res, glue::glue("{stringr::str_remove_all(genes, ' |,')}_data.csv"))
my_env <- environment()
rV <- get("rV", envir = parent.env(my_env))
rV <- append(rV, glue::glue("A data file for {genes} has been saved"))
assign("rV", rV, envir = parent.env(my_env))
print("Save successful")
})
observeEvent(input$done, {
my_env <- environment()
returnValue <- get("rV", envir = parent.env(my_env))
if (is.null(returnValue)) {returnValue <- "No data was saved"}
stopApp(returnValue)
})
}
## Pull ui and server together to run
shiny::runGadget(ui, server)
}
lharris421/gdexpl documentation built on Dec. 23, 2019, 6:38 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions genetic_disease_explore
Documented in genetic_disease_explore
#' @title Explore Gene-Disease Associations
#'
#' @description This is a Shiny Gadget that allows the user to easily explore gene associated with certain diseases and vice versa.
#' The user is able to either have a chromoMap built or have a data table produced. The chromoMap has a number of preset diseases that can be
#' explored based on ICD-9 coding. In the future, I plan on expanding the selection possibilities. After the user creates a chromoMap, they will
#' also be able to explore genes and related diseases that appear in the chromoMap. Genes are identified by their geneid which is a Universal number
#' that identifies genes. If the user knows what gene or genes they wish to explore, they may also specify them manually without running a chromoMap.
#' Multiple genes should be seperated by a comma and unreconized genes will produce a connection warning but will not stop the Gadget. In either use case
#' the user may save the necesssary files to reproduce the chromoMap or data table or may have (and specify the name) th object saved to their Global
#' Enviornment upon hitting 'done'. Note, hitting cancel will stop the app and kill any messages but will objects already saved will not be aborted.
#' @param ... (optional)
#' The ... take a number of styling options for the chromomap. The options are canvas_height (Numeric), canvas_width (Numeric), chr_color (Character String), anno_col (Character String), chr_width (Numeric), ch_gap (Numeric), labels (T/F).
#' @param inputValue1
#' For shiny gadget
#' @param inputValue2
#' For shiny gadget
#'
#' @export
#'
#' @import magrittr
#' @import chromoMap
#' @import glue
#' @import readr
#' @import rvest
#' @import stringr
#' @import tibble
#' @import xml2
#' @import dplyr
#' @import htmlwidgets
#' @import miniUI
#' @import shiny
#' @import shinyjs
#'
#' @return A number of different objects or files in and outside of R depending on selections
#' in the gadget. It can return data files, messages, and R objects. Data files for the chromoMap include an annotation file (.txt) and styling file (.rds)
#' Data files for the gene to disease tab can be outputted as a .csv. They can lso be saved to the R global enviornment with a user specified name.
#' The chromomap will be saved as a list, the gene to disease data will be saved as a table. During useage and upon completion, messages will
#' be produced in the console to inform the user of the processes happening on the backend.
#' @examples
#' \dontrun{
#' genetic_disease_explore()
#' }
#'
#' @details
#' Directions: Run the function.
#'
#' 1. You can then select a disease and click "Create Chromomap." You may also proceed directly to
#' the gene-disease table where you can specify genes you want to explore if you know their ids. You will also need to
#' select the columns you'd like to use. If this is the case and you have more than one geneid, then seperate others with
#' commas. Click "Create Gene Table
#'
#' 2. After running the chromoMap, you will also be able to select these genes for the disease-gene table. If this is the case
#' make sure you select the map selection.
#'
#' 3. Proceed to chromosome or gene table page. In either page you can output the dataset as a file or to R. If
#' you choose to output to R, you must set an object name - follow proper conventions- or the default will be used.
#'
#' 4. Click 'Done'
#'
#' Note: Clicking "Cancel" will stop the Gadget and produce and error, but it will not undo already saved files.
genetic_disease_explore <- function(inputValue1, inputValue2, ...) {
chromosomes <- gdexpl::chromosomes
readr::write_delim(chromosomes, "chromosomes.txt", delim = "\t",
col_names = F)
cols <- colnames(readr::read_tsv("https://www.disgenet.org/api/gda/gene/1081?source=CURATED&min_score=0&max_score=1&format=tsv"))
cols <- cols[which(cols != "geneid")]
rV <- NULL
## Cleaned disease data to load into function
cleaned_res <- diseases
in_widget <- cleaned_res$icd9
names(in_widget) <- cleaned_res$cleaned_res
## Preset values for getting data later
database <- "CURATED"
score <- c(0,1)
## UI minipage body ----
ui <- miniUI::miniPage(
shinyjs::useShinyjs(),
## A bit of shiny::HTML to change the default color of buttons
shiny::tags$head(
shiny::tags$style(shiny::HTML('#chromo{background-color:orange}')),
shiny::tags$style(shiny::HTML('#table{background-color:orange}')),
shiny::tags$style(shiny::HTML('#chrom_r{background-color:orange}')),
shiny::tags$style(shiny::HTML('#table_r{background-color:orange}')),
shiny::tags$style(shiny::HTML('#table_csv{background-color:orange}')),
shiny::tags$style(shiny::HTML('#chrom_r_save{background-color:orange}'))
),
miniUI::gadgetTitleBar("Disease-Gene Linkage Exploration"),
miniUI::miniTabstripPanel(id = "main",
miniUI::miniTabPanel("Select Options", icon = shiny::icon("sliders"),
miniUI::miniContentPanel(
shiny::selectizeInput("disease", "Select Disease", in_widget),
shiny::actionButton("chromo", "Create Chromomap", color = "blue"),
shiny::br(),shiny::hr(),
shiny::fillRow(
shiny::fillCol(
shiny::uiOutput("geneuiu"),
shiny::uiOutput("geneuim"),
shiny::uiOutput("geneinput"),
shiny::actionButton("table", "Create Gene Table")
),
shiny::fillCol(
shiny::selectizeInput("cols", "Select Columns for Data Table", choice = cols, multiple = T)
)
)
)
),
miniUI::miniTabPanel(title = "Chromomap", value = "tab2", icon = shiny::icon("align-left"),
miniUI::miniContentPanel(
shiny::tags$div(id = "r1",
shiny::tags$h3("Please select output options on the 'Select Options' tab")
),
chromoMap::chromoMapOutput("chrom"),
shiny::fluidRow(
shiny::column(width = 6,
shiny::uiOutput("chrom_r_download_name"),
shiny::uiOutput("chrom_r_to_r")),
shiny::column(width = 6,
shiny::br(), shiny::hr(),
shiny::uiOutput("chrom_r_download"))),
shiny::br()
)
),
miniUI::miniTabPanel("Gene to Diseases Table", icon = shiny::icon("table"),
miniUI::miniContentPanel(
shiny::tags$div(id = "r2",
shiny::tags$h3("Please select output options on the 'Select Options' tab")
),
shiny::tableOutput("gene_table"),
shiny::fluidRow(
shiny::column(width = 6,
shiny::uiOutput("table_r_download_name"),
shiny::uiOutput("table_r_download")),
shiny::column(width = 6,
shiny::br(),shiny::hr(),
shiny::uiOutput("table_csv_download"))),
shiny::br()
))
)
)
server <- function(input, output, session) {
to_scrape <- NULL
output$geneuiu <- renderUI({textInput("user", "Enter a Gene ID", "123, 456, 789")})
# When the Done button is clicked, return a value
observeEvent(input$chromo, {
shinyjs::hide("r1")
disease <- input$disease
url <- glue::glue("http://www.disgenet.org/api/gda/disease/icd9cm/{disease}?source={database}&min_score={score[1]}&max_score={score[2]}&format=tsv")
gene_info <- list(readr::read_tsv(url), disease)
to_scrape <- unique(gene_info[[1]]$geneid)
output$geneuim <- renderUI({shiny::selectizeInput("gene", "or Select Gene",
to_scrape,
multiple = T)})
output$geneinput <- renderUI({radioButtons("useromap", "Manual Input or Input Gene(s) from Map",
c("Manual", "Map"))})
output$chrom_r_download <- renderUI({shiny::actionButton("chrom_r", "Save Chromomap Annotations (.txt) and settings (.rds)")})
output$chrom_r_download_name <- renderUI({textInput("chrom_r_name", "Object Name", value = "chromomap")})
output$chrom_r_to_r <- renderUI({shiny::actionButton("chrom_r_save", "Save Chromomap to R")})
## Create URL
urls <- sapply(to_scrape, function(x) {glue::glue("https://www.ncbi.nlm.nih.gov/gene/{x}")}, USE.NAMES = F)
## Preallocate space
start <- numeric(length(urls))
end <- numeric(length(urls))
chromosome <- character(length(urls))
## Scrape and obtain data
for (i in 1:length(urls)) {
web_page <- xml2::read_html(urls[i])
html_data <- rvest::html_nodes(web_page, 'tr:nth-child(1) td:nth-child(5)')
text <- rvest::html_text(html_data)
if (length(text) == 0) {
start[i] <- 0
end[i] <- 0
chromosome[i] <- 0
next
}
start[i] <- stringr::str_extract(text, "(?<=[(])\\d*")
end[i] <- stringr::str_extract(text, "(?<=\\.\\.)\\d*")
html_data_2 <- rvest::html_nodes(web_page, 'tr:nth-child(1) td:nth-child(4)')
text_2 <- rvest::html_text(html_data_2)
chromosome[i] <- text_2[1]
## Give the user an update
print(glue::glue("Getting data for Gene {to_scrape[i]} ({i} of {length(start)})"))
}
## Create gene table and save it for function reference
anno <- tibble::as_tibble(cbind(unique(gene_info[[1]]$geneid), as.character(chromosome), start, end)) %>%
dplyr::filter(chromosome %in% as.character(c(1:22, "X", "Y"))) %>%
dplyr::filter(chromosome != 0)
anno_name <- glue::glue("annotation_{stringr::str_remove_all(names(in_widget)[which(in_widget == as.numeric(input$disease))], ' |,')}.txt")
write.table(anno, file = anno_name, sep = "\t", quote = F,
col.names = F, row.names = F)
my_name <- stringr::str_remove_all(names(in_widget)[which(in_widget == as.numeric(input$disease))], ' |,')
title <- glue::glue("Genes associates with {cleaned_res[as.character(cleaned_res$icd9) == gene_info[[2]], 'cleaned_res']}")
atts <- list(...)
## Load in attributes for the chromomap and supply defaults if not specified
canvas_height <- ifelse(is.null(atts[["canvas_height"]]), 800, atts[["canvas_height"]])
canvas_width <- ifelse(is.null(atts[["canvas_width"]]), 750, atts[["canvas_width"]])
chr_color <- ifelse(is.null(atts[["chr_color"]]), c("lightblue"), atts[["chr_color"]])
anno_col <- ifelse(is.null(atts[["anno_col"]]), c("black"), atts[["anno_col"]])
chr_width <- ifelse(is.null(atts[["chr_width"]]), 8, atts[["chr_width"]])
ch_gap <- ifelse(is.null(atts[["ch_gap"]]), 4, atts[["ch_gap"]])
labels <- ifelse(is.null(atts[["labels"]]), F, atts[["labels"]])
## Write otu data an attributes, specify specific names so different outputs can be made if necessary
settings <- list(canvas_height, canvas_width, chr_color, anno_col, chr_width, ch_gap, labels, title, my_name)
names(settings) <- c("canvas_height", "canvas_width", "chr_color", "anno_col", "chr_width", "ch_gap", "labels", "title", "my_name")
my_env <- environment()
assign("settings", settings, envir = parent.env(my_env))
## Create Chromomap
chrom <- chromomap_2_shiny("chromosomes.txt", data.files = anno_name,
canvas_height = canvas_height,
canvas_width = canvas_width,
chr_color = chr_color,
anno_col = anno_col,
chr_width = chr_width,
ch_gap = ch_gap,
title = title,
labels = labels)
my_env <- environment()
assign("chromo", chrom, envir = parent.env(my_env))
output$chrom <- chromoMap::renderChromoMap({
chrom
})
})
observeEvent(input$table, {
shinyjs::hide("r2")
output$table_r_download <- renderUI({shiny::actionButton("table_r", "Save Table to R")})
output$table_r_download_name <- renderUI({textInput("table_r_name", "Object Name", value = "table_output")})
output$table_csv_download <- renderUI({shiny::actionButton("table_csv", "Save Table to CSV")})
uom <- ifelse(is.null(input$useromap), "yes", input$useromap)
switch <- !(uom == "Manual" | uom == "yes")
if (switch) {
genes <- input$gene
if (length(genes) > 1) {
all_genes <- list()
for (i in 1:length(genes)) {
gene_id <- genes[i]
gene_disease <- readr::read_tsv(glue::glue("https://www.disgenet.org/api/gda/gene/{gene_id}?source=CURATED&min_score=0&max_score=1&format=tsv"))
all_genes[[i]] <- gene_disease
}
gene_res <- do.call(rbind, all_genes)
} else {
gene_id <- input$gene
gene_disease <- readr::read_tsv(glue::glue("https://www.disgenet.org/api/gda/gene/{gene_id}?source=CURATED&min_score=0&max_score=1&format=tsv"))
gene_res <- gene_disease
}
} else {
if (stringr::str_detect(input$user, ",")) {
genes <- as.numeric(unlist(stringr::str_split(stringr::str_remove_all(input$user, " "), ",")))
all_genes_1 <- list()
for (i in 1:length(genes)) {
gene_id <- genes[i]
my_url <- glue::glue("https://www.disgenet.org/api/gda/gene/{gene_id}?source=CURATED&min_score=0&max_score=1&format=tsv")
gene_disease <- tryCatch(readr::read_tsv(my_url),
error = function(cond) {
close(url(my_url))
return(NULL)},
warning = function(cond) {
close(url(my_url))
return(NULL)})
all_genes_1[[i]] <- gene_disease
}
gene_res <- do.call(rbind, all_genes_1)
} else {
gene_id <- as.numeric(stringr::str_remove_all(input$user, " "))
gene_disease <- readr::read_tsv(glue::glue("https://www.disgenet.org/api/gda/gene/{gene_id}?source=CURATED&min_score=0&max_score=1&format=tsv"))
gene_res <- gene_disease
}
}
gene_res <- gene_res %>%
dplyr::mutate(geneid = as.integer(geneid))
gene_res <- gene_res %>%
dplyr::filter(!is.na(disease_class)) %>%
dplyr::select("geneid", input$cols)
genes <- paste(unique(gene_res$geneid), collapse = "")
my_env <- environment()
assign("gene_res", gene_res, envir = parent.env(my_env))
assign("genes", genes, envir = parent.env(my_env))
output$gene_table <- renderTable(gene_res)
})
observeEvent(input$chrom_r, {
settings_name <- glue::glue("settings_{stringr::str_remove_all(names(in_widget)[which(in_widget == as.numeric(input$disease))], ' |,')}.rds")
saveRDS(settings, settings_name)
d_name <- names(in_widget)[which(in_widget == as.numeric(input$disease))]
my_env <- environment()
rV <- get("rV", envir = parent.env(my_env))
rV <- append(rV, glue::glue("Annotation and settings files for {d_name} has been saved"))
assign("rV", rV, envir = parent.env(my_env))
print("Save successful")
})
observeEvent(input$chrom_r_save, {
assign(input$chrom_r_name, chromo, envir = globalenv())
d_name <- names(in_widget)[which(in_widget == as.numeric(input$disease))]
my_env <- environment()
rV <- get("rV", envir = parent.env(my_env))
rV <- append(rV, glue::glue("Chromomap for {d_name} has been saved to R"))
assign("rV", rV, envir = parent.env(my_env))
print("Save successful, chromomap will be avalible in R after pressing 'done'")
})
observeEvent(input$table_r, {
assign(input$table_r_name, gene_res, envir = globalenv())
my_env <- environment()
rV <- get("rV", envir = parent.env(my_env))
rV <- append(rV, glue::glue("Data file for {genes} has been saved to R"))
assign("rV", rV, envir = parent.env(my_env))
print("Save successful and will be useable after clicking 'done'")
})
observeEvent(input$table_csv, {
readr::write_csv(gene_res, glue::glue("{stringr::str_remove_all(genes, ' |,')}_data.csv"))
my_env <- environment()
rV <- get("rV", envir = parent.env(my_env))
rV <- append(rV, glue::glue("A data file for {genes} has been saved"))
assign("rV", rV, envir = parent.env(my_env))
print("Save successful")
})
observeEvent(input$done, {
my_env <- environment()
returnValue <- get("rV", envir = parent.env(my_env))
if (is.null(returnValue)) {returnValue <- "No data was saved"}
stopApp(returnValue)
})
}
## Pull ui and server together to run
shiny::runGadget(ui, server)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.