Commit 3b36c29c authored by Andreas Tille's avatar Andreas Tille

New upstream version 1.12.0

parent dd44f98b
Package: interactiveDisplayBase
Type: Package
Title: Base package for enabling powerful shiny web displays of
Bioconductor objects
Version: 1.12.0
Date: 2014-09-09
Author: Shawn Balcome, Marc Carlson
Maintainer: Shawn Balcome <balc0022@umn.edu>
Imports: shiny
Depends: R (>= 2.10), methods, BiocGenerics
Suggests: knitr
Enhances: rstudioapi
Description: The interactiveDisplayBase package contains the the basic
methods needed to generate interactive Shiny based display
methods for Bioconductor objects.
License: Artistic-2.0
Collate: interactiveDisplayBase.R dataframe.R dot_runApp.R zzz.R
VignetteBuilder: knitr
biocViews: GO, GeneExpression, Microarray, Sequencing, Classification,
Network, QualityControl, Visualization, Visualization,
Genetics, DataRepresentation, GUI, AnnotationData
NeedsCompilation: no
Packaged: 2016-10-17 23:34:20 UTC; biocbuild
import(methods)
import(BiocGenerics)
import(shiny)
export(.runApp)
export(display)
exportMethods(display)
##########################################################################3
## experimental new(er) version of .dataFrame
## helper for rowname wrangling:
.rownamesAreUnique <- function(df){
length(rownames(df)) == length(unique(rownames(df)))
}
.dataFrame3 <-
function(df, ..., summaryMessage = "",
serverOptions = list(orderClasses=TRUE))
{
rowNames <- rownames(df)
## If the rownames are unique then just use the names as idx.
## but if not, then also also append supplementary idx
if(.rownamesAreUnique(df)){
dt <- data.frame(idx=rowNames,df)
}else{
dt <- data.frame(idx=1:dim(df)[1],rownames=rowNames,df)
}
## define the app
app <- list(
ui = fluidPage(
tags$head(tags$style(HTML("tfoot {display: table-header-group;}"))),
title = 'The data from your data.frame',
fluidRow(textOutput('rows_out'),
br(),
actionButton("btnSend", "Return rows to R session")),
hr(),
mainPanel(dataTableOutput('tbl'))
),
server = function(input, output) {
output$rows_out <- renderText({
paste(c('Selected rows:',
input$rows),
collapse = ' ')
})
output$tbl <- renderDataTable(
dt,
options = list(pageLength = 20),
callback = "function(table) {
table.on('click.dt', 'tr', function() {
$(this).toggleClass('selected');
var rownames = $.map(table.rows('.selected').data(),
function(x) { return(x[0]) });
Shiny.onInputChange('rows', rownames);
}); }",
serverOptions)
if (length(summaryMessage)!=1){
output$summary <- renderUI({
HTML(paste0(
'<span class="shiny-html-output" >',summaryMessage[1],'</span> ',
'<br>',
'<span class="shiny-html-output" >',summaryMessage[2],'</span> ',
'<br>',
'<span class="shiny-html-output" >',summaryMessage[3],'</span> ',
'<br>',
'<span class="shiny-html-output" >',summaryMessage[4],'</span> ' ,
'<br>',
'<span class="shiny-html-output" >',summaryMessage[5],'</span> ' ,
'<br>',
'<span class="shiny-html-output" >',summaryMessage[6],'</span> ' ,
'<br>'
))
})
}
observe({
if(input$btnSend > 0)
isolate({
# print(input$rows)
idx <- input$rows
# message("the input size is: ", length(input$rows))
# message("the input class is: ", class(input$rows))
stopApp(returnValue = df[idx,])
})
})
})
.runApp(app, ...)
}
setMethod("display", signature(object = c("data.frame")),
function(object, ...)
{
.dataFrame3(df=object, ...)
})
##################################################################
## Older code follows
.selDataTableOutput <-
function(outputId, ... )
{
origStyle<- c(
'<script src="shared/datatables/js/jquery.dataTables.min.js"></script>',
'<script class="shiny-html-output"
src= "/js-interactiveDisplayBase/DTbinding.js"></script>',
'<link rel = "stylesheet",
type = "text/css",
href = "shared/datatables/css/DT_bootstrap.css"></link>',
'<style type="text/css">
.rowsSelected td{
background-color: rgba(112,164,255,0.2)
!important}) </style>',
'<style type="text/css"> .selectable div table tbody tr{
cursor: hand; cursor: pointer;}</style>',
'<style type="text/css"> .selectable div table tbody tr td{
-webkit-touch-callout: none;
-webkit-user-select: none;
-khtml-user-select: none;
-moz-user-select: none;
-ms-user-select: none;
user-select: none;} </style>',
'<style type="text/css">
#myTable tfoot {display:table-header-group;}</style>')
tagList(
singleton(
tags$head(HTML(origStyle)
)
),
div(id = outputId, class = "shiny-datatable-output selectable")
)
}
.dataFrame <-
function(df, ..., summaryMessage = "", serverOptions = list(orderClasses=TRUE))
{
colNames <- colnames(df)
app <- list(ui=pageWithSidebar(
headerPanel("Data Tables binding"),
sidebarPanel(
tags$head(
tags$style(type='text/css', ".span4 { max-width: 330px; }")
),
conditionalPanel(
condition= "output.summary",
strong(uiOutput('summary'))
),
br(),
actionButton("btnSend", "Send Rows"),
em(p("Shift-Click to select multiple rows.")),
br(),
tags$button("Select All Rows", class="btn", id="select_all_rows"),
em(p("Click to select all rows on page")),
br(),
tags$button("Deselect All Rows", class="btn", id="deselect_all_rows"),
em(p("Click to deselect all rows on page"))
),
mainPanel(
.selDataTableOutput(outputId="myTable",...)
)
), server=function(input, output) {
output$myTable <-
renderDataTable({df},
options = serverOptions
)
if (length(summaryMessage)!=1){
output$summary <- renderUI({
HTML(paste0(
'<span class="shiny-html-output" >',summaryMessage[1],'</span> ',
'<br>',
'<span class="shiny-html-output" >',summaryMessage[2],'</span> ',
'<br>',
'<span class="shiny-html-output" >',summaryMessage[3],'</span> ',
'<br>',
'<span class="shiny-html-output" >',summaryMessage[4],'</span> ' ,
'<br>',
'<span class="shiny-html-output" >',summaryMessage[5],'</span> ' ,
'<br>',
'<span class="shiny-html-output" >',summaryMessage[6],'</span> ' ,
'<br>'
))
})
}
observe({
if(input$btnSend > 0)
isolate({
#print(input$myTable)
dfVec <- input$myTable
df <- as.data.frame(matrix(data=dfVec, ncol=dim(df)[2],
byrow=TRUE))
names(df) <- colNames
stopApp(returnValue = df)
})
})
})
# runApp(app, ...)
.runApp(app, ...)
}
#################################################
## testing:
## library(interactiveDisplayBase); df <- mtcars;
## foo <- interactiveDisplayBase:::.dataFrame(df)
## foo <- display(df)
## TODO: add support for trapping last usage (for cases where user
## accidently calls it without assignment like this : display(df)
.runApp <- function(app, ...) {
## selectively use the RStudio viewer pane (if available)
viewer <- getOption("viewer")
if (!is.null(viewer) && is.function(viewer)) {
runApp(app, launch.browser = viewer, ...)
} else {
runApp(app, ...)
}
}
################################################################################
### Main
################################################################################
## declare the display generic
setGeneric("display", function(object, ...)
standardGeneric("display")
)
setMethod("display",
signature(object = "ANY"),
function(object){
message("Wrong object")
})
setMethod("display",
signature(object = "missing"),
function(object){
message("Missing object")
})
################################################################################
### Helper Functions
################################################################################
.usePackage <- function(p) {
source("http://bioconductor.org/biocLite.R")
if (!is.element(p, installed.packages()[,1])){
stop(paste("The required package, '",p,"', is missing. Please install it by
typing biocLite('",p,"') in the console", sep=""))
}
require(p, character.only = TRUE)
}
## helper for JS library tags
.jstags <- function(){
list(
tags$script(src="/js/jquery.min.js"),
tags$script(src="/js/d3.v2.js"))
}
#tags$script(src="/js/jquery-svgpan.js"),
#tags$script(src="/js/jscolor/jscolor.js"))
#.shiny-output-error { visibility: hidden; }
#.shiny-output-error:before { visibility: hidden; }
.csstags <- function(){
shiny::tags$head(
shiny::tags$style(type='text/css', "
.span4 {
width: 370px;
position: absolute;
z-index: 50;
}
.span8 {
position: absolute;
left: 400px;
right: 30px;
width: auto;
height: auto;
}
")
)
}
## The loading gif/panel
.loading_gif <- function(){
list(
conditionalPanel(condition="$('html').hasClass('shiny-busy')",
div("Loading...", style = "color:blue")),
conditionalPanel(condition="!($('html').hasClass('shiny-busy'))", br())
)
}
#selDataTableOutput <- function (outputId){
# tagList(singleton(tags$head(tags$link(rel = "stylesheet",
# type = "text/css", href = "shared/datatables/css/DT_bootstrap.css"),
# tags$style(type="text/css", ".rowsSelected td{background-color: rgba(112,164,255,0.2) !important}"),
# tags$style(type="text/css", ".selectable div table tbody tr{cursor: hand; cursor: pointer;}"),
# tags$style(type="text/css",".selectable div table tbody tr td{
# -webkit-touch-callout: none;
# -webkit-user-select: none;
# -khtml-user-select: none;
# -moz-user-select: none;
# -ms-user-select: none;
# user-select: none;}"),
# tags$script(src = "shared/datatables/js/jquery.dataTables.min.js"),
# tags$script(src = "shared/datatables/js/DT_bootstrap.js"),
# tags$script(src = "/js/DTbinding.js"))),
# div(id = outputId, class = "shiny-datatable-output selectable"))
#}
################################################################################
### Additional Functions
################################################################################
#grid2jssvg <- function(gp){
#
# jscode <- "
# <script type='text/javascript'>
# $(document).ready(function() {
# $('svg').svgPan('viewport');
# });
# </script>
# "
# png(filename = "myplot.png", bg = "transparent",height=1000,width=1000)
# print(gp)
#
# mysvg <- gridSVG::grid.export()
# dev.off()
# mysvg2 <- saveXML(mysvg$svg[["g"]])
# mysvg3 <- sub("<g transform=","<g id='viewport' transform=",mysvg2)
# mysvg4 <- sub(">NA<","><",mysvg3)
# htmlxml <- HTML(paste("<svg xmlns='http://www.w3.org/2000/svg'
# xmlns:xlink='http://www.w3.org/1999/xlink' version='1.1' width='100%'
# height='100%'>",jscode,mysvg4,"</svg>",sep=""))
# htmlxml
#}
# This pair of functions can be used in cases where it is desirable to
# give the user a choice between rendering a plot as svg or to use the default
# Shiny plot function.
#svgcheckout <- function(contents,sflag){
# if(sflag==TRUE){
# uiOutput(contents)
# }
# else{
# plotOutput(contents)
# }
#}
.onLoad <- function(libname, pkgname)
{
suppressMessages({
addResourcePath("js-interactiveDisplayBase", system.file("www", "js", package="interactiveDisplayBase"))
addResourcePath("css-interactiveDisplayBase", system.file("www", "css", package="interactiveDisplayBase"))
})
}
\ No newline at end of file
r-bioc-interactivedisplaybase (1.12.0-1) unstable; urgency=medium
* New upstream version (bump versioned Build-Depends)
* Convert to dh-r
* Generic BioConductor homepage
-- Andreas Tille <tille@debian.org> Thu, 27 Oct 2016 14:08:26 +0200
r-bioc-interactivedisplaybase (1.10.2-1) unstable; urgency=low
* Initial release (closes: #824448)
-- Andreas Tille <tille@debian.org> Mon, 16 May 2016 08:47:01 +0200
Source: r-bioc-interactivedisplaybase
Maintainer: Debian Med Packaging Team <debian-med-packaging@lists.alioth.debian.org>
Uploaders: Andreas Tille <tille@debian.org>
Section: gnu-r
Priority: optional
Build-Depends: debhelper (>= 9),
dh-r,
r-base-dev,
r-bioc-biocgenerics,
r-cran-shiny
Standards-Version: 3.9.8
Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-bioc-interactivedisplaybase/trunk/
Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-bioc-interactivedisplaybase/trunk/
Homepage: https://bioconductor.org/packages/interactiveDisplayBase/
Package: r-bioc-interactivedisplaybase
Architecture: all
Depends: ${R:Depends},
${misc:Depends},
Recommends: ${R:Recommends}
Suggests: ${R:Suggests}
Description: base package for enabling powerful shiny web displays of Bioconductor objects
The interactiveDisplayBase package contains the basic methods
needed to generate interactive Shiny based display methods for
Bioconductor objects.
Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
Upstream-Name: interactiveDisplayBase
Upstream-Contact: Shawn Balcome <balc0022@umn.edu>
Source: https://bioconductor.org/packages/interactiveDisplayBase/
Files: *
Copyright: 2006-2016 Shawn Balcome, Marc Carlson
License: Artistic-2.0
Files: debian/*
Copyright: 2016 Andreas Tille <tille@debian.org>
License: Artistic-2.0
License: Artistic-2.0
The "Artistic License"
.
Preamble
.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that
you duplicate all of the original copyright notices and associated
disclaimers.
.
2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder. A
Package modified in such a way shall still be considered the Standard
Version.
.
3. You may otherwise modify your copy of this Package in any way,
provided that you insert a prominent notice in each changed file stating
how and when you changed that file, and provided that you do at least
ONE of the following:
.
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or
an equivalent medium, or placing the modifications on a major archive
site such as uunet.uu.net, or by allowing the Copyright Holder to include
your modifications in the Standard Version of the Package.
.
b) use the modified Package only within your corporation or organization.
.
c) rename any non-standard executables so the names do not conflict
with standard executables, which must also be provided, and provide
a separate manual page for each non-standard executable that clearly
documents how it differs from the Standard Version.
.
d) make other distribution arrangements with the Copyright Holder.
.
4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:
.
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where
to get the Standard Version.
.
b) accompany the distribution with the machine-readable source of
the Package with your modifications.
.
c) give non-standard executables non-standard names, and clearly
document the differences in manual pages (or equivalent), together
with instructions on where to get the Standard Version.
.
d) make other distribution arrangements with the Copyright Holder.
.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this Package.
You may not charge a fee for this Package itself. However, you may
distribute this Package in aggregate with other (possibly commercial)
programs as part of a larger (possibly commercial) software distribution
provided that you do not advertise this Package as a product of your
own. You may embed this Package's interpreter within an executable of
yours (by linking); this shall be construed as a mere form of
aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
.
6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall under
the copyright of this Package, but belong to whoever generated them, and
may be sold commercially, and may be aggregated with this Package. If
such scripts or library files are aggregated with this Package via the
so-called "undump" or "unexec" methods of producing a binary executable
image, then distribution of such an image shall neither be construed as
a distribution of this Package nor shall it fall under the restrictions
of Paragraphs 3 and 4, provided that you do not represent such an
executable image as a Standard Version of this Package.
.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#!/usr/bin/make -f
%:
dh $@ --buildsystem R
version=3
opts=downloadurlmangle=s?^(.*)\.\.?http:$1packages/release/bioc? \
http://www.bioconductor.org/packages/release/bioc/html/interactiveDisplayBase.html .*/interactiveDisplayBase_([\d\.]+)\.tar\.gz
\name{interactiveDisplayBase-NEWS}
\title{interactiveDisplayBase News}
\section{CHANGES IN VERSION 1.7}{
\subsection{NEW FEATURES}{
\itemize{
\item \code{.runApp} runs the app in RStudio's 'viewer' pane (if
the app is launched under RStudio), or in the browser.
}
}
\subsection{BUG FIXES}{
\itemize{
\item Applications would only start under some versions of
shiny, due to a reference to either 'rstudio' or 'rstudioapp'
search path element.
}
}
}
## ----setup, echo=FALSE--------------------------------------------------------
suppressWarnings(suppressPackageStartupMessages(library(knitr)))
options(width=80)
## ----wrap-hook, echo=FALSE----------------------------------------------------
hook_output = knit_hooks$get('output')
knit_hooks$set(output = function(x, options) {
# this hook is used only when the linewidth option is not NULL
if (!is.null(n <- options$linewidth)) {
x = knitr:::split_lines(x)
# any lines wider than n should be wrapped
if (any(nchar(x) > n)) x = strwrap(x, width = n)
x = paste(x, collapse = '\n')
}
hook_output(x, options)
})
## ----interactiveDisplayBase-load, echo=FALSE----------------------------------
suppressWarnings(suppressPackageStartupMessages(library(interactiveDisplayBase)))
## ----dataframe_demo, eval=FALSE-----------------------------------------------
# mtcars2 <- display(mtcars)
<!--
%\VignetteEngine{knitr::knitr}
%\VignetteIndexEntry{Using interactiveDisplayBase for Bioconductor object visualization and modification}
-->
```{r setup, echo=FALSE}
suppressWarnings(suppressPackageStartupMessages(library(knitr)))
options(width=80)
```
```{r wrap-hook, echo=FALSE}
hook_output = knit_hooks$get('output')
knit_hooks$set(output = function(x, options) {
# this hook is used only when the linewidth option is not NULL
if (!is.null(n <- options$linewidth)) {
x = knitr:::split_lines(x)
# any lines wider than n should be wrapped
if (any(nchar(x) > n)) x = strwrap(x, width = n)
x = paste(x, collapse = '\n')
}
hook_output(x, options)
})
```
```{r interactiveDisplayBase-load, echo=FALSE}
suppressWarnings(suppressPackageStartupMessages(library(interactiveDisplayBase)))
```
# interactiveDisplayBase
[interactiveDisplayBase](http://bioconductor.org/packages/2.13/bioc/html/interactiveDisplayBase.html)
`interactiveDisplayBase` uses the function `display()` to host a browser based
application on the fly using the Shiny package. Shiny UI elements are available based on the
object passed to `display()`. These allow the user to modify how the plot is
displayed, and for some objects, modify or subset the data and send it back to
the console.
## Methods
Many of the display method will have a button that allows you return
subset values back to the R session. To use these, couple the intial
call with an assignment operator like this:
```{r dataframe_demo, eval=FALSE}
mtcars2 <- display(mtcars)
```
Once you leave the diplay web gui, the results of the above
interaction will be captured inside of mtcars2.
## Acknowledgments
Shiny <br/>
Joe Cheng and Winston Chang <br/>
http://www.rstudio.com/shiny/ <br/>
Force Layout <br/>
Jeff Allen <br/>
https://github.com/trestletech/shiny-sandbox/tree/master/grn <br/>
gridSVG <br/>
Simon Potter <br/>
http://sjp.co.nz/projects/gridsvg/ <br/>
Zoom/Pan JavaScript libraries <br/>
John Krauss <br/>
https://github.com/talos/jquery-svgpan <br/>
Andrea Leofreddi <br/>
https://code.google.com/p/svgpan/ <br/>
JavaScript Color Chooser <br/>
Jan Odvarko <br/>
http://jscolor.com/ <br/>
Data-Driven Documents <br/>
Michael Bostock <br/>
http://d3js.org/ <br/>
Javascript for returning values from data.frames <br/>
Kirill Savin <br/>
Help with the display method for data.frames <br/>
Dan Tenenbaum <br/>
This diff is collapsed.
## tests to check paging.
library(interactiveDisplayBase)
display(iris)
display(mtcars)
library(AnnotationHub)
ah = AnnotationHub()
df = as.data.frame(mcols(ah))
## This can be set up so that it's all on one page.
## But: this makes things painfully slow and the
## moment you do a search the indexing is all
## screwed up anyways...
## Esentially here I have a problem where the call back is retrieving relative
## indices instead of the absolute ones that I need from it.
\ No newline at end of file
<style>
.node text {
pointer-events: none;
font: 10px sans-serif;
}
.link {
stroke: #999;
stroke-opacity: .6;
}