Evaluate the supplier/customers:

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 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.

Code
library(dataui) # remotes::install_github("timelyportfolio/dataui")
library(reactable)
library(sparkline)
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 statistics
      margin = list(right = 40),
      components = list(
        dui_sparklineseries(
          stroke = colpal[index],
          showArea = TRUE,
          fill = colpal[index]
        ),
        # statistics - display median for reference
        dui_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.

Code
(df3<-df %>%
  group_by(purchase_officers) %>% 
  summarise(sum = sum(money))  %>% 
  arrange(desc(sum)) %>% 
  slice(1:3))
# A tibble: 3 × 2
  purchase_officers       sum
  <chr>                 <dbl>
1 Virginia Woolf     6637741.
2 Czeslaw Milosz     6581341.
3 Fyodor Dostoyevsky 6477715.
Code
# 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 in 1:length(m$Group)){
  n<-df2 %>% 
    filter(purchase_officers == m$Group[[i]])
  m$Line[i] <-list(list(n$money))
}

for(i in 1: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
Code
# Finally plot table by {reactable}
library(reactablefmtr)
reactable(m, 
           theme = flatly(),
          columns = list(Line = Line, 
                         Bar = Bar))
Code
library(htmltools)
Warning: package 'htmltools' was built under R version 4.2.3
Code
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 jump
  showPageSizeOptions = 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" 
        
      else if (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

Code
library(ggiraph)
Warning: package 'ggiraph' was built under R version 4.2.3
Code
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
       )
Code
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()
`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