johrpan/ubigen
1
0
Fork 0
mirror of https://github.com/johrpan/ubigen.git synced 2025-10-26 19:57:24 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

Reformat to use two spaces for tabs

Browse source
This commit is contained in:
Elias Projahn 2022-05-30 19:32:19 +02:00
parent 6aefa55eb9
commit 80d81c572d
3 changed files with 219 additions and 219 deletions
Download patch file Download diff file Expand all files Collapse all files

2
R/app.R
View file

@ -5,5 +5,5 @@
#' #'
#' @export #' @export
run_app <- function(host = "127.0.0.1", port = 3464) { run_app <- function(host = "127.0.0.1", port = 3464) {
runApp(shinyApp(ui, server), host = host, port = port) runApp(shinyApp(ui, server), host = host, port = port)
} }

220
R/server.R
View file

@ -1,43 +1,43 @@
#' Server implementing the main user interface. #' Server implementing the main user interface.
#' @noRd #' @noRd
server <- function(input, output) { server <- function(input, output) {
ranked_data <- reactive({ ranked_data <- reactive({
total_weight <- abs(input$above_zero) + total_weight <- abs(input$above_zero) +
abs(input$above_median) + abs(input$above_median) +
abs(input$above_95) + abs(input$above_95) +
abs(input$mean_expression) + abs(input$mean_expression) +
abs(input$sd_expression) abs(input$sd_expression)
data <- data.table::copy(ubigen::genes) data <- data.table::copy(ubigen::genes)
data[, score := data[, score :=
(input$above_zero * above_zero + (input$above_zero * above_zero +
input$above_95 * above_95 + input$above_95 * above_95 +
input$above_median * above_median + input$above_median * above_median +
input$mean_expression * mean_expression_normalized + input$mean_expression * mean_expression_normalized +
input$sd_expression * sd_expression_normalized) / input$sd_expression * sd_expression_normalized) /
total_weight] total_weight]
data.table::setorder(data, -score) data.table::setorder(data, -score)
data[, rank := .I] data[, rank := .I]
data[, percentile := 1 - rank / max(rank)] data[, percentile := 1 - rank / max(rank)]
data data
}) })
output$scores_plot <- plotly::renderPlotly(scores_plot(ranked_data())) output$scores_plot <- plotly::renderPlotly(scores_plot(ranked_data()))
output$selected_genes <- DT::renderDataTable({ output$selected_genes <- DT::renderDataTable({
selected_points <- plotly::event_data("plotly_selected") selected_points <- plotly::event_data("plotly_selected")
data <- if (is.null(selected_points)) { data <- if (is.null(selected_points)) {
ranked_data() ranked_data()
} else { } else {
ranked_data()[rank %in% selected_points$x] ranked_data()[rank %in% selected_points$x]
} }
genes_table(data) genes_table(data)
}) })
} }
#' Create plot showing the distribution of scores using `plotly`. #' Create plot showing the distribution of scores using `plotly`.
@ -49,95 +49,95 @@ server <- function(input, output) {
#' @return A `plotly` figure for rendering. #' @return A `plotly` figure for rendering.
#' @noRd #' @noRd
scores_plot <- function(ranked_data, ranks = 1000) { scores_plot <- function(ranked_data, ranks = 1000) {
data <- if (is.null(ranks)) { data <- if (is.null(ranks)) {
ranked_data ranked_data
} else { } else {
ranked_data[1:ranks] ranked_data[1:ranks]
} }
ranks_label <- if (is.null(ranks)) { ranks_label <- if (is.null(ranks)) {
"Ranks" "Ranks"
} else { } else {
glue::glue("Ranks (1 to {ranks})") glue::glue("Ranks (1 to {ranks})")
} }
plotly::plot_ly() |> plotly::plot_ly() |>
plotly::add_markers( plotly::add_markers(
data = data, data = data,
x = ~rank, x = ~rank,
y = ~score, y = ~score,
text = ~hgnc_name, text = ~hgnc_name,
customdata = ~percentile, customdata = ~percentile,
hovertemplate = paste0( hovertemplate = paste0(
"<b>%{text}</b><br>", "<b>%{text}</b><br>",
"Rank: %{x}<br>", "Rank: %{x}<br>",
"Score: %{y:.2}<br>", "Score: %{y:.2}<br>",
"Percentile: %{customdata:.2%}", "Percentile: %{customdata:.2%}",
"<extra></extra>" "<extra></extra>"
) )
) |> ) |>
plotly::layout( plotly::layout(
xaxis = list(title = ranks_label), xaxis = list(title = ranks_label),
yaxis = list(title = "Score"), yaxis = list(title = "Score"),
clickmode = "event+select", clickmode = "event+select",
dragmode = "select" dragmode = "select"
) )
} }
#' Create a displayable data table from the gene results data. #' Create a displayable data table from the gene results data.
#' @noRd #' @noRd
genes_table <- function(data) { genes_table <- function(data) {
data <- data[, .( data <- data[, .(
"Gene" = glue::glue_data( "Gene" = glue::glue_data(
data, data,
"<a href=\"https://www.ensembl.org/Homo_sapiens/Gene/Summary", "<a href=\"https://www.ensembl.org/Homo_sapiens/Gene/Summary",
"?db=core;g={gene}\" target=\"_blank\">{hgnc_name}</a>" "?db=core;g={gene}\" target=\"_blank\">{hgnc_name}</a>"
), ),
"Rank" = rank, "Rank" = rank,
"Percentile" = percentile, "Percentile" = percentile,
"Score" = score, "Score" = score,
"Median" = median_expression, "Median" = median_expression,
"Mean" = mean_expression, "Mean" = mean_expression,
"Standard deviation" = sd_expression, "Standard deviation" = sd_expression,
"Expressed" = above_zero, "Expressed" = above_zero,
"Above median" = above_median, "Above median" = above_median,
"Above 95%" = above_95 "Above 95%" = above_95
)] )]
DT::datatable( DT::datatable(
data, data,
options = list( options = list(
buttons = list( buttons = list(
list( list(
extend = "copy", extend = "copy",
text = "Copy to clipboard" text = "Copy to clipboard"
),
list(
extend = "csv",
text = "Download CSV"
)
),
dom = "fBrtip",
pageLength = 100
), ),
rownames = FALSE, list(
escape = FALSE, extend = "csv",
selection = "none", text = "Download CSV"
extensions = "Buttons" )
),
dom = "fBrtip",
pageLength = 100
),
rownames = FALSE,
escape = FALSE,
selection = "none",
extensions = "Buttons"
) |>
DT::formatPercentage(
c(
"Percentile",
"Score",
"Expressed",
"Above median",
"Above 95%"
),
digits = 2,
) |> ) |>
DT::formatPercentage( DT::formatRound(c(
c( "Median",
"Percentile", "Mean",
"Score", "Standard deviation"
"Expressed", ))
"Above median",
"Above 95%"
),
digits = 2,
) |>
DT::formatRound(c(
"Median",
"Mean",
"Standard deviation"
))
} }

216
R/ui.R
View file

@ -1,115 +1,115 @@
#' Function for creating the main user interface. #' Function for creating the main user interface.
#' @noRd #' @noRd
ui <- function() { ui <- function() {
navbarPage( navbarPage(
theme = bslib::bs_theme( theme = bslib::bs_theme(
version = 5, version = 5,
bootswatch = "united", bootswatch = "united",
primary = "#7d19bf" primary = "#7d19bf"
),
title = "Ubigen",
tabPanel(
"Explore",
sidebarLayout(
sidebarPanel(
width = 3,
h3("Features"),
sliderInput(
"above_zero",
verticalLayout(
strong("Expressed"),
paste0(
"Percentage of samples in which the gene is ",
"expressed."
)
),
min = -1.0,
max = 1.0,
step = 0.01,
value = 0.33
),
sliderInput(
"above_median",
verticalLayout(
strong("Expressed above median"),
paste0(
"Percentage of samples that express the gene ",
"more than the median of expression within ",
"that sample."
)
),
min = -1.0,
max = 1.0,
step = 0.01,
value = 0.33
),
sliderInput(
"above_95",
verticalLayout(
strong("Expressed above 95%"),
paste0(
"Percentage of samples that express the gene ",
"more than the 95. percentile of expression ",
"within that sample."
)
),
min = -1.0,
max = 1.0,
step = 0.01,
value = 0.33
),
sliderInput(
"mean_expression",
verticalLayout(
strong("Mean expression"),
div(paste0(
"Average of the gene's expression across all ",
"samples."
))
),
min = -1.0,
max = 1.0,
step = 0.01,
value = 1.0
),
sliderInput(
"sd_expression",
verticalLayout(
strong("Standard deviation"),
paste0(
"Standard deviation of the gene's expression ",
"across all samples."
)
),
min = -1.0,
max = 1.0,
step = 0.01,
value = -1.0
)
), ),
title = "Ubigen", mainPanel(
tabPanel( width = 9,
"Explore", h3("Distribution of scores"),
sidebarLayout( div(paste0(
sidebarPanel( "Click or drag within the figure to select genes of ",
width = 3, "interest."
h3("Features"), )),
sliderInput( plotly::plotlyOutput("scores_plot"),
"above_zero", h3("Detailed ranking"),
verticalLayout( div(paste0(
strong("Expressed"), "Click on gene names to view them using the Ensembl ",
paste0( "genome browser."
"Percentage of samples in which the gene is ", )),
"expressed." div(class = "p-1"),
) DT::dataTableOutput("selected_genes")
),
min = -1.0,
max = 1.0,
step = 0.01,
value = 0.33
),
sliderInput(
"above_median",
verticalLayout(
strong("Expressed above median"),
paste0(
"Percentage of samples that express the gene ",
"more than the median of expression within ",
"that sample."
)
),
min = -1.0,
max = 1.0,
step = 0.01,
value = 0.33
),
sliderInput(
"above_95",
verticalLayout(
strong("Expressed above 95%"),
paste0(
"Percentage of samples that express the gene ",
"more than the 95. percentile of expression ",
"within that sample."
)
),
min = -1.0,
max = 1.0,
step = 0.01,
value = 0.33
),
sliderInput(
"mean_expression",
verticalLayout(
strong("Mean expression"),
div(paste0(
"Average of the gene's expression across all ",
"samples."
))
),
min = -1.0,
max = 1.0,
step = 0.01,
value = 1.0
),
sliderInput(
"sd_expression",
verticalLayout(
strong("Standard deviation"),
paste0(
"Standard deviation of the gene's expression ",
"across all samples."
)
),
min = -1.0,
max = 1.0,
step = 0.01,
value = -1.0
)
),
mainPanel(
width = 9,
h3("Distribution of scores"),
div(paste0(
"Click or drag within the figure to select genes of ",
"interest."
)),
plotly::plotlyOutput("scores_plot"),
h3("Detailed ranking"),
div(paste0(
"Click on gene names to view them using the Ensembl ",
"genome browser."
)),
div(class = "p-1"),
DT::dataTableOutput("selected_genes")
)
)
),
tabPanel(
title = "Help"
),
tabPanel(
title = "Publication"
) )
)
),
tabPanel(
title = "Help"
),
tabPanel(
title = "Publication"
) )
)
} }