see : http://www.statmethods.net/advstats/index.html
ui.r
require(shiny) require("RSQLite") get_mydbnane_uistate <- function(id) { drv <- dbDriver("SQLite", max.con = 1) conn <- dbConnect(drv, dbname="uistate") rs <- dbSendQuery( conn, paste( "select value from R where id ='mydbname';" ) ) row <- fetch(rs, n=1); dbDisconnect(conn) return( gsub(" ", "", row$value ) ) } get_listtables <- function(mydbname) { drv <- dbDriver("SQLite", max.con = 1) conn <- dbConnect(drv, dbname=mydbname) d <- dbListTables(conn) dbDisconnect(conn) return( d ) } get_firsttablename <- function(mydbname) { drv <- dbDriver("SQLite", max.con = 1) conn <- dbConnect(drv, dbname=mydbname) d <- dbListTables(conn) dbDisconnect(conn) return( d[1] ) } # Define UI for dataset viewer application shinyUI(pageWithSidebar( # Application title headerPanel("Data Explorer"), # Sidebar with controls to provide a caption, select a dataset, and # specify the number of observations to view. Note that changes made # to the caption in the textInput control are updated in the output # area immediately as you type sidebarPanel( textInput("dbname", "Database:", "/tmp/rdataset"), selectInput("dataset", paste( "Dataset of ", get_mydbnane_uistate("mydbname"), ":" ), choices = get_listtables(get_mydbnane_uistate("mydbname")), selected = get_listtables(get_mydbnane_uistate("mydbname"))[1] ), numericInput("obs", "Number of rows to view:", 10), textInput("gattname", "Grouping Attribute:", "Sepal_Length") ), # Show the caption, a summary of the dataset and an HTML table with # the requested number of observations mainPanel( h3(textOutput("caption")), textOutput("t1caption"), tableOutput("gresult"), textOutput("t2caption"), tableOutput("view"), textOutput("t3caption"), verbatimTextOutput("summary") ) ))
server.r require(shiny) require(datasets) require("RSQLite") require("sqldf") inituistate <- function() { if ( inituistate_done != 1 ) { drv <- dbDriver("SQLite", max.con = 1) conn <- dbConnect(drv, dbname="uistate") inituistate_done <<- 1 rs <- dbSendQuery( conn, "create table R ( id text, value text );" ) rs <- dbSendQuery( conn, "insert into R values( 'mydbname', '' );" ) dbDisconnect(conn) } } storeuistate <- function(mydbname) { inituistate(); drv <- dbDriver("SQLite", max.con = 1) conn <- dbConnect(drv, dbname="uistate") rs <- dbSendQuery( conn, paste( "update R set value ='", mydbname, "'where id = 'mydbname';" ) ) dbDisconnect(conn) } readdb <- function(mydbname) { if ( mydbname != current_dbname ) { drv <- dbDriver("SQLite", max.con = 1) conn <- dbConnect(drv, dbname=mydbname) rs <- dbSendQuery( conn, "SELECT * FROM diamonds;" ) diamonds_dataset <<- fetch(rs, n = -1) rs <- dbSendQuery( conn, "SELECT * FROM economics;" ) economics_dataset <<- fetch(rs, n = -1) rs <- dbSendQuery( conn, "SELECT * FROM indometh;" ) indometh_dataset <<- fetch(rs, n = -1) rs <- dbSendQuery( conn, "SELECT * FROM iris;" ) iris_dataset <<- fetch(rs, n = -1) rs <- dbSendQuery( conn, "SELECT * FROM nhtemp;" ) nhtemp_dataset <<- fetch(rs, n = -1) rs <- dbSendQuery( conn, "SELECT * FROM seals;" ) seals_dataset <<- fetch(rs, n = -1) dbDisconnect(conn) storeuistate(mydbname) current_dbname <<- mydbname } } shinyServer(function(input, output) { datasetInput <- reactive(function() { switch(input$dataset, "diamonds" = diamonds_dataset, "economics" = economics_dataset, "indometh" = indometh_dataset, "iris" = iris_dataset, "nhtemp" = nhtemp_dataset, "seals" = seals_dataset) }) output$CLIST <- reactiveText( function() { c("diamonds", "economics", "indometh", "iris", "nhtemp", "seals", "hoge") }) output$caption <- reactiveText(function() { paste("Dataset Name:", input$dataset) }) output$t1caption <- reactiveText(function() { paste("table 1. grouping result of", input$dataset, ".", "select ", input$gattname, ", count(*) from dataset group by" , input$gattname, ";" ) }) output$gresult <- reactiveTable(function() { readdb(input$dbname) dataset <- datasetInput() sqldf( paste("select ", input$gattname, ", count(*) from dataset group by" , input$gattname, ";") ) }) output$t2caption <- reactiveText(function() { "table 2. dataset content" }) output$view <- reactiveTable(function() { head(datasetInput(), n = input$obs) }) output$t3caption <- reactiveText(function() { paste("table 3. summary of", input$dataset) }) output$summary <- reactivePrint(function() { readdb(input$dbname) dataset <- datasetInput() summary(dataset) }) })