Nothing
setMethod("make_trace", signature = c(x = "RowPlot"),
function(x, xaxes, yaxes, colorbars, colorbar_grid, ...){
xa <- xaxes[[xaxis_name(x)]]
ya <- yaxes[[yaxis_name(x)]]
xvals <- get_data(x)[axis_order(ya)]
txt <- paste(if (!is.na(x@name)) x@name else NULL,
paste("Row:", axis_text(ya, ordered = TRUE)),
paste("Value:", xvals), sep = "<br>")
trace <- modifyList(x@additional,
list(y = I(axis_values(ya)),
x = I(xvals),
text = I(txt),
hoverinfo = "text",
xaxis = id(xa),
yaxis = id(ya),
showlegend = x@showlegend,
type = x@type,
name = if (!is.na(x@name))
x@name else NULL))
return(trace)
})
setMethod("make_trace", signature = c(x = "ColumnPlot"),
function(x, xaxes, yaxes, colorbars, colorbar_grid, ...){
xa <- xaxes[[xaxis_name(x)]]
ya <- yaxes[[yaxis_name(x)]]
yvals <- get_data(x)[axis_order(xa)]
txt <- paste(if (!is.na(x@name)) x@name else NULL,
paste("Column:", axis_text(xa, ordered = TRUE)),
paste("Value:", yvals), sep = "<br>")
trace <- modifyList(x@additional,
list(x = I(axis_values(xa)),
y = I(yvals),
text = I(txt),
hoverinfo = "text",
xaxis = id(xa),
yaxis = id(ya),
showlegend = x@showlegend,
type = x@type,
name = if (!is.na(x@name))
x@name else NULL))
return(trace)
})
#' add_col_plot
#'
#' Add a scatter or line plot with one point per column of the main heatmap
#' @param p iheatmap object
#' @param y y axis values
#' @param ... additional arguments to add to plotly scatter trace, see
#' \url{https://plotly.com/javascript/reference/#scatter}
#' @param mode mode of plot -- one of "lines+markers","lines", or "markers"
#' @param color color of bars
#' @param tracename name of trace (for legend and hover)
#' @param showlegend show in legend?
#' @param side side of plot on which to add subplot
#' @param layout yaxis layout list
#' @param size relative size of subplot relative to main heatmap
#' @param buffer amount of space to leave empty before this plot, relative to
#' size of first heatmap
#' @param xname internal name of xaxis
#' @param yname internal name of yaxis
#' @param pname internal name of plot
#'
#' @return \code{\link{Iheatmap-class}} object, which can be printed to generate
#' an interactive graphic
#' @export
#' @seealso \code{\link{add_col_signal}}, \code{\link{iheatmap}},
#' \code{\link{add_col_barplot}}
#' @rdname add_col_plot
#' @name add_col_plot
#' @aliases add_col_plot,Iheatmap-method
#' @author Alicia Schep
#' @examples
#'
#' mat <- matrix(rnorm(20), ncol = 5, nrow = 4)
#' hm <- iheatmap(mat) %>% add_col_plot(y = 1:5, tracename = "Strength")
#'
#' # Print heatmap if interactive session
#' if (interactive()) hm
setMethod(add_col_plot, c(p = "Iheatmap"),
function(p,
y,
...,
mode = c("lines+markers","lines","markers"),
color = NULL,
tracename = NA_character_,
showlegend = !is.na(tracename),
side = c("top","bottom"),
layout = list(),
size = 0.2,
buffer = 0.02,
xname = current_xaxis(p),
yname = NULL,
pname = if (!is.na(tracename)) tracename else "col_plot"){
side <- match.arg(side)
mode <- match.arg(mode)
additional_data <- modifyList(list(mode = mode), list(...))
if (is.null(color) && !isTRUE(showlegend)){
if (mode == "lines" || mode == "lines+markers"){
color_list <- list(line = list(color = "black"))
} else{
color_list <- list(marker = list(color = "black"))
}
additional_data <- modifyList(color_list, additional_data)
} else if (!is.null(color)){
if (mode == "lines" || mode == "lines+markers"){
color_list <- list(line = list(color = color))
} else{
color_list <- list(marker = list(color = color))
}
additional_data <- modifyList(color_list, additional_data)
}
new_y <- new_yaxis(p, xname, layout)
if (is.null(yname)) yname <- id(new_y)
new_plot <- new("ColumnPlot",
xaxis = xname,
yaxis = yname,
data = y,
showlegend = showlegend,
type = "scatter",
name = tracename,
additional = additional_data)
p <- add_axis(p,
new_y,
yname = yname,
xname = xname,
size = size,
buffer = buffer,
side = side)
p <- add_plot(p, new_plot, pname)
validObject(p)
p
})
#' add_row_plot
#'
#' Add a scatter or line plot with one point per row of the main heatmap
#' @param p iheatmap object
#' @param x x axis values
#' @param ... additional arguments to add to plotly scatter trace, see
#' \url{https://plotly.com/javascript/reference/#scatter}
#' @param mode mode of plot -- one of "lines+markers","lines", or "markers"
#' @param color color of bars
#' @param tracename name of trace (for legend and hover)
#' @param showlegend show in legend?
#' @param side side of plot on which to add subplot
#' @param layout yaxis layout list
#' @param size relative size of subplot relative to main heatmap
#' @param buffer amount of space to leave empty before this plot, relative to
#' size of first heatmap
#' @param xname internal name of xaxis
#' @param yname internal name of yaxis
#' @param pname internal name of plot
#'
#' @return \code{\link{Iheatmap-class}} object, which can be printed to generate
#' an interactive graphic
#' @export
#' @rdname add_row_plot
#' @name add_row_plot
#' @aliases add_row_plot,Iheatmap-method
#' @seealso \code{\link{add_row_signal}}, \code{\link{iheatmap}},
#' \code{\link{add_row_barplot}}
#' @author Alicia Schep
#' @examples
#'
#' mat <- matrix(rnorm(20), ncol = 5, nrow = 4)
#' hm <- iheatmap(mat) %>% add_row_plot(x = 1:4, tracename = "Strength")
#'
#' # Print heatmap if interactive session
#' if (interactive()) hm
setMethod(add_row_plot, c(p = "Iheatmap"),
function(p,
x,
...,
mode = c("lines+markers","lines","markers"),
color = NULL,
tracename = NA_character_,
showlegend = !is.na(tracename),
side = c("right","left"),
layout = list(),
size = 0.2,
buffer = 0.02,
xname = NULL,
yname = current_yaxis(p),
pname = if (!is.na(tracename)) tracename else "row_plot"){
side <- match.arg(side)
mode <- match.arg(mode)
additional_data <- modifyList(list(mode = mode), list(...))
if (is.null(color) && !isTRUE(showlegend)){
if (mode == "lines" || mode == "lines+markers"){
color_list <- list(line = list(color = "black"))
} else{
color_list <- list(marker = list(color = "black"))
}
additional_data <- modifyList(color_list, additional_data)
} else if (!is.null(color)){
if (mode == "lines" || mode == "lines+markers"){
color_list <- list(line = list(color = color))
} else{
color_list <- list(marker = list(color = color))
}
additional_data <- modifyList(color_list, additional_data)
}
new_x <- new_xaxis(p, yname, layout)
if (is.null(xname)) xname <- id(new_x)
new_plot <- new("RowPlot",
xaxis = xname,
yaxis = yname,
data = x,
showlegend = showlegend,
type = "scatter",
name = tracename,
additional = additional_data)
p <- add_axis(p,
new_x,
yname = yname,
xname = xname,
size = size,
buffer = buffer,
side = side)
p <- add_plot(p, new_plot, pname)
validObject(p)
p
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.