1+ # ' Prevalence plot
2+ # '
3+ # ' Prevalence plot of all or agglomerated features in a
4+ # ' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}}
5+ # ' object. The panel implements \code{\link[miaViz:plotAbundance]{plotPrevalence}}
6+ # ' to generate the plot.
7+ # '
8+ # ' @section Slot overview:
9+ # ' The following slots control the thresholds used in the visualization:
10+ # ' \itemize{
11+ # ' \item \code{detection} \code{Numeric scalar}. Detection threshold between 0
12+ # ' and 1 for absence/presence. (Defualt: \code{0})
13+ # '
14+ # ' \item \code{prevalence} \code{Numeric scalar}. Prevalence threshold between 0
15+ # ' and 1. The required prevalence is strictly greater by default. To
16+ # ' include the limit, set \code{include.lowest} to \code{TRUE}. (Default:
17+ # ' \code{0})
18+ # '
19+ # ' \item \code{assay.type} \code{Character scalar}. The name of the assay to
20+ # ' show. (Default: \code{"relabundance"})
21+ # '
22+ # ' \item \code{rank} \code{Character scalar}. The taxonomic rank to visualise.
23+ # ' (Default: \code{NULL})
24+ # '
25+ # ' \item \code{show.rank} \code{Logical scalar}. Should options for the
26+ # ' taxonomic rank appear. (Default: \code{FALSE})
27+ # '
28+ # ' \item \code{include.lowest} \code{Logical scalar}. Should features with
29+ # ' prevalence equal to \code{prevalence} be included. (Default: \code{FALSE})
30+ # ' }
31+ # '
32+ # ' In addition, this class inherits all slots from its parent class
33+ # ' \code{\link[iSEE:Panel-class]{Panel}}.
34+ # '
35+ # ' @return
36+ # ' The \code{PrevalencePlot(...)} constructor creates an instance of an
37+ # ' PrevalencePlot class, where any slot and its value can be passed to
38+ # ' \code{...} as a named argument.
39+ # '
40+ # ' @author Giulio Benedetti
41+ # ' @examples
42+ # ' # Import TreeSE
43+ # ' library(mia)
44+ # ' data("Tengeler2020", package = "mia")
45+ # ' tse <- Tengeler2020
46+ # '
47+ # ' tse <- transformAssay(tse,
48+ # ' assay.type = "counts",
49+ # ' method = "relabundance")
50+ # '
51+ # ' # Store panel into object
52+ # ' panel <- PrevalencePlot()
53+ # ' # View some adjustable parameters
54+ # ' head(slotNames(panel))
55+ # '
56+ # ' # Launch iSEE with custom initial panel
57+ # ' if (interactive()) {
58+ # ' iSEE(tse, initial = c(panel))
59+ # ' }
60+ # '
61+ # ' @docType methods
62+ # ' @name PrevalencePlot
63+ NULL
64+
65+ # ' @importFrom S4Vectors setValidity2
66+ setValidity2(" PrevalencePlot" function (x ) {
67+
68+ msg <- character (0 )
69+ msg <- .singleStringError(msg , x , fields = c(" assay.type" " rank"
70+ msg <- .validLogicalError(msg , x , fields = c(" include.lowest" " show.rank"
71+ msg <- .validNumberError(msg , x , " detection" lower = 0 , upper = 1 )
72+ msg <- .validNumberError(msg , x , " prevalence" lower = 0 , upper = 1 )
73+
74+ if ( length(msg ) ){
75+ return (msg )
76+ }
77+ TRUE
78+ })
79+
80+ # ' @importFrom methods callNextMethod
81+ setMethod ("initialize ", "PrevalencePlot", function(.Object, ...) {
82+ args <- list (... )
83+ args <- .emptyDefault(args , " detection" 0 )
84+ args <- .emptyDefault(args , " prevalence" 0 )
85+ args <- .emptyDefault(args , " include.lowest" FALSE )
86+ args <- .emptyDefault(args , " assay.type" " relabundance"
87+ args <- .emptyDefault(args , " rank" NA_character_ )
88+ args <- .emptyDefault(args , " show.rank" FALSE )
89+
90+ do.call(callNextMethod , c(list (.Object ), args ))
91+ })
92+
93+ # ' @export
94+ # ' @importFrom methods new
95+ PrevalencePlot <- function (... ) {
96+ new(" PrevalencePlot" ... )
97+ }
98+
99+ # ' @importFrom methods slot
100+ # ' @importFrom SummarizedExperiment assayNames
101+ # ' @importFrom mia taxonomyRanks
102+ setMethod (".defineDataInterface ", "PrevalencePlot", function(x, se, select_info) {
103+ panel_name <- .getEncodedName(x )
104+
105+ list (.selectInput.iSEE(x , field = " assay.type" label = " Assay type:"
106+ choices = assayNames(se ), selected = slot(x , " assay.type"
107+ .sliderInput.iSEE(x , field = " prevalence" label = " Prevalence threshold:"
108+ min = 0 , max = 1 , step = 0.01 , value = slot(x , " prevalence"
109+ .checkboxInput.iSEE(x , field = " include.lowest" label = " Include lowest"
110+ value = slot(x , " include.lowest"
111+ .sliderInput.iSEE(x , field = " detection" label = " Detection threshold:"
112+ min = 0 , max = 1 , step = 0.01 , value = slot(x , " detection"
113+ .checkboxInput.iSEE(x , field = " show.rank" label = " Show rank:"
114+ value = slot(x , " show.rank"
115+ .conditionalOnCheckSolo(paste0(panel_name , " _show.rank" TRUE ,
116+ .selectInput.iSEE(x , field = " rank" label = " Rank"
117+ choices = taxonomyRanks(se ), selected = slot(x , " rank"
118+ })
119+
120+ # ' @importFrom methods callNextMethod
121+ setMethod (".defineInterface ", "PrevalencePlot", function(x, se, select_info) {
122+ out <- callNextMethod()
123+ list (out [1 ], .create_visual_box_for_prev_plot(x , se ), out [- 1 ])
124+ })
125+
126+ setMethod (".createObservers ", "PrevalencePlot",
127+ function (x , se , input , session , pObjects , rObjects ) {
128+
129+ callNextMethod()
130+ panel_name <- .getEncodedName(x )
131+
132+ .createProtectedParameterObservers(panel_name , c(" assay.type" " prevalence"
133+ " detection" " include.lowest" " rank" input = input , pObjects = pObjects ,
134+ rObjects = rObjects )
135+
136+ .createUnprotectedParameterObservers(panel_name , c(" show.rank"
137+ input = input , pObjects = pObjects , rObjects = rObjects )
138+
139+ invisible (NULL )
140+ })
141+
142+ setMethod (".fullName ", "PrevalencePlot", function(x) "Prevalence plot")
143+ setMethod (".panelColor ", "PrevalencePlot", function(x) "grey")
144+
145+ # ' @importFrom shiny plotOutput
146+ # ' @importFrom shinyWidgets addSpinner
147+ setMethod (".defineOutput ", "PrevalencePlot", function(x) {
148+ panel_name <- .getEncodedName(x )
149+
150+ addSpinner(plotOutput(panel_name ,
151+ height = paste0(slot(x , " PanelHeight" " px" color = .panelColor(x ))
152+ })
153+
154+ # ' @importFrom miaViz plotPrevalence
155+ setMethod (".generateOutput ", "PrevalencePlot",
156+ function (x , se , all_memory , all_contents ) {
157+
158+ panel_env <- new.env()
159+ all_cmds <- list ()
160+ args <- character (0 )
161+
162+ all_cmds [[" select" <- .processMultiSelections(
163+ x , all_memory , all_contents , panel_env
164+ )
165+
166+ if ( exists(" row_selected" envir = panel_env , inherits = FALSE ) ){
167+ panel_env [[" se" <- se [ , unlist(panel_env [[" row_selected"
168+ } else {
169+ panel_env [[" se" <- se
170+ }
171+
172+ args [[" assay.type" <- deparse(slot(x , " assay.type"
173+ args [[" prevalence" <- deparse(seq(slot(x , " prevalence" 1 , by = 0.1 ))
174+ args [[" detection" <- deparse(seq(slot(x , " detection" 1 , by = 0.1 ))
175+ args [[" include.lowest" <- deparse(slot(x , " include.lowest"
176+
177+ if ( slot(x , " show.rank"
178+ args [[" rank" <- deparse(slot(x , " rank"
179+ }
180+
181+ args <- sprintf(" %s=%s" args ), args )
182+ args <- paste(args , collapse = " , "
183+ fun_call <- sprintf(" p <- miaViz::plotPrevalence(se, %s)" args )
184+
185+ fun_cmd <- paste(strwrap(fun_call , width = 80 , exdent = 4 ), collapse = " \n "
186+ plot_out <- .textEval(fun_cmd , panel_env )
187+ all_cmds [[" fun" <- fun_cmd
188+
189+ list (commands = all_cmds , plot = plot_out , varname = NULL , contents = NULL )
190+ })
191+
192+ # ' @importFrom shiny renderPlot
193+ # ' @importFrom methods callNextMethod
194+ setMethod (".renderOutput ", "PrevalencePlot",
195+ function (x , se , output , pObjects , rObjects ) {
196+
197+ panel_name <- .getEncodedName(x )
198+ force(se ) # defensive programming to avoid bugs due to delayed evaluation
199+
200+ output [[panel_name ]] <- renderPlot({
201+ .retrieveOutput(panel_name , se , pObjects , rObjects )
202+ })
203+
204+ callNextMethod()
205+ })
206+
207+ # ' @importFrom grDevices pdf dev.off
208+ setMethod (".exportOutput ", "PrevalencePlot",
209+ function (x , se , all_memory , all_contents ) {
210+
211+ contents <- .generateOutput(x , se , all_memory = all_memory ,
212+ all_contents = all_contents )
213+
214+ newpath <- paste0(.getEncodedName(x ), " .pdf"
215+
216+ pdf(newpath , width = slot(x , " PanelHeight" / 75 ,
217+ height = slot(x , " PanelWidth" * 2 )
218+
219+ print(contents $ plot )
220+ dev.off()
221+
222+ newpath
223+ })
224+
225+ # ' @importFrom methods callNextMethod
226+ setMethod (".hideInterface ", "PrevalencePlot", function(x, field) {
227+ if ( field %in% c(" SelectionHistory" " ColumnSelectionRestrict"
228+ " ColumnSelectionDynamicSource" " ColumnSelectionSource"
229+ TRUE
230+ } else {
231+ callNextMethod()
232+ }
233+ })
234+
235+ setMethod (".multiSelectionResponsive ", "PrevalencePlot",
236+ function (x , dim = character (0 )) {
237+
238+ if ( " row" %in% dim ){
239+ return (TRUE )
240+ }
241+ return (FALSE )
242+ })
243+
244+ # ' @importFrom methods callNextMethod
245+ setMethod (".definePanelTour ", "PrevalencePlot", function(x) {
246+ rbind(c(paste0(" #" x )), sprintf(
247+ " The <font color=\" %s\" >Prevalence Plot</font> panel
248+ contains a representation of the relative abundance
249+ for each taxonomic rank. Each column corresponds to
250+ a sample of the <code>SummarizedExperiment</code>
251+ object." , .getPanelColor(x ))),
252+ .addTourStep(x , " DataBoxOpen" " The <i>Data parameters</i> box shows the
253+ available parameters that can be tweaked to control the data on
254+ the plot.<br/><br/><strong>Action:</strong> click on this
255+ box to open up available options." ),
256+ .addTourStep(x , " Visual" " The <i>Visual parameters</i> box shows
257+ the available visual parameters that can be tweaked in this
258+ plot.<br/><br/><strong>Action:</strong> click on this box to
259+ open up available options." ),
260+ callNextMethod())
261+ })
262+
263+ # ' @importFrom methods slot
264+ # ' @importFrom mia taxonomyRanks
265+ # ' @importFrom SummarizedExperiment rowData
266+ .create_visual_box_for_prev_plot <- function (x , se ) {
267+ panel_name <- .getEncodedName(x )
268+
269+ # Define what parameters the user can adjust
270+ collapseBox(paste0(panel_name , " _Visual"
271+ title = " Visual parameters" open = FALSE )
272+ }
0 commit comments