├── D3_fold_bar.gif ├── temp_flight2.rds ├── summary_report_word.Rmd ├── summary_report.Rmd ├── README.md ├── bar_plot.js └── app.R /D3_fold_bar.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jienagu/D3_folded_bar_Shiny/HEAD/D3_fold_bar.gif -------------------------------------------------------------------------------- /temp_flight2.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jienagu/D3_folded_bar_Shiny/HEAD/temp_flight2.rds -------------------------------------------------------------------------------- /summary_report_word.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Summary Report" 3 | author: "Airline: `r input$airlines`" 4 | date: "`r format(Sys.time(), '%d %B, %Y')`" 5 | output: word_document 6 | --- 7 | ```{r setup, include=FALSE} 8 | knitr::opts_chunk$set(echo = F) 9 | ``` 10 | 11 | 12 | 13 | ```{r Interval1, out.width = "510px"} 14 | saveWidget(bar_graphD3(), file= 'temp_Pivot_single.html') 15 | respivot = webshot::webshot('temp_Pivot_single.html','my-screenshot-Pivot_single.png', zoom = 1.2) 16 | knitr::include_graphics(respivot) 17 | ``` 18 | 19 | 20 | ```{r Interval2, warning = FALSE} 21 | note_in_md_word(input$markdowninput) 22 | ``` 23 | -------------------------------------------------------------------------------- /summary_report.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Summary Report" 3 | author: "Airline: `r input$airlines`" 4 | date: "`r format(Sys.time(), '%d %B, %Y')`" 5 | output: pdf_document 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | knitr::opts_chunk$set(echo = F) 10 | ``` 11 | 12 | 13 | 14 | ```{r Interval1, out.width = "510px"} 15 | saveWidget(bar_graphD3(), file= 'temp_Pivot_single.html') 16 | respivot = webshot::webshot('temp_Pivot_single.html','my-screenshot-Pivot_single.png', zoom = 1.2) 17 | knitr::include_graphics(respivot) 18 | ``` 19 | 20 | 21 | ```{r Interval2, warning = FALSE} 22 | note_in_md_pdf(input$markdowninput) 23 | ``` 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # D3_folded_bar_Shiny 2 | This is the first shiny app using D3.js library. Live demo: https://appforiarteam.shinyapps.io/D3_folded_bar/ 3 | 4 | * Simply click the bar in the chart or the dropdown tab to guide you to a monthly chart of clicked airflight. Then click "ALL" in the tab to reset. 5 | 6 | * You can write down the note or suggestions in the text box (support Markdown syntax), and your note will be print in a summary report (pdf or word)! 7 | 8 | * This app demonstrates the power of using `R2D3` package which can link your data (in R) to D3.js script. 9 | 10 | * The note box part used `noteMD` R package (`devtools::install_github("jienagu/noteMD")`). Repos: https://github.com/jienagu/noteMD 11 | 12 | ![D3_shiny](D3_fold_bar.gif) 13 | 14 | ## Acknowledgement 15 | 16 | Beef Cattle Institute at Kansas State University: https://ksubci.org/ 17 | Special thanks to Yihui Xie (from RStudio.LLC)! 18 | -------------------------------------------------------------------------------- /bar_plot.js: -------------------------------------------------------------------------------- 1 | // !preview r2d3 data= data.frame(label = c("Austin Bergstrom Intl", "Chicago Ohare Intl", "Dallas Fort Worth Intl", "Eagle Co Rgnl", "Fort Lauderdale Hollywood Intl", "General Edward Lawrence Logan Intl"), y = c(365, 1455, 7257, 103, 182, 274), x = c("GPT", "GPT", "GPT","GPT","GPT","GPT")) 2 | 3 | var layer_left = 0.35; 4 | layer_left_text = 0.01; 5 | layer_top = 0.1; 6 | layer_height = 0.85; 7 | layer_width = 0.55; 8 | 9 | var col_left_text = width * layer_left_text; 10 | 11 | function svg_height() {return parseInt(svg.style('height'))} 12 | function svg_width() {return parseInt(svg.style('width'))} 13 | 14 | function col_top() {return svg_height() * layer_top; } 15 | function col_left() {return svg_width() * layer_left;} 16 | 17 | function actual_max() {return d3.max(data, function (d) {return d.y; }); } 18 | function col_width() {return (svg_width() / actual_max()) * layer_width; } 19 | function col_heigth() {return svg_height() / data.length * layer_height; } 20 | 21 | var bars = svg.selectAll('rect').data(data); 22 | 23 | bars.enter().append('rect') 24 | .attr('width', function(d) { return d.y * col_width(); }) 25 | .attr('height',col_heigth() * 0.9) 26 | .attr('y', function(d, i) { return i * col_heigth() + col_top(); }) 27 | .attr('x', col_left()) 28 | .attr('fill', '#c4154f') 29 | .attr('opacity', function(d) { return d.y / (actual_max()*0.6 ); }) 30 | .attr('tip', function(d) { return (d.y * col_width()) + col_left(); }) 31 | .attr("d", function(d) { return d.x; }) 32 | .on("click", function(){ 33 | Shiny.setInputValue( 34 | "bar_clicked", 35 | d3.select(this).attr("d"), 36 | {priority: "event"} 37 | ); 38 | }) 39 | .on("mouseover", function(){ 40 | d3.select(this) 41 | .attr('fill', '#ffb14e'); 42 | }) 43 | .on("mouseout", function(){ 44 | d3.select(this) 45 | .attr('fill', '#c4154f'); 46 | }); 47 | 48 | bars.exit().remove(); 49 | 50 | bars.transition() 51 | .duration(500) 52 | .attr('width', function(d) { return d.y * col_width(); }) 53 | .attr('height',col_heigth() * 0.9) 54 | .attr('y', function(d, i) { return i * col_heigth() + col_top(); }) 55 | .attr('x', col_left()) 56 | .attr('opacity', function(d) { return d.y / (actual_max()*0.6 ); }) 57 | .attr('tip', function(d) { return (d.y * col_width()) + col_left(); }); 58 | 59 | // Identity labels 60 | 61 | var txt = svg.selectAll('text').data(data); 62 | 63 | txt.enter().append('text') 64 | .attr('x', col_left_text) 65 | .attr('y', function(d, i) { return i * col_heigth() + (col_heigth() / 2) + col_top(); }) 66 | .text(function(d) {return d.label; }) 67 | .style('font-size', '14px') 68 | .style('font-weight', 'bold') 69 | .style('font-family', 'sans-serif'); 70 | 71 | txt.exit().remove(); 72 | 73 | txt.transition() 74 | .duration(1000) 75 | .attr('x', col_left_text) 76 | .attr('y', function(d, i) { return i * col_heigth() + (col_heigth() / 2) + col_top(); }) 77 | .attr("d", function(d) { return d.x; }) 78 | .style('font-size', '14px') 79 | .style('font-weight', 'bold') 80 | .style('font-family', 'sans-serif') 81 | .text(function(d) {return d.label; }); 82 | 83 | // Numeric labels 84 | 85 | var totals = svg.selectAll().data(data); 86 | 87 | totals.enter().append('text') 88 | .attr('x', function(d) { return ((d.y * col_width()) + col_left()) * 1.01; }) 89 | .attr('y', function(d, i) { return i * col_heigth() + (col_heigth() / 2) + col_top(); }) 90 | .style('font-size', '14px') 91 | .style('font-weight', 'bold') 92 | .style('font-family', 'sans-serif') 93 | .text(function(d) {return d.y; }); 94 | 95 | totals.exit().remove(); 96 | 97 | totals.transition() 98 | .duration(1000) 99 | .attr('x', function(d) { return ((d.y * col_width()) + col_left()) * 1.01; }) 100 | .attr('y', function(d, i) { return i * col_heigth() + (col_heigth() / 2) + col_top(); }) 101 | .attr("d", function(d) { return d.x; }) 102 | .text(function(d) {return d.y; }); 103 | 104 | // Title 105 | 106 | // svg.append('text') 107 | // .attr('x', svg_width() * 0.01) 108 | // .attr('y', svg_height() * 0.05) 109 | // .style('font-size', '18px') 110 | // .style('font-family', 'sans-serif') 111 | // .text('Top 10 Destination Airports'); 112 | 113 | // Sub-title 114 | 115 | svg.append('text') 116 | .attr('x', svg_width() * 0.99) 117 | .attr('y', svg_height() * 0.05) 118 | .attr('text-anchor', 'end') 119 | .style('font-size', '16px') 120 | .style('font-family', 'sans-serif') 121 | .text('Click bar to zoom into monthly; click "ALL" on tab to reset!'); 122 | -------------------------------------------------------------------------------- /app.R: -------------------------------------------------------------------------------- 1 | # 2 | # This is a Shiny web application. You can run the application by clicking 3 | # the 'Run App' button above. 4 | # 5 | # Find out more about building applications with Shiny here: 6 | # 7 | # http://shiny.rstudio.com/ 8 | # 9 | 10 | library(shiny) 11 | library(dplyr) 12 | library(purrr) 13 | library(rlang) 14 | library(stringr) 15 | # devtools::install_github("jienagu/noteMD") 16 | library(noteMD) 17 | library(DT) 18 | library(r2d3) 19 | library(webshot) 20 | library(htmlwidgets) 21 | webshot::install_phantomjs() 22 | 23 | temp_flight2=readRDS("temp_flight2.rds") 24 | 25 | # Define UI for application that draws a histogram 26 | ui <- fluidPage( 27 | 28 | # Application title 29 | titlePanel("D3 Interactive Bar Chart"), 30 | 31 | # Sidebar with a slider input for number of bins 32 | sidebarLayout( 33 | sidebarPanel( 34 | selectInput( 35 | inputId = "airlines", 36 | label = "Airlines:", 37 | choices = c("ALL", unique(temp_flight2$name)), 38 | size = 10,selectize = FALSE, 39 | selected = "ALL" 40 | ), 41 | # actionButton("remove", "Remove data table(s)!"),br(),br(),br(), 42 | downloadButton('describe_download',"Download Report",class="butt" ),br(), 43 | tags$head(tags$style(".butt{background-color:#230682;} .butt{color: #e6ebef;}")), 44 | radioButtons('format', 'Document format', c('PDF', 'Word'), 45 | inline = TRUE) 46 | ), 47 | 48 | # Show a plot of the generated distribution 49 | mainPanel( 50 | tabsetPanel( 51 | id = "tabs", 52 | tabPanel( 53 | title = "Analytics Dashboard", 54 | value = "page1", 55 | fluidRow( 56 | column( 57 | width = 8, 58 | d3Output("airbar") 59 | ) 60 | ), 61 | fluidRow( 62 | column(12, 63 | helpText("Note: Any comments made in the box will be printed if you download the summary report.") ), 64 | column(12, 65 | tags$textarea( 66 | "Please using any **markdown** syntax!", 67 | id = 'markdowninput', 68 | rows = 3, 69 | style = 'width:100%;')) ), 70 | helpText("Preview:"), 71 | htmlOutput('htmlmarkdown'),br(),br() 72 | ) 73 | ) 74 | ) 75 | ) 76 | ) 77 | 78 | # Define server logic required to draw a histogram 79 | server <- function(input, output, session) { 80 | 81 | output$htmlmarkdown = reactive({ 82 | note_in_html(input$markdowninput) 83 | }) 84 | 85 | tab_list <- NULL 86 | 87 | sel_flights <- reactive({ 88 | 89 | if (input$airlines != "ALL") temp_flight2 <- filter(temp_flight2, name == input$airlines) 90 | temp_flight2 91 | 92 | }) 93 | 94 | bar_graphD3=reactive({ 95 | grouped <- ifelse(input$airlines != "ALL", expr(monthly), expr(name)) 96 | 97 | flightdata <- sel_flights() %>% 98 | group_by(!!grouped) %>% 99 | tally() %>% 100 | collect() %>% 101 | mutate( 102 | y = n, 103 | x = !!grouped 104 | ) %>% 105 | select(x, y) 106 | 107 | flightdata <- flightdata %>% 108 | mutate(label = x) 109 | 110 | r2d3(flightdata, "bar_plot.js") 111 | }) 112 | 113 | 114 | output$airbar = renderD3({ 115 | bar_graphD3() 116 | }) 117 | 118 | # airline/month bar click (server) --------------------------------- 119 | observeEvent(input$bar_clicked != "", { 120 | if (input$airlines == "ALL") { 121 | updateSelectInput(session, "airlines", selected = input$bar_clicked) 122 | } 123 | }, ignoreInit = TRUE ) 124 | 125 | 126 | output$describe_download = downloadHandler( 127 | filename<- function(){ 128 | paste("Summary",Sys.Date(),switch( 129 | input$format, PDF = '.pdf', Word = '.docx' 130 | ),sep = "") 131 | }, 132 | 133 | content = function(file) { 134 | if (input$format=="PDF"){ 135 | #### Progressing indicator 136 | withProgress(message = 'Download in progress', 137 | detail = 'This may take a while...', value = 0, { 138 | for (i in 1:15) { 139 | incProgress(1/15) 140 | Sys.sleep(0.01) 141 | } 142 | 143 | ## End of progression 144 | src <- normalizePath('summary_report.Rmd') 145 | 146 | # temporarily switch to the temp dir, in case you do not have write 147 | # permission to the current working directory 148 | owd <- setwd(tempdir()) 149 | on.exit(setwd(owd)) 150 | file.copy(src, 'summary_report.Rmd', overwrite = TRUE) 151 | 152 | library(rmarkdown) 153 | out <- render('summary_report.Rmd', pdf_document()) 154 | file.rename(out, file) 155 | 156 | }) 157 | ### below is the end of pdf content 158 | }else{ 159 | withProgress(message = 'Download in progress', 160 | detail = 'This may take a while...', value = 0, { 161 | for (i in 1:15) { 162 | incProgress(1/15) 163 | Sys.sleep(0.01) 164 | } 165 | 166 | ## End of progression 167 | src <- normalizePath('summary_report_word.Rmd') 168 | 169 | # temporarily switch to the temp dir, in case you do not have write 170 | # permission to the current working directory 171 | owd <- setwd(tempdir()) 172 | on.exit(setwd(owd)) 173 | file.copy(src, 'summary_report_word.Rmd', overwrite = TRUE) 174 | 175 | library(rmarkdown) 176 | out <- render('summary_report_word.Rmd', word_document()) 177 | file.rename(out, file) 178 | }) 179 | } 180 | 181 | }) 182 | 183 | } 184 | 185 | # Run the application 186 | shinyApp(ui = ui, server = server) 187 | 188 | --------------------------------------------------------------------------------