But look again your output, the table is boring and the name of columns is abbreviated so it perhaps lead to viewer’s misunderstanding. In order to familier with reader, R have package {reactable} help us to implement beautiful interactive dashboard.
So before implementing, I will build a function to add reactivity in dashboard, which’s similar with us that is filter button. I get this code from Albert Rapp and I think you gonna love his education posts about technical field.
Code
# Function for filter button:filter_fct <-function(values, name) { tags$select( tags$option(value ="", "All"), purrr::map(unique(values), tags$option),onchange = glue::glue("Reactable.setFilter( 'my-tbl', '{name}', event.target.value // This is the value of the dropdown menu )" ) )}
Then I will custom the barchart and linechart in reactable by package dataui. You can read detail and tutorial from this link dataui.
Warning: package 'sparkline' was built under R version 4.2.3
Code
# Function for beautiful barchart:Bar =colDef(cell =function(value, index) {dui_sparkline(data =hist(value[[1]], breaks=bins, plot=FALSE)$density,height =80,component =dui_sparkbarseries() ) } )# Function for beautiful linechart:colpal <-topo.colors(5)Line <-colDef(cell =function(value, index) {dui_sparkline(data = value[[1]],height =80,# make some room for our statisticsmargin =list(right =40),components =list(dui_sparklineseries(stroke = colpal[index],showArea =TRUE,fill = colpal[index] ),# statistics - display median for referencedui_sparkhorizontalrefline(reference =median(value[[1]]),stroke = colpal[index],strokeDasharray ="4,4",renderLabel = htmlwidgets::JS("(d) => d.toFixed(2)"),labelPosition ="right" ),dui_tooltip(components =list(dui_sparkverticalrefline(strokeDasharray ="4,4",stroke =gray.colors(10)[3] ),dui_sparkpointseries(stroke = colpal[index],fill ="#fff",renderLabel = htmlwidgets::JS("(d) => d.toFixed(2)") ) )) ) ) })
So this is the business result from all purchase officers in the company. For the purpose of easy understanding, we just plot for top-3 purchasing departments. This is top 3 purchasing officers.
`summarise()` has grouped output by 'Month', 'receiving_department'. You can
override using the `.groups` argument.
Code
p2<-df4 %>%ggplot(aes(x = money, y = receiving_department, fill = receiving_department,data_id = id))+geom_boxplot_interactive(position =position_nudge(y =0.25),width =0.5)+labs(x ="The total revenue",y =element_blank(),title ="The KPI achieved by receiving_department")+theme_minimal()library(patchwork)girafe(ggobj = p1/p2 +plot_spacer() +plot_layout(widths =c(0.45, 0.1, 0.45)),options =list(opts_hover(css =''),opts_hover_inv(css ="opacity:0.1;"),opts_sizing(rescale =FALSE) ),height_svg =6,width_svg =10 )
Next we will move to the next section is about: Spatial analyst
Source Code
---title: "Report concepts"format: html: code-fold: true code-tools: true---## Evaluate the supplier/customers:```{r}#| include: falselibrary(readxl)procurement_data <-read_excel(r"(C:/Users/locca/Documents/Xuân Lộc/VILAS/Data_Chuong 7/procurement_data.xlsx)")## Call packages:pacman::p_load(rio, here, janitor, tidyverse, dplyr, magrittr, ggplot2, purrr, lubridate, knitr, shiny)## Copy into new object:df<-procurement_data ## Adjusting:df<-df %>%# standardize column name syntax janitor::clean_names() %>%distinct() df <- df %>%# break the datetime PO into date and time cols separatelymutate(po_date =as.Date(df$po_date_time),po_time =hms(format(df$po_date_time,"%H:%M:%S")))df$money<-runif(nrow(df),1000,10000)```## Reactable table:But look again your output, the table is boring and the name of columns is abbreviated so it perhaps lead to viewer's misunderstanding. In order to familier with reader, R have package `{reactable}` help us to implement beautiful interactive dashboard.So before implementing, I will build a function to add reactivity in dashboard, which's similar with us that is filter button. I get this code from [Albert Rapp](https://albert-rapp.de/posts/18_connecting_reactable_ojs/18_connecting_reactable_ojs) and I think you gonna love his education posts about technical field.```{r}#| warning: false#| message: false# Function for filter button:filter_fct <-function(values, name) { tags$select( tags$option(value ="", "All"), purrr::map(unique(values), tags$option),onchange = glue::glue("Reactable.setFilter( 'my-tbl', '{name}', event.target.value // This is the value of the dropdown menu )" ) )}```Then I will custom the barchart and linechart in `reactable` by package `dataui`. You can read detail and tutorial from this link [dataui](https://timelyportfolio.github.io/dataui/articles/dataui_reactable.html). ```{r}library(dataui) # remotes::install_github("timelyportfolio/dataui")library(reactable)library(sparkline)# Function for beautiful barchart:Bar =colDef(cell =function(value, index) {dui_sparkline(data =hist(value[[1]], breaks=bins, plot=FALSE)$density,height =80,component =dui_sparkbarseries() ) } )# Function for beautiful linechart:colpal <-topo.colors(5)Line <-colDef(cell =function(value, index) {dui_sparkline(data = value[[1]],height =80,# make some room for our statisticsmargin =list(right =40),components =list(dui_sparklineseries(stroke = colpal[index],showArea =TRUE,fill = colpal[index] ),# statistics - display median for referencedui_sparkhorizontalrefline(reference =median(value[[1]]),stroke = colpal[index],strokeDasharray ="4,4",renderLabel = htmlwidgets::JS("(d) => d.toFixed(2)"),labelPosition ="right" ),dui_tooltip(components =list(dui_sparkverticalrefline(strokeDasharray ="4,4",stroke =gray.colors(10)[3] ),dui_sparkpointseries(stroke = colpal[index],fill ="#fff",renderLabel = htmlwidgets::JS("(d) => d.toFixed(2)") ) )) ) ) })```So this is the business result from all purchase officers in the company. For the purpose of easy understanding, we just plot for top-3 purchasing departments. This is top 3 purchasing officers.```{r}(df3<-df %>%group_by(purchase_officers) %>%summarise(sum =sum(money)) %>%arrange(desc(sum)) %>%slice(1:3))``````{r}#| warning: false#| message: false# Prepare data for plot:m<-data.frame(Group =unique(df3$purchase_officers),Line =NA,Bar =NA)df2<-df %>%mutate(month =as.Date(paste(month(po_date),"01",year(po_date),sep ="/"),format ="%m/%d/%Y")) %>%group_by(month,purchase_officers) %>%summarise(money =sum(money),po_amount =sum(po_amount))for(i in1:length(m$Group)){ n<-df2 %>%filter(purchase_officers == m$Group[[i]]) m$Line[i] <-list(list(n$money))}for(i in1:length(m$Group)){ n<-df2 %>%filter(purchase_officers == m$Group[[i]]) m$Bar[i] <-list(list(n$po_amount))}bins <-hist(unlist(m$Bar), breaks =10, plot =FALSE)$breaks``````{r}#| warning: false#| message: false# Finally plot table by {reactable}library(reactablefmtr)reactable(m, theme =flatly(),columns =list(Line = Line, Bar = Bar))``````{r}library(htmltools)df3<-df %>%select(c(purchase_officers, po_amount, money, tran_status)) %>%mutate(p = po_amount/money)reactable( df3,groupBy =c("purchase_officers","tran_status"),filterable =TRUE, minRows =5,searchable =TRUE,compact =TRUE,paginationType ="jump", #"jump" to show a page jumpshowPageSizeOptions =TRUE, theme =reactableTheme(borderColor ="#dfe2e5",stripedColor ="#f6f8fa",highlightColor ="#f0f5f9",cellPadding ="8px 12px",style =list(fontFamily ="-apple-system, BlinkMacSystemFont, Segoe UI, Helvetica, Arial, sans-serif" )),columns =list(purchase_officers =colDef(name ="Purchase Officer",filterInput = filter_fct),tran_status =colDef(name ="Status of transaction",aggregate ="sum", cell =function(value) {if (value =="Fully Billed") "\u2714\ufe0f Yes"elseif (value =="Pending Bill"|value =="Pending Receipt"|value =="Closed") browsable(div(shiny::icon('warning', class ='fas', style ='color: orange'),"Warning")) else"\u274c No"}),po_amount =colDef(name ="Number of PO",aggregate ="sum",format =colFormat(separators =TRUE)),money =colDef(name ="Total amount",aggregate ="sum",format =colFormat(currency ="USD")),p =colDef(name ="Percentage",aggregate ="mean") ))```Finally, we will create a plot for ```{r}library(ggiraph)p1<-df %>%mutate(tooltip_label = glue::glue('The total quantity PO is {po_amount}<br> with value is {round(money,2)}')) %>%ggplot(aes(x = po_amount,y = money,col = tran_status)) +geom_point_interactive(size =4,aes(tooltip = tooltip_label)) +theme_minimal()girafe(ggobj = p1,options =list(opts_hover(css =''),opts_hover_inv(css ="opacity:0.1;"),opts_sizing(rescale =FALSE) ),height_svg =6,width_svg =8 )``````{r,warning=F}library(lubridate)library(ggiraph)df4<-df %>%mutate(receiving_department =as.factor(receiving_department),id =levels(receiving_department)[as.numeric(receiving_department)],receiving_department = forcats::fct_reorder(receiving_department, po_amount))p1<-df4 %>%mutate(Month =as.Date(paste(month(po_date),"01",year(po_date),sep ="/"),format ="%m/%d/%Y")) %>%group_by(Month,receiving_department,id) %>%summarise(mean =mean(money)) %>%ggplot(aes(y = mean, x = Month,col = receiving_department,data_id = id))+geom_line_interactive(linewidth =2.5) +geom_point_interactive(size =4) +labs(x ="Month",y ="The total revenue",title ="The line chart of revenue monthly" )+theme(text =element_text(color ='grey20' ),legend.position ='none',panel.grid.minor =element_blank(),plot.title.position ='plot' ) +theme_minimal()p2<-df4 %>%ggplot(aes(x = money, y = receiving_department, fill = receiving_department,data_id = id))+geom_boxplot_interactive(position =position_nudge(y =0.25),width =0.5)+labs(x ="The total revenue",y =element_blank(),title ="The KPI achieved by receiving_department")+theme_minimal()library(patchwork)girafe(ggobj = p1/p2 +plot_spacer() +plot_layout(widths =c(0.45, 0.1, 0.45)),options =list(opts_hover(css =''),opts_hover_inv(css ="opacity:0.1;"),opts_sizing(rescale =FALSE) ),height_svg =6,width_svg =10 )```Next we will move to the next section is about: [Spatial analyst](spatial.qmd)