Skip to content

Commit

Permalink
More versatile styling for interactive plots
Browse files Browse the repository at this point in the history
  • Loading branch information
@zsteinmetz
zsteinmetz committed Aug 17, 2023
1 parent 055ff9b commit 8fd588c
Show file tree
Hide file tree
Showing 5 changed files with 214 additions and 157 deletions.
246 changes: 129 additions & 117 deletions R/interactive_plots.R
View file
Original file line number Diff line number Diff line change
@@ -1,25 +1,53 @@
#' @rdname interactive_plots
#' @title Plots for Open Specy objects
#' @title Interactive plots for OpenSpecy objects
#'
#' @description
#' These functions generate heatmaps, spectral plots, and interactive plots for OpenSpecy data.
#' These functions generate heatmaps, spectral plots, and interactive plots for
#' OpenSpecy data.
#'
#' @param x An \code{OpenSpecy} object containing metadata and spectral data for the first group.
#' @param x2 An optional second \code{OpenSpecy} object containing metadata and spectral data for the second group.
#' @param z Optional numeric vector specifying the intensity values for the heatmap. If not provided, the function will use the intensity values from the \code{OpenSpecy} object.
#' @param sn Optional numeric value specifying the signal-to-noise ratio threshold. If provided along with \code{min_sn}, regions with SNR below the threshold will be excluded from the heatmap.
#' @param cor Optional numeric value specifying the correlation threshold. If provided along with \code{min_cor}, regions with correlation below the threshold will be excluded from the heatmap.
#' @param min_sn Optional numeric value specifying the minimum signal-to-noise ratio for inclusion in the heatmap. Regions with SNR below this threshold will be excluded.
#' @param min_cor Optional numeric value specifying the minimum correlation for inclusion in the heatmap. Regions with correlation below this threshold will be excluded.
#' @param selected_spectrum Optional index of the selected spectrum to highlight on the heatmap.
#' @param selected_spectrum2 an optional second index of the selected spectrum to highlight on the heatmap.
#' @param \ldots further arguments passed to subfunctions.
#' @param x an \code{OpenSpecy} object containing metadata and spectral data for
#' the first group.
#' @param x2 an optional second \code{OpenSpecy} object containing metadata and
#' spectral data for the second group.
#' @param z optional numeric vector specifying the intensity values for the
#' heatmap. If not provided, the function will use the intensity values from the
#' \code{OpenSpecy} object.
#' @param sn optional numeric value specifying the signal-to-noise ratio
#' threshold. If provided along with \code{min_sn}, regions with SNR below the
#' threshold will be excluded from the heatmap.
#' @param cor optional numeric value specifying the correlation threshold. If
#' provided along with \code{min_cor}, regions with correlation below the
#' threshold will be excluded from the heatmap.
#' @param min_sn optional numeric value specifying the minimum signal-to-noise
#' ratio for inclusion in the heatmap. Regions with SNR below this threshold
#' will be excluded.
#' @param min_cor optional numeric value specifying the minimum correlation for
#' inclusion in the heatmap. Regions with correlation below this threshold
#' will be excluded.
#' @param select optional index of the selected spectrum to highlight on the
#' heatmap.
#' @param select2 an optional second index of the selected spectrum to highlight
#' on the heatmap.
#' @param line list; \code{line} parameter for \code{x}; passed to
#' \code{\link[plotly]{add_trace}()}.
#' @param line2 list; \code{line} parameter for \code{x2}; passed to
#' \code{\link[plotly]{add_trace}()}.
#' @param line_select list; \code{line}; parameter for \code{select}; passed to
#' \code{\link[plotly]{add_trace}()}.
#' @param font list; passed to \code{\link[plotly]{layout}()}.
#' @param plot_bgcolor color value; passed to \code{\link[plotly]{layout}()}.
#' @param paper_bgcolor color value; passed to \code{\link[plotly]{layout}()}.
#' @param colorscale colorscale passed to \code{\link[plotly]{add_trace}()}.
#' @param \ldots further arguments passed to \code{\link[plotly]{plot_ly}()}.
#'
#' @return A plotly heatmap object displaying the OpenSpecy data. A subplot containing the heatmap and spectra plot. A plotly object displaying the spectra from the \code{OpenSpecy} object(s).
#' @return
#' A plotly heatmap object displaying the OpenSpecy data. A subplot
#' containing the heatmap and spectra plot. A plotly object displaying the
#' spectra from the \code{OpenSpecy} object(s).
#'
#' @examples
#' data("raman_hdpe")
#' tiny_map <- read_zip(read_extdata("CA_tiny_map.zip"))
#' tiny_map <- read_extdata("CA_tiny_map.zip") |> read_zip()
#' plotly_spec(raman_hdpe)
#'
#' correlation <- cor_spec(
Expand All @@ -29,7 +57,7 @@
#' heatmap_spec(tiny_map, z = tiny_map$metadata$y)
#'
#' sample_spec(tiny_map, size = 12) |>
#' interactive_plot(selected_spectrum = 2, x2 = raman_hdpe)
#' interactive_plot(select = 2, x2 = raman_hdpe)
#'
#' @author
#' Win Cowger, Zacharias Steinmetz
Expand All @@ -52,55 +80,48 @@ plotly_spec.default <- function(x, ...) {
#' @rdname interactive_plots
#'
#' @export
plotly_spec.OpenSpecy <- function(x, x2 = NULL, ...) {
plotly_spec.OpenSpecy <- function(x, x2 = NULL,
line = list(color = 'rgb(255, 255, 255)'),
line2 = list(dash = "dash",
color = 'rgb(125,249,255)'),
font = list(color = '#FFFFFF'),
plot_bgcolor = 'rgb(17, 0, 73)',
paper_bgcolor = 'rgb(0, 0, 0)',
...) {
dt <- cbind(wavenumber = x$wavenumber, x$spectra) |>
melt(id.vars = "wavenumber", variable.name = "id", value.name = "intensity")

p <- plot_ly(dt, type = "scatter", mode = "lines", ...) |>
add_trace(x = ~wavenumber,
y = ~make_rel(intensity, na.rm = T),
color = ~id,
name = "Your Spectra",
line = list(color = 'rgb(255,255,255)'),
showlegend = F) |>
layout(xaxis = list(title = "wavenumber [cm<sup>-1</sup>]", autorange = "reversed"),
yaxis = list(title = "absorbance intensity [-]"),
plot_bgcolor = 'rgb(17,0,73)',
paper_bgcolor = 'rgb(0,0,0)',
legend = list(orientation = 'h', y = 1.1),
font = list(color = '#FFFFFF'))
add_trace(x = ~wavenumber, y = ~make_rel(intensity, na.rm = T),
color = ~id, line = line,
name = "Your Spectra", showlegend = F) |>
layout(xaxis = list(title = "wavenumber [cm<sup>-1</sup>]",
autorange = "reversed"),
yaxis = list(title = "intensity [-]"),
plot_bgcolor = plot_bgcolor,
paper_bgcolor = paper_bgcolor,
legend = list(orientation = 'h', y = 1.1), font = font)

# Add dummy trace for Your Spectra
p <- p |>
add_trace(x = NULL,
y = NULL,
line = list(color = 'rgb(255,255,255)'),
name = "Your Spectra",
showlegend = T)
add_trace(x = NULL, y = NULL,
line = line, name = "Your Spectra", showlegend = T)

if (!is.null(x2)) {
dt2 <- cbind(wavenumber = x2$wavenumber, x2$spectra) |>
melt(id.vars = "wavenumber", variable.name = "id", value.name = "intensity")

p <- p |>
add_trace(
data = dt2,
x = ~wavenumber,
y = ~make_rel(intensity, na.rm = T),
color = ~id,
type = "scatter",
mode = "lines",
name = "Library Spectra",
line = list(dash = "dash", color = 'rgb(125,249,255)'),
showlegend = F)
add_trace(data = dt2, x = ~wavenumber, y = ~make_rel(intensity, na.rm = T),
color = ~id, type = "scatter", mode = "lines",
name = "Library Spectra",
line = line2, showlegend = F)

# Add dummy trace for Library Spectra
p <- p |>
add_trace(x = NULL,
y = NULL,
line = list(dash = "dash", color = 'rgb(125,249,255)'),
name = "Library Spectra",
showlegend = T)
add_trace(x = NULL, y = NULL,
line = line2,
name = "Library Spectra", showlegend = T)
}

return(p)
Expand All @@ -124,69 +145,49 @@ heatmap_spec.default <- function(x, ...) {
#'
#' @export
heatmap_spec.OpenSpecy <- function(x,
z = NULL,
sn = NULL,
cor = NULL,
min_sn = NULL,
min_cor = NULL,
selected_spectrum = NULL, ...) {
if(!is.null(z)){
z = NULL, sn = NULL, cor = NULL,
min_sn = NULL, min_cor = NULL, select = NULL,
font = list(color = '#FFFFFF'),
plot_bgcolor = 'rgba(17, 0, 73, 0)',
paper_bgcolor = 'rgb(0, 0, 0)',
colorscale = 'Viridis',
...) {
if(!is.null(z))
plot_z <- z # default
}
else if(!is.null(cor)){
else if(!is.null(cor))
plot_z <- cor
}
else if(!is.null(sn)){
else if(!is.null(sn))
plot_z <- sn
}
else{
stop("z, cor, or sn need to be specified to plot the z axis", call. = F)
}
if (!is.null(sn) && !is.null(min_sn)) {
else stop("z, cor, or sn need to be specified to plot the z axis", call. = F)

if (!is.null(sn) && !is.null(min_sn))
plot_z <- ifelse(sn > min_sn, plot_z, NA)
}
if (!is.null(cor) && !is.null(min_cor)) {
plot_z <- ifelse(cor > min_cor, plot_z, NA)
}

#colorscale <- if (!is.null(cor)) {
# hcl.colors(n = sum(sn > min_sn & cor > min_cor), palette = "viridis")
#} else {
# heat.colors(n = sum(sn > min_sn))
#}
if (!is.null(cor) && !is.null(min_cor))
plot_z <- ifelse(cor > min_cor, plot_z, NA)

p <- plot_ly(...) |>
add_trace(
x = x$metadata$x,
y = x$metadata$y,
z = plot_z,
colorscale='Viridis',
type = "heatmap",
hoverinfo = 'text',
showscale = F,
text = ~paste(
"row: ", 1:nrow(x$metadata),
"<br>x: ", x$metadata$x,", y: ", x$metadata$y, ", z: ", plot_z,
if(!is.null(sn)){paste("<br>snr: ", round(sn, 0))} else{""},
if(!is.null(cor)){paste("<br>cor: ", round(cor, 1))} else{""})) |>
add_trace(x = x$metadata$x, y = x$metadata$y, z = plot_z,
colorscale = colorscale, type = "heatmap", hoverinfo = 'text',
showscale = F,
text = ~paste("row: ", 1:nrow(x$metadata),
"<br>x: ", x$metadata$x,", y: ", x$metadata$y,
", z: ", plot_z,
if(!is.null(sn)) paste("<br>snr: ", round(sn, 0)) else "",
if(!is.null(cor)) paste("<br>cor: ", round(cor, 1)) else ""
)) |>
layout(
#title = paste0(nrow(x$metadata), " Spectra"),
xaxis = list(title = 'x', zeroline = F, showgrid = F),
yaxis = list(title = 'y',
scaleanchor = "x",
scaleratio = 1,
yaxis = list(title = 'y', scaleanchor = "x", scaleratio = 1,
zeroline = F, showgrid = F),
plot_bgcolor = 'rgba(17,0,73, 0)',
paper_bgcolor = 'rgb(0,0,0)',
showlegend = FALSE,
font = list(color = '#FFFFFF'))

if(!is.null(selected_spectrum)){
p <- p |> add_markers(
name = "Selected Spectrum",
x = x$metadata$x[selected_spectrum],
y = x$metadata$y[selected_spectrum])
plot_bgcolor = plot_bgcolor, paper_bgcolor = paper_bgcolor,
showlegend = FALSE, font = font)

if(!is.null(select)){
p <- p |> add_markers(x = x$metadata$x[select], y = x$metadata$y[select],
name = "Selected Spectrum")
}

return(p)
}

Expand All @@ -207,37 +208,48 @@ interactive_plot.default <- function(x, ...) {
#' @rdname interactive_plots
#'
#' @export
interactive_plot.OpenSpecy <- function(x, selected_spectrum, x2 = NULL,
selected_spectrum2 = NULL, ...) {
interactive_plot.OpenSpecy <- function(x, select, x2 = NULL, select2 = NULL,
line = list(color = 'rgb(255, 255, 255)'),
line2 = list(dash = "dash",
color = 'rgb(125,249,255)'),
line_select = list(color = 'red'),
font = list(color = '#FFFFFF'),
plot_bgcolor = 'rgba(17, 0, 73, 0)',
paper_bgcolor = 'rgb(0, 0, 0)',
colorscale = 'Viridis',
...) {
# Generate the heatmap
heat_map <- heatmap_spec(x, z = x$metadata$y, selected_spectrum = selected_spectrum)
heat_map <- heatmap_spec(x, z = x$metadata$y, select = select,
font = font, plot_bgcolor = plot_bgcolor,
paper_bgcolor = paper_bgcolor,
colorscale = colorscale)

# Generate the spectral plot
spectra_plot <- plotly_spec(x, x2 = x2, selected_spectrum = selected_spectrum, selected_spectrum2 = selected_spectrum2)
spectra_plot <- plotly_spec(x, x2 = x2, select = select, select2 = select2,
line = line, line2 = line2, font = font,
plot_bgcolor = plot_bgcolor,
paper_bgcolor = paper_bgcolor)

# Extract intensity and wavenumber for the selected spectrum
selected_spectrum_points <- x$metadata[selected_spectrum, ]
selected_spectrum_intensity <- x$spectra[, selected_spectrum, with = F]
selected_spectrum_wavenumber <- x$wavenumber
select_points <- x$metadata[select, ]
select_intensity <- x$spectra[, select, with = F]
select_wavenumber <- x$wavenumber

# Add trace for the selected spectrum in the spectral plot
selected_spectrum_trace <- list(
type = "scatter",
mode = "lines",
x = selected_spectrum_wavenumber,
y = selected_spectrum_intensity,
line = list(color = 'red'), # Set the line color to red
name = "Selected Spectrum"
)
select_trace <- list(type = "scatter", mode = "lines", x = select_wavenumber,
y = select_intensity, line = line_select,
name = "Selected Spectrum"
)

# Update the spectral plot data with the selected spectrum trace
spectra_plot$data <- c(spectra_plot$data, selected_spectrum_trace)
spectra_plot$data <- c(spectra_plot$data, select_trace)

# Add margin to heatmap for separation
heat_map <- heat_map |> layout(autosize = TRUE, margin = list(b = 100))

# Combine both plots using subplot
plot_grid <- subplot(heat_map, spectra_plot, nrows = 2, heights = c(0.6, 0.4), margin = 0.1)
plot_grid <- subplot(heat_map, spectra_plot, nrows = 2, heights = c(0.6, 0.4),
margin = 0.1)

# Show the interactive plot
return(plot_grid)
Expand Down
27 changes: 9 additions & 18 deletions R/signal_noise.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,27 +60,18 @@ signal_noise.OpenSpecy <- function(x, metric = "signal_over_noise",
signal <- max(max, na.rm = T)#/mean(x, na.rm = T)
noise <- median(max[max != 0], na.rm = T)
}
else{
else {
signal = mean(y, na.rm = na.rm)
noise = sd(y, na.rm = na.rm)
}
if(metric == "signal"){
return(signal)
}
if(metric == "noise"){
return(noise)
}
if(metric == "signal_times_noise"){
return(abs(signal*noise))
}
if(metric %in% c("signal_over_noise", "run_signal_over_noise")){

if(metric == "signal") return(signal)
if(metric == "noise") return(noise)
if(metric == "signal_times_noise") return(abs(signal*noise))

if(metric %in% c("signal_over_noise", "run_signal_over_noise"))
return(abs(signal/noise))
}
if(metric == "total_signal"){
return(sum(y))
}
if(metric == "log_total_signal"){
return(sum(exp(y)))
}
if(metric == "total_signal") return(sum(y))
if(metric == "log_total_signal") return(sum(exp(y)))
}, FUN.VALUE = numeric(1))
}
Loading

0 comments on commit 8fd588c

Please sign in to comment.