├── .gitignore ├── LICENSE ├── README.Rmd ├── README.md ├── examples ├── postgresql │ ├── config.R │ └── update_samples.R └── sqlite │ ├── config.R │ └── update_samples.R ├── global.R ├── images ├── line.gif └── scatter.gif ├── server.R ├── shiny-chart-builder.Rproj ├── tables └── .gitignore └── ui.R /.gitignore: -------------------------------------------------------------------------------- 1 | /config.R 2 | /update_samples.R 3 | /shiny_bookmarks/ 4 | .RData 5 | .Rhistory 6 | schema.rda 7 | README_files 8 | .Rproj.user 9 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2016 Pablo Seibelt 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | md_document: 4 | variant: markdown_github 5 | --- 6 | 7 | 8 | ```{r, echo = FALSE} 9 | knitr::opts_chunk$set( 10 | collapse = TRUE, 11 | comment = "#>", 12 | fig.path = "README-" 13 | ) 14 | ``` 15 | 16 | # Shiny chart builder 17 | 18 | v0.1 19 | 20 | This shiny app means to be a system for basic reporting in the style of most Business Intelligence tools, you can create a report, and then share it with the bookmark, without knowing any SQL or R. 21 | 22 | This package heavily relies on dplyr for database abstraction, it theoretically works with any dplyr-compatible database, but may require some tuning for some of the databases. 23 | 24 | ## The flow 25 | 26 | The way you should use this app is to build your chart with the `Sample mode`, and when you have the visualization you want, you untick the sample mode, which goes to the database to fetch the complete dataset you need. The app does some tricks with dplyr to avoid over-querying data. 27 | 28 | ![Scatterplot](images/scatter.gif) 29 | 30 | ![Linechart](images/line.gif) 31 | 32 | ## Configuration 33 | 34 | The app has to be configured by placing 2 files on the root of the project: config.R and update_samples.R. Example files using sqlite have been provided in the examples folder. 35 | 36 | Before using the shiny app, you have to execute the script "update_samples.R", which will download samples of all tables (Might take a while on big databases). If you only want to query a subset of your tables, modify this script so it only finds those tables. 37 | 38 | This script should be reran ocasionally, depending on how much your database changes, maybe daily, weekly or monthly, use your job scheduler or cron to do execute this script. 39 | 40 | Also, the stack overflows easily because of the level of recursion used, on the server or machine where you deploy this, you should allow for big stack sizes, i've tried and it worked fine with the unlimited setting in my experience. 41 | 42 | ``` 43 | ulimit -s unlimited 44 | ``` 45 | 46 | ## Missing features 47 | 48 | This is a very preliminar release, a lot of things may be missing, pull requests are welcome! 49 | 50 | Some examples of missing features: 51 | 52 | * Some advanced settings to control appearance 53 | * Bar charts 54 | * Histograms 55 | * Faceting? 56 | * More database examples 57 | * Bookmarking charts (It fails with the default bookmarker) -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | Shiny chart builder 3 | =================== 4 | 5 | v0.1 6 | 7 | This shiny app means to be a system for basic reporting in the style of most Business Intelligence tools, you can create a report, and then share it with the bookmark, without knowing any SQL or R. 8 | 9 | This package heavily relies on dplyr for database abstraction, it theoretically works with any dplyr-compatible database, but may require some tuning for some of the databases. 10 | 11 | The flow 12 | -------- 13 | 14 | The way you should use this app is to build your chart with the `Sample mode`, and when you have the visualization you want, you untick the sample mode, which goes to the database to fetch the complete dataset you need. The app does some tricks with dplyr to avoid over-querying data. 15 | 16 | ![Scatterplot](images/scatter.gif) 17 | 18 | ![Linechart](images/line.gif) 19 | 20 | Configuration 21 | ------------- 22 | 23 | The app has to be configured by placing 2 files on the root of the project: config.R and update\_samples.R. Example files using sqlite have been provided in the examples folder. 24 | 25 | Before using the shiny app, you have to execute the script "update\_samples.R", which will download samples of all tables (Might take a while on big databases). If you only want to query a subset of your tables, modify this script so it only finds those tables. 26 | 27 | This script should be reran ocasionally, depending on how much your database changes, maybe daily, weekly or monthly, use your job scheduler or cron to do execute this script. 28 | 29 | Also, the stack overflows easily because of the level of recursion used, on the server or machine where you deploy this, you should allow for big stack sizes, i've tried and it worked fine with the unlimited setting in my experience. 30 | 31 | ulimit -s unlimited 32 | 33 | Missing features 34 | ---------------- 35 | 36 | This is a very preliminar release, a lot of things may be missing, pull requests are welcome! 37 | 38 | Some examples of missing features: 39 | 40 | - Some advanced settings to control appearance 41 | - Bar charts 42 | - Histograms 43 | - Faceting? 44 | - More database examples 45 | - Bookmarking charts (It fails with the default bookmarker) 46 | -------------------------------------------------------------------------------- /examples/postgresql/config.R: -------------------------------------------------------------------------------- 1 | library(DBI) 2 | library(dplyr) 3 | library(shiny) 4 | 5 | #Dplyr database, replace this with a call to src_* with your database 6 | dplyr_DB = function(){ 7 | src_postgres() 8 | } 9 | 10 | #Function to execute arbitrary SQL 11 | queryDb = function(query){ 12 | db = dplyr_DB() 13 | dbGetQuery(db$obj, query) 14 | } 15 | 16 | #UI customizations 17 | UI_HEADER=HTML("") 18 | UI_THEME=NA 19 | UI_STYLE=HTML("") 20 | UI_TITLE="Chart builder" 21 | -------------------------------------------------------------------------------- /examples/postgresql/update_samples.R: -------------------------------------------------------------------------------- 1 | source('config.R') 2 | library(dplyr) 3 | 4 | allTables = queryDb(" 5 | SELECT DISTINCT tablename 6 | FROM pg_table_def 7 | WHERE schemaname = 'public' 8 | ORDER BY tablename 9 | ") 10 | 11 | 12 | allColumns = queryDb(" 13 | SELECT \"tablename\", \"column\", \"type\" 14 | FROM pg_table_def 15 | WHERE schemaname = 'public' 16 | ") 17 | 18 | allColumns$type = case_when( 19 | allColumns$type == 'integer' ~ 'integer', 20 | allColumns$type == 'bigint' ~ 'integer', 21 | startsWith(allColumns$type, 'numeric') ~ 'numeric', 22 | startsWith(allColumns$type, 'character') ~ 'character', 23 | allColumns$type == 'boolean' ~ 'boolean', 24 | allColumns$type == 'date' ~ 'date', 25 | startsWith(allColumns$type, "timestamp") ~ 'datetime', 26 | TRUE ~ 'character' 27 | ) 28 | 29 | save(allTables, allColumns, file="schema.rda") 30 | 31 | downloadSample = function(tab){ 32 | print(paste0("Downloading sample for table ", tab)) 33 | sample = queryDb(paste0('select * from ', tab, ' order by random() limit 5000')) 34 | saveRDS(sample, file=paste0('tables/', tab, '.rda')) 35 | } 36 | 37 | by(allTables, 1:nrow(allTables), function(row){ 38 | tab = row$tablename 39 | 40 | if(!file.exists(paste0('tables/', tab, '.rda'))){ 41 | r <- NULL 42 | attempt <- 1 43 | while( is.null(r) && attempt <= 3 ) { 44 | attempt <- attempt + 1 45 | r = tryCatch({ 46 | return(downloadSample(tab)) 47 | }, error = function(e){ 48 | print(paste("Error: ",err, ". Retrying...")) 49 | }) 50 | } 51 | } 52 | } 53 | ) 54 | 55 | #Delete old samples of non-existent tables 56 | delete = data.frame(tablename=gsub('.rda', '', list.files('tables/', pattern="*.rda"))) %>% anti_join(allTables, by='tablename') 57 | 58 | if(nrow(delete) > 0){ 59 | res = by(delete, 1:nrow(delete), function(row){ 60 | tab = row$tablename 61 | 62 | file.remove(paste0('tables/',tab,'.rda')) 63 | }) 64 | } 65 | -------------------------------------------------------------------------------- /examples/sqlite/config.R: -------------------------------------------------------------------------------- 1 | library(DBI) 2 | library(dplyr) 3 | library(shiny) 4 | 5 | #Dplyr database, replace this with a call to src_* with your database 6 | dplyr_DB = function(){ 7 | lahman_sqlite() 8 | } 9 | 10 | #Function to execute arbitrary SQL 11 | queryDb = function(query){ 12 | db = dplyr_DB() 13 | dbGetQuery(db$obj, query) 14 | } 15 | 16 | #UI customizations 17 | UI_HEADER =HTML("") 18 | UI_THEME=NA 19 | UI_STYLE=HTML("") 20 | UI_TITLE="Chart builder" 21 | -------------------------------------------------------------------------------- /examples/sqlite/update_samples.R: -------------------------------------------------------------------------------- 1 | # Make sure your working directory is that of the project, not "example". 2 | source('example/config.R') 3 | 4 | allTables = queryDb("SELECT name tablename FROM sqlite_master WHERE type='table'") 5 | 6 | 7 | getDef = function(table) 8 | { 9 | t=queryDb(paste0("pragma table_info(", table, ")")) 10 | t$type = case_when( 11 | t$type == "INTEGER" ~ "integer", 12 | t$type == "REAL" ~ "numeric", 13 | t$type == "BOOLEAN" ~ "boolean", 14 | t$type == "TEXT" ~ "character", 15 | TRUE ~ "character" 16 | ) 17 | t$tablename=table 18 | select(t, tablename, column=name, type) 19 | } 20 | 21 | allColumns = rowwise(allTables) %>% do(getDef(.)) 22 | 23 | #Save schema to disk 24 | save(allTables, allColumns, file="schema.rda") 25 | 26 | downloadSample = function(tab){ 27 | print(paste0("Downloading sample for table ", tab)) 28 | sample = queryDb(paste0('select * from ', tab, ' order by random() limit 5000')) 29 | saveRDS(sample, file=paste0('tables/', tab, '.rda')) 30 | TRUE 31 | } 32 | 33 | #Download 5k sample for all tables 34 | res = by(allTables, 1:nrow(allTables), function(row){ 35 | tab = row$tablename 36 | 37 | r <- NULL 38 | attempt <- 1 39 | while( is.null(r) && attempt <= 3 ) { 40 | attempt <- attempt + 1 41 | r = tryCatch({ 42 | return(downloadSample(tab)) 43 | }, error = function(e){ 44 | print(paste("Error: ",err, ". Retrying...")) 45 | }) 46 | } 47 | }) 48 | 49 | #Delete old samples of non-existent tables 50 | delete = data.frame(tablename=gsub('.rda', '', list.files('tables/', pattern="*.rda"))) %>% anti_join(allTables, by='tablename') 51 | 52 | if(nrow(delete) > 0){ 53 | res = by(delete, 1:nrow(delete), function(row){ 54 | tab = row$tablename 55 | 56 | file.remove(paste0('tables/',tab,'.rda')) 57 | }) 58 | } 59 | -------------------------------------------------------------------------------- /global.R: -------------------------------------------------------------------------------- 1 | enableBookmarking(store = "server") -------------------------------------------------------------------------------- /images/line.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sicarul/shiny-chart-builder/e5072ab8bfcff1a897e6aac448ce00de0b4d58aa/images/line.gif -------------------------------------------------------------------------------- /images/scatter.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sicarul/shiny-chart-builder/e5072ab8bfcff1a897e6aac448ce00de0b4d58aa/images/scatter.gif -------------------------------------------------------------------------------- /server.R: -------------------------------------------------------------------------------- 1 | library(ggplot2) 2 | library(lubridate) 3 | library(lazyeval) 4 | source('config.R') 5 | 6 | shinyServer(function(input, output, session) { 7 | 8 | ####################### 9 | # Table retrieval # 10 | ####################### 11 | 12 | getTableDef <- function(columns, tname){ 13 | filter(columns, tablename == tname) %>% 14 | select(column, type) 15 | } 16 | 17 | 18 | getColumnType <- function(columns, tname, col){ 19 | getTableDef(columns, tname) %>% 20 | filter(column == col) %>% select(type) %>% as.character() 21 | 22 | } 23 | 24 | getTableSample <- function(tname){ 25 | readRDS(paste0('tables/', tname, '.rda')) 26 | } 27 | 28 | getTableFull <- function(table, db){ 29 | tbl(db, table) 30 | } 31 | 32 | applyFilters = function(table){ 33 | columnsFilter = input$filterColumns 34 | 35 | for(col in columnsFilter) { 36 | type = getColumnType(allColumns, tableName(), col) 37 | ftype = input[[paste0("filterType", col,sep="_")]] 38 | 39 | if(length(ftype)>0){ 40 | if(ftype == 'If missing'){ 41 | table = filter_(table, paste0("is.na(",col,")")) 42 | }else{ 43 | if(type == 'character' | type == 'boolean'){ 44 | values = input[[paste0("filter", col,sep="_")]] 45 | values = ifelse(values == '<>', '', values) 46 | 47 | if(length(values) > 0){ 48 | if(length(values) == 1){ 49 | formula_string = paste0(col, " %in% (v)") 50 | }else{ 51 | formula_string = paste0(col, " %in% v") 52 | } 53 | 54 | if (ftype == "If true"){ 55 | table = filter_(table, interp(formula_string, v = values)) 56 | }else{ 57 | table = filter_(table, interp(paste0("!", formula_string), v = values)) 58 | } 59 | } 60 | }else if (type == 'numeric' | type == 'integer'){ 61 | values = input[[paste0("filter", col,sep="_")]] 62 | 63 | if (ftype == "If true"){ 64 | table = filter_(table, interp(paste0(col, " >= x & ", col, " <= y"), .values = list(x=values[1], y=values[2]))) 65 | }else{ 66 | table = filter_(table, interp(paste0(col, " < x & ", col, " > y"), .values = list(x=values[1], y=values[2]))) 67 | } 68 | }else if (type == 'date' | type == 'datetime'){ 69 | values = input[[paste0("filter", col,sep="_")]] 70 | 71 | minDay=as.Date(values[1]) 72 | maxDay=as.Date(values[2])+1 73 | 74 | if (ftype == "If true"){ 75 | table = filter_(table, paste0(col, " >= '", minDay, "' & ", col, " < '", maxDay, "'")) 76 | }else{ 77 | table = filter_(table, paste0(col, " < '", minDay, "' & ", col, " >= '", maxDay, "'")) 78 | } 79 | } 80 | } 81 | } 82 | 83 | 84 | table 85 | } 86 | 87 | table 88 | 89 | } 90 | 91 | # Load schema 92 | load('schema.rda') 93 | 94 | 95 | ####################### 96 | # Reactive tables # 97 | ####################### 98 | 99 | tableDef = reactive({ 100 | if(length(input$selectedTable) > 0){ 101 | if(!is.na(input$selectedTable)){ 102 | t = getTableDef(allColumns, input$selectedTable) 103 | f = function(x) {getColumnType(allColumns, input$selectedTable, x)} 104 | t$resolved_type = lapply(t$column, f) 105 | t 106 | } 107 | }else{ 108 | data.frame(column="A dataset", resolved_type='character') 109 | } 110 | }) 111 | 112 | sampleTable = reactive({ 113 | if(length(input$selectedTable) > 0){ 114 | if(!is.na(input$selectedTable)){ 115 | getTableSample(input$selectedTable) 116 | } 117 | }else{ 118 | data.frame(choose="A dataset") 119 | } 120 | }) 121 | 122 | tableName = reactive({ 123 | input$selectedTable 124 | }) 125 | 126 | output$tableDetail <- renderDataTable({ 127 | sampleTable() 128 | }) 129 | 130 | 131 | output$tableRender = renderUI({ 132 | selectInput('selectedTable', label='Table', choices=allTables$tablename) 133 | }) 134 | 135 | 136 | ####################### 137 | # Scatterplot # 138 | ####################### 139 | 140 | scatterResolve = reactive({ 141 | validate( 142 | need(input$scatterX != '' & input$scatterY != '' && input$scatterX != input$scatterY, "Please select two different X and Y to create the chart") 143 | ) 144 | 145 | if(input$scatterX != '' & input$scatterY != '' && input$scatterX != input$scatterY){ 146 | 147 | withProgress(message = 'Generating chart...', value = 0, { 148 | txt = "" 149 | 150 | xType = getColumnType(allColumns, tableName(), input$scatterX) 151 | yType = getColumnType(allColumns, tableName(), input$scatterY) 152 | cType = getColumnType(allColumns, tableName(), input$scatterC) 153 | 154 | if(input$sampleMode){ 155 | txt = paste0(txt, "--Remember you are in SAMPLE MODE (Random 5k sample from dataset)--") 156 | origData = getTableSample(input$selectedTable) 157 | }else{ 158 | dbcon <- dplyr_DB() 159 | origData = getTableFull(input$selectedTable, dbcon) 160 | } 161 | incProgress(0.1) 162 | origData = applyFilters(origData) 163 | 164 | incProgress(0.1) 165 | 166 | if(input$scatterC != ''){ 167 | data = mutate_(origData, .dots=setNames(c(input$scatterX, input$scatterY, input$scatterC), c("x", "y", "group"))) %>% 168 | select(x,y,group) %>% 169 | collect(n=Inf) 170 | 171 | if(cType != 'integer' & cType != 'numeric' & select(data, group) %>% distinct() %>% count() > 30){ 172 | txt = paste(txt, "Won't use color with more than 30 categories", sep="\n") 173 | data = select(data, -group) 174 | } 175 | 176 | }else{ 177 | data = select_(origData, .dots=setNames(c(input$scatterX, input$scatterY), c("x", "y"))) %>% collect(n=Inf) 178 | } 179 | 180 | if(!input$sampleMode){ 181 | rm(origData) 182 | } 183 | incProgress(0.4) 184 | 185 | if(xType == 'character'){ 186 | if(select(data, x) %>% distinct() %>% count() > 20){ 187 | txt = paste(txt, "* This may not be the best chart for the data, X is a categorical variable with too many possible values", sep='\n') 188 | } 189 | data$x = ifelse(is.na(data$x), 'NULL', data$x) 190 | }else if (xType == 'date'){ 191 | data$x = as.Date(data$x) 192 | }else if (xType == 'datetime'){ 193 | data$x = as.POSIXct(data$x) 194 | } 195 | 196 | # Check if Y is string 197 | if(yType == "character"){ 198 | data$y = ifelse(is.na(data$y), 'NULL', data$y) 199 | 200 | if(select(data, y) %>% distinct() %>% count() > 20){ 201 | txt = paste(txt, "This may not be the best chart for the data, Y is a categorical variable with too many possible values", sep="\n") 202 | } 203 | #Check if Y is date 204 | }else if (yType == 'date'){ 205 | txt = paste(txt, "It's recommended to use date variables in the X axis, instead of Y", sep="\n") 206 | data$y = as.Date(data$y) 207 | 208 | #Check if Y is datetime 209 | }else if (yType == 'datetime'){ 210 | txt = paste(txt, "It's recommended to use datetime variables in the X axis, instead of Y", sep="\n") 211 | data$y = as.POSIXct(data$y) 212 | } 213 | 214 | # Calculate different combinations 215 | cnt = select(data, x, y) %>% distinct() %>% count() 216 | incProgress(0.1) 217 | 218 | #Start generating plot 219 | g = ggplot(data, aes(x=x, y=y)) + 220 | labs(x=input$scatterX, y=input$scatterY) 221 | 222 | #Which aes to use 223 | if("group" %in% colnames(data)) 224 | { 225 | aesUse = aes(colour=group) 226 | g = g + labs(colour=input$scatterC) 227 | }else{ 228 | aesUse=NULL 229 | } 230 | 231 | # Jitter when there are not many possible combinations 232 | if(cnt < 100){ 233 | g = g + suppressWarnings(geom_jitter(aesUse, alpha=0.4)) 234 | }else{ 235 | g = g + suppressWarnings(geom_point(aesUse, alpha=0.4)) 236 | } 237 | 238 | # Log Scale X 239 | if((xType == 'integer' | xType == 'numeric') & input$scatterXlog){ 240 | g = g + scale_x_log10() 241 | } 242 | 243 | # Log Scale Y 244 | if((yType == 'integer' | yType == 'numeric') & input$scatterYlog){ 245 | g = g + scale_y_log10() 246 | } 247 | 248 | if((xType == 'integer' | xType == 'numeric') & (yType == 'integer' | yType == 'numeric')){ 249 | g = g + 250 | suppressWarnings(stat_ellipse(type = "norm", linetype = 2)) + 251 | suppressWarnings(stat_ellipse(type = "t")) 252 | } 253 | 254 | if (xType == 'date'){ 255 | g = g + scale_x_date() 256 | }else if (xType == 'datetime'){ 257 | g = g + scale_x_datetime() 258 | } 259 | 260 | if (yType == 'date'){ 261 | g = g + scale_y_date() 262 | }else if (yType == 'datetime'){ 263 | g = g + scale_y_datetime() 264 | } 265 | 266 | g = g + theme_bw() + theme( 267 | axis.text.x = element_text(angle = 45, hjust = 1), 268 | axis.text.y = element_text(angle = 45, hjust = 1), 269 | legend.position = "top" 270 | ) 271 | incProgress(0.3) 272 | 273 | list(chart=g, text=txt) 274 | 275 | }) 276 | }else{ 277 | list(chart=NULL, text=NULL) 278 | } 279 | }) 280 | 281 | output$scatterMessages = renderText({ 282 | s = scatterResolve() 283 | s$text 284 | }) 285 | 286 | output$scatterPlot = renderPlot({ 287 | s = scatterResolve() 288 | s$chart 289 | }) 290 | 291 | output$downloadScatter <- downloadHandler( 292 | filename = function() { 293 | paste('chart-', Sys.time(), '.png', sep='') 294 | }, 295 | content = function(file) { 296 | s = scatterResolve() 297 | ggsave(file = file, plot = s$chart, dpi = 128) 298 | } 299 | ) 300 | 301 | ####################### 302 | # Line chart # 303 | ####################### 304 | 305 | output$lineYSum = renderUI({ 306 | validate( 307 | need(input$lineY != '', '') 308 | ) 309 | col = input$lineY 310 | type = getColumnType(allColumns, tableName(), col) 311 | 312 | choices = list('Count'='count') 313 | 314 | if(type %in% c('integer', 'numeric')){ 315 | choices = list('Distribution'='dist', 'Count'='count', 'Sum values'='sum', 'Minimun value'='min', 'Maximun value'='max') 316 | }else if(type == 'boolean'){ 317 | choices = list('Sum values'='sum', 'Count'='count') 318 | } 319 | 320 | selected = 'count' 321 | if(length(input$lineSum) > 0){ 322 | if(input$lineSum %in% choices){ 323 | selected = input$lineSum 324 | } 325 | } 326 | 327 | selectInput('lineSum', label='Aggregation', choices=choices, selected=selected) 328 | }) 329 | 330 | output$lineXGranularity = renderUI({ 331 | validate( 332 | need(input$lineX != '', '') 333 | ) 334 | col = input$lineX 335 | type = getColumnType(allColumns, tableName(), col) 336 | 337 | choices = list() 338 | 339 | if(type == 'date'){ 340 | choices = list('Yearly'='year', 'Monthly'='month', 'Weekly'='week', 'Daily'='day') 341 | }else if(type == 'datetime'){ 342 | choices = list('Yearly'='year', 'Monthly'='month', 'Weekly'='week', 'Daily'='day', 'Hourly'='hour', 'Minutes'='minute', 'Seconds'='second') 343 | }else{ 344 | return(HTML("")) 345 | } 346 | 347 | selected = 'month' 348 | if(length(input$lineDateGranularity) > 0){ 349 | if(input$lineDateGranularity %in% choices){ 350 | selected = input$lineDateGranularity 351 | } 352 | } 353 | selectInput('lineDateGranularity', label='Date granularity', selected='month', 354 | choices=choices) 355 | }) 356 | 357 | 358 | lineResolve = reactive({ 359 | validate( 360 | need(input$lineX != '' & input$lineY != '' & input$lineX != input$lineY & input$lineY != input$lineGroup & input$lineSum != '', "Please select two different X and Y to create the chart") 361 | ) 362 | 363 | withProgress(message = 'Generating chart...', value = 0, { 364 | txt = "" 365 | 366 | xType = getColumnType(allColumns, tableName(), input$lineX) 367 | yType = getColumnType(allColumns, tableName(), input$lineY) 368 | 369 | if(input$sampleMode){ 370 | txt = paste0(txt, "--Remember you are in SAMPLE MODE (Random 5k sample from dataset)--") 371 | origData = getTableSample(input$selectedTable) 372 | }else{ 373 | dbcon <- dplyr_DB() 374 | origData = getTableFull(input$selectedTable, dbcon) 375 | } 376 | incProgress(0.1) 377 | origData = applyFilters(origData) 378 | 379 | incProgress(0.1) 380 | if(input$lineGroup != ''){ 381 | data = select_(origData, .dots=setNames(c(input$lineX, input$lineY, input$lineGroup), c("x", "y", 'g'))) 382 | }else{ 383 | data = select_(origData, .dots=setNames(c(input$lineX, input$lineY), c("x", "y"))) 384 | } 385 | 386 | ## Transform date 387 | if(xType %in% c('date', 'datetime')){ 388 | if ("tbl_postgres" %in% class(data)) { 389 | mutate_expression <- 390 | sprintf("x = DATE_TRUNC('%s', x)", 391 | input$lineDateGranularity 392 | ) 393 | 394 | mutate_command <- 395 | parse(text=sprintf("dplyr::mutate(data, %s)", 396 | mutate_expression 397 | ) 398 | ) 399 | data = eval(mutate_command) 400 | }else{ 401 | data = collect(data,n=Inf) # If not supported, bring data.frame 402 | data = mutate(data, x=floor_date(as.POSIXct(x), input$lineDateGranularity)) 403 | } 404 | } 405 | 406 | incProgress(0.2) 407 | 408 | if(input$lineGroup != ''){ 409 | data=group_by(data, x, g) 410 | }else{ 411 | data=group_by(data, x) 412 | } 413 | data = filter(data, !is.na(y)) 414 | 415 | 416 | if(input$lineSum=='count'){ 417 | if(yType == 'character'){ 418 | data = summarize(data, y=sum(ifelse(y != '', 1, 0))) 419 | }else{ 420 | data = tally(data) %>% dplyr::rename(y=n) 421 | } 422 | }else if(input$lineSum=='sum'){ 423 | if(yType == 'boolean'){ 424 | 425 | data = summarize(data, y=sum(ifelse(y == TRUE, 1, 0))) 426 | }else{ 427 | data = summarize(data, y=sum(y)) 428 | } 429 | 430 | }else if(input$lineSum=='min'){ 431 | data = summarize(data, y=min(y)) 432 | }else if(input$lineSum=='max'){ 433 | data = summarize(data, y=max(y)) 434 | }else if(input$lineSum=='dist'){ 435 | 436 | if ("tbl_postgres" %in% class(data)) { 437 | data = mutate(data, 438 | rnk__ = ntile(y, 100) 439 | ) %>% 440 | summarize( 441 | vl=max(ifelse(rnk__ <= 5, y, NA)), 442 | l=max(ifelse(rnk__ <= 25, y, NA)), 443 | h=min(ifelse(rnk__ >= 75, y, NA)), 444 | vh=min(ifelse(rnk__ >= 95, y, NA)), 445 | y=min(ifelse(rnk__ >= 50, y, NA)) 446 | ) 447 | }else{ 448 | data = collect(data,n=Inf) # If not supported, bring data.frame 449 | data = summarize(data, 450 | vl=quantile(y, probs=(0.05), na.rm=T), 451 | l=quantile(y, probs=(0.25), na.rm=T), 452 | h=quantile(y, probs=(0.75), na.rm=T), 453 | vh=quantile(y, probs=(0.95), na.rm=T), 454 | y=median(y, na.rm=T) 455 | ) 456 | } 457 | 458 | } 459 | 460 | incProgress(0.3) 461 | 462 | data = collect(data, n=Inf) %>% arrange(x) %>% filter(!is.na(x)) 463 | if(input$lineGroup == ''){ 464 | data$g = input$lineY 465 | } 466 | 467 | incProgress(0.25) 468 | 469 | if(xType %in% c('date', 'datetime')){ 470 | data$x = as.POSIXct(data$x, format='%Y-%m-%d %H:%M:%S') 471 | } 472 | 473 | #Start generating plot 474 | g = ggplot(data, aes(x=x, y=y, fill=g, colour=g), colour='blue', fill='grey') + 475 | labs(x=input$lineX, y=input$lineY, fill=input$lineGroup, colour=input$lineGroup) 476 | 477 | g = g + geom_line() 478 | if(input$lineSum=='dist'){ 479 | g = g + 480 | geom_ribbon(aes(ymin=l, ymax=h), alpha=0.2, colour=NA) + 481 | geom_ribbon(aes(ymin=vl, ymax=vh), alpha=0.2, colour=NA) 482 | } 483 | 484 | 485 | list(chart=g, text=txt) 486 | 487 | }) 488 | }) 489 | 490 | output$lineMessages = renderText({ 491 | l = lineResolve() 492 | l$text 493 | }) 494 | 495 | output$linePlot = renderPlot({ 496 | l = lineResolve() 497 | l$chart 498 | }) 499 | 500 | output$downloadLine <- downloadHandler( 501 | filename = function() { 502 | paste('chart-', Sys.time(), '.png', sep='') 503 | }, 504 | content = function(file) { 505 | l = lineResolve() 506 | ggsave(file = file, plot = l$chart, dpi = 128) 507 | } 508 | ) 509 | 510 | ####################### 511 | # Filters # 512 | ####################### 513 | 514 | 515 | output$filtersList = renderUI({ 516 | selectizeInput( 517 | 'filterColumns', 'Filter by', choices = tableDef()$column, 518 | multiple = TRUE 519 | ) 520 | }) 521 | 522 | output$filtersChoose = renderUI({ 523 | columnsFilter = input$filterColumns 524 | sample = sampleTable() 525 | 526 | generateFilter = function(col){ 527 | type = getColumnType(allColumns, tableName(), col) 528 | values = sample[,col] 529 | 530 | curSelected = isolate(input[[paste0("filter", col,sep="_")]]) 531 | 532 | el = NULL 533 | if(type == 'character'){ 534 | distinct = unique(values) 535 | distinct = ifelse(distinct == '', '<>', distinct) 536 | 537 | el = selectizeInput(paste0("filter", col,sep="_"), col, selected=curSelected, choices=distinct, multiple=T, options = list(create = T, allowEmptyOption=T)) 538 | }else if (type == 'boolean'){ 539 | el = selectInput(paste0("filter", col,sep="_"), col, choices=c("TRUE", "FALSE", '<>'), selected=curSelected) 540 | }else if (type == 'numeric' | type == 'integer'){ 541 | 542 | minim = min(c(0,values), na.rm=T) 543 | least = quantile(values, probs = 0.25, na.rm = T) 544 | great = quantile(values, probs = 0.75, na.rm = T) 545 | step = 0.01 546 | if(all.equal(values, as.integer(values)) == TRUE){ 547 | step = 1 548 | } 549 | 550 | if(length(curSelected)>0){ 551 | valSel = curSelected 552 | }else{ 553 | valSel = c(minim, great) 554 | } 555 | 556 | el = sliderInput(paste0("filter", col,sep="_"), col, value=valSel , min=minim, max=max(values,na.rm=T)+great/2, step=step) 557 | }else if (type == 'date' | type == 'datetime'){ 558 | 559 | if(length(curSelected)>0){ 560 | st = curSelected[1] 561 | en = curSelected[2] 562 | }else{ 563 | st = as.Date(max(values, na.rm=T))-30 564 | en = max(values, na.rm=T) 565 | } 566 | 567 | el = dateRangeInput(paste0("filter", col,sep="_"), 568 | label = col, 569 | start = st, end = en 570 | ) 571 | } 572 | 573 | fluidRow( 574 | column( 575 | width=9, 576 | el 577 | ), 578 | column( 579 | width=3, 580 | selectInput(paste0("filterType",col,sep="_"), '', choices=c('If true', 'If false', 'If missing'), selected="Include") 581 | ) 582 | ) 583 | } 584 | 585 | lapply(columnsFilter, generateFilter) 586 | }) 587 | 588 | 589 | 590 | ####################### 591 | # Render dynamic view # 592 | ####################### 593 | 594 | output$outView = renderUI({ 595 | switch(input$chart, 596 | 'sample'={ 597 | dataTableOutput('tableDetail') 598 | }, 599 | 'scatter'={ 600 | span( 601 | fluidRow( 602 | column(width=10, offset=1, 603 | wellPanel( 604 | tabsetPanel( 605 | tabPanel("Basic", 606 | fluidRow( 607 | column(width=4, 608 | selectInput('scatterX', label='X axis', choices=c('',tableDef()$column)) 609 | ), 610 | column(width=4, 611 | selectInput('scatterY', label='Y axis', choices=c('',tableDef()$column)) 612 | ), 613 | column(width=4, 614 | selectInput('scatterC', label='Color (Optional)', choices=c('',tableDef()$column)) 615 | ) 616 | ) 617 | ), 618 | tabPanel("Advanced", 619 | fluidRow( 620 | column(width=3, 621 | checkboxInput('scatterXlog', "Log scale on X") 622 | ), 623 | column(width=3, 624 | checkboxInput('scatterYlog', "Log scale on Y") 625 | ) 626 | ) 627 | ) 628 | ) 629 | ) 630 | ) 631 | ), 632 | fluidRow( 633 | column(width=10, offset=1, 634 | verbatimTextOutput('scatterMessages') 635 | ) 636 | ), 637 | fluidRow( 638 | column(width=10, offset=1, 639 | plotOutput('scatterPlot', 640 | height=500) 641 | ) 642 | ), 643 | fluidRow( 644 | column(width=10, offset=1, 645 | wellPanel( 646 | downloadButton('downloadScatter', 'Download this chart') 647 | ) 648 | ) 649 | ) 650 | ) 651 | }, 652 | 'line'={ 653 | lineColumns = filter(tableDef(), resolved_type %in% c('date', 'datetime', 'integer', 'numeric')) %>% select(column) 654 | charColumns = filter(tableDef(), resolved_type == 'character') %>% select(column) 655 | span( 656 | fluidRow( 657 | column(width=10, offset=1, 658 | wellPanel( 659 | tabsetPanel( 660 | tabPanel("Basic", 661 | fluidRow( 662 | column(width=3, 663 | selectInput('lineX', label='X axis', choices=c('',lineColumns$column)) 664 | ), 665 | column(width=3, 666 | uiOutput('lineXGranularity') 667 | 668 | ), 669 | column(width=3, 670 | selectInput('lineY', label='Y axis', choices=c('',tableDef()$column)) 671 | ), 672 | column(width=3, 673 | uiOutput('lineYSum') 674 | ) 675 | ), 676 | fluidRow( 677 | column(width=3, 678 | selectInput('lineGroup', label='Group by', choices=c('',charColumns$column)) 679 | ) 680 | ) 681 | ), 682 | tabPanel("Advanced", 683 | fluidRow( 684 | column(width=3, 685 | checkboxInput('lineYlog', "Log scale on Y") 686 | ) 687 | ) 688 | ) 689 | ) 690 | ) 691 | ) 692 | ), 693 | fluidRow( 694 | column(width=10, offset=1, 695 | verbatimTextOutput('lineMessages') 696 | ) 697 | ), 698 | fluidRow( 699 | column(width=10, offset=1, 700 | plotOutput('linePlot', 701 | height=500) 702 | ) 703 | ), 704 | fluidRow( 705 | column(width=10, offset=1, 706 | wellPanel( 707 | downloadButton('downloadLine', 'Download this chart') 708 | ) 709 | ) 710 | ) 711 | ) 712 | } 713 | ) 714 | }) 715 | 716 | output$tbl_name <- renderText({ tableName() }) 717 | 718 | 719 | }) 720 | -------------------------------------------------------------------------------- /shiny-chart-builder.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | -------------------------------------------------------------------------------- /tables/.gitignore: -------------------------------------------------------------------------------- 1 | *.rda -------------------------------------------------------------------------------- /ui.R: -------------------------------------------------------------------------------- 1 | source('config.R') 2 | 3 | 4 | shinyUI(fluidPage( 5 | 6 | title = UI_TITLE, 7 | UI_HEADER, 8 | theme=UI_THEME, 9 | UI_STYLE, 10 | titlePanel(UI_TITLE), 11 | 12 | fluidRow( 13 | column(width=5, 14 | wellPanel( 15 | checkboxInput("sampleMode", tags$b("Sample mode"), T), 16 | uiOutput('tableRender'), 17 | selectInput("chart", label="Chart type", selected="scatter", choices=list( 18 | "Scatter plot" = "scatter", 19 | "Line chart" = "line", 20 | #"Bar chart" = "bar", 21 | #"Histogram" = "histogram", 22 | "Sample data" = "sample" 23 | )) 24 | ) 25 | ), 26 | 27 | 28 | column(width=7, 29 | wellPanel( 30 | uiOutput('filtersList'), 31 | uiOutput('filtersChoose') 32 | ) 33 | ) 34 | ), 35 | fluidRow( 36 | columns=12, 37 | 38 | uiOutput('outView') 39 | ) 40 | )) --------------------------------------------------------------------------------