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) }) })