inst/scripts/shinyTest.R

In AnnotationHub: Client to access AnnotationHub resources

library(shiny)


#####################################################
## the original demo as a function:

# display2 <- 
# function(df, ...)
# {    
#     app <- list(
#                 ui = fluidPage(
#                     title = 'Row selection in DataTables',
#                     sidebarLayout(
#                         sidebarPanel(textOutput('rows_out')),
#                         mainPanel(dataTableOutput('tbl')),
#                         position = 'right'
#                     )
#                 )                
#                 ,
#                 server = function(input, output) {
#                     output$rows_out <- renderText({
#                         paste(c('You selected these rows on the page:', 
#                                 input$rows),
#                                     collapse = ' ')
#                     })                    
#                     output$tbl <- renderDataTable(
#                         df,
#                         options = list(pageLength = 10),
#                         callback = "function(table) {
#                         table.on('click.dt', 'tr', function() {
#                         $(this).toggleClass('selected');
#                         Shiny.onInputChange('rows',
#                         table.rows('.selected').indexes().toArray());
#                         }); }")
#                 }
#     )
# 
#     ## selectively use the RStudio viewer pane (if available)
#     viewer <- getOption("viewer")
#     if (!is.null(viewer)){
#         runApp(app, launch.browser = rstudio::viewer, ...)
#     }else{
#         runApp(app, ...)
#     }
# }


#####################################################
## my function that tries to just use indexes:
display2 <- 
    function(df, ...)
    {
        rowNames <- rownames(df)
        dt <- data.frame(rownames=rowNames,df)
        ## define the app
        app <- list(
            ui = fluidPage(
                title = 'The data from your data.frame',
                sidebarLayout(
                    sidebarPanel(textOutput('rows_out'),
                                 br(),
                                 actionButton("btnSend", "Send Rows")),
                    mainPanel(dataTableOutput('tbl')),
                    position = 'left'
                )
            )                
            ,
            server = function(input, output) {
                output$rows_out <- renderText({
                    paste(c('You selected these rows on the page:', 
                            input$rows),
                          collapse = ' ')
                })                    
                output$tbl <- renderDataTable(
                    dt,
                    options = list(pageLength = 20),
                    callback = "function(table) {
                    table.on('click.dt', 'tr', function() {
                    $(this).toggleClass('selected');
                    Shiny.onInputChange('rows',
                    table.rows('.selected').indexes().toArray());
                    }); }")
                observe({
                    if(input$btnSend > 0)
                        isolate({
                            #print(input$rows)
                            idx <- as.integer(input$rows) + 1
                            stopApp(returnValue = df[idx,])
                        })
                })                            
        })
        ## selectively use the RStudio viewer pane (if available)
        viewer <- getOption("viewer")
        if (!is.null(viewer)){
            runApp(app, launch.browser = rstudio::viewer, ...)
        }else{
            runApp(app, ...)
        }
}
## usage: 
## display2(mtcars)

## original:
## table.rows('.selected').indexes().toArray());

## This is kind of the same thing
##     table.rows( $('.selected').closest('tr') ).indexes().toArray());
## And this gets just the 1st one
##     table.rows( $('.selected').closest('tr')[0] ).indexes().toArray());






#####################################################
## my function that just get the row data (like before)
display2 <- 
    function(df, ...)
    {
        rowNames <- rownames(df)
        dt <- data.frame(rownames=rowNames,df)
        ## define the app
        app <- list(
            ui = fluidPage(
                title = 'The data from your data.frame',
                sidebarLayout(
                    sidebarPanel(textOutput('rows_out'),
                                 br(),
                                 actionButton("btnSend", "Send Rows")),
                    mainPanel(dataTableOutput('tbl')),
                    position = 'left'
                )
            )                
            ,
            server = function(input, output) {
                output$rows_out <- renderText({
                    paste(c('You selected these rows on the page:', 
                            input$rows),
                          collapse = ' ')
                })                    
                output$tbl <- renderDataTable(
                    dt,
                    options = list(pageLength = 50),
                    callback = "function(table) {
                    table.on('click.dt', 'tr', function() {
                    $(this).toggleClass('selected');
                    Shiny.onInputChange('rows',                    
            table.rows('.selected').indexes().toArray());
                    Shiny.onInputChange('tbl',                    
            table.rows('.selected').indexes().toArray());
                    }); }")
## TODO: change the above callback so that it returns rowRanges (not just indexes)
                observe({
                    if(input$btnSend > 0)
                        isolate({
                            #print(input$rows)
#                            idx <- as.integer(input$rows) + 1
#                           stopApp(returnValue = df[idx,])
                            
#                             dfVec <- input$myTable
#                             df <- as.data.frame(matrix(data=dfVec, ncol=dim(df)[2],
#                                                        byrow=TRUE))
#                             names(df) <- colNames
                             stopApp(returnValue = input$tbl)                            
                        })
    })                            
    })
    ## selectively use the RStudio viewer pane (if available)
    viewer <- getOption("viewer")
    if (!is.null(viewer)){
        runApp(app, launch.browser = rstudio::viewer, ...)
    }else{
        runApp(app, ...)
    }
    }
## usage: 
## display2(mtcars)