inst/workforcePlanApp/app.R

## Shiny Workforce Planning Worksheet
## created by Dale Kube (dkube@uwalumni.com)
## part of the hR package available in CRAN

suppressMessages(library(shiny))
suppressMessages(library(rhandsontable))
suppressMessages(library(data.table))
suppressMessages(library(knitr))

# Initialize dummy global variables to pass CRAN tests
value=NULL
variable=NULL
Total=NULL

# Define initial date attributes
current = as.POSIXlt(Sys.Date())
first.month = current$mon+1
first.month = sprintf("%02d",first.month)
first.year = format(Sys.Date(),"%Y")
first.date = paste(first.year,first.month,"01",sep="-")
mns = seq(as.Date(first.date),by="month",length=12)
mns = format(mns,"%b-%Y")

shinyApp(

  # UI Client
  ui = fluidPage(
    
    # Boilerplate Code
    tags$meta(name="viewport",content="width=750"),
    tags$title("hR: Workforce Planning"),
    tags$script(src="https://kit.fontawesome.com/a43c80910b.js", crossorigin="anonymous"),
    tags$style(HTML(
      "
      .rhandsontable {overflow:visible;}
      body {min-height:1600px;margin:25px;}
      td {padding-right:15px;width:auto;white-space:nowrap !important;}
      .colHeader {white-space:nowrap !important;}
      .col-sm-3 {width:auto;}
      #Calculate {margin-bottom:10px;background-color:green;color:white;}
      .smallPad {padding:5px;}
      .metric {
        width:300px;
        height:auto;
        margin: 10px 0px 10px 0px;
        display:block;
        }
      .metricHeader {font-weight:bold; padding:3px;}
      .box {width:750px;border-top:thin lightgrey solid;padding:15px;margin:20px;}
      .boxTop {width:750px;padding:15px;margin:20px;}
      .textBox {width:725px;}
      .fa-seedling {font-size:50px;}
      .progress, .shiny-input-container {margin:0px;}
      
      "
    )),

    div(
      
      class="boxTop",
      
      # Header
      div(
        span(style="font-size:32px;margin-right:15px;","Workforce Planning Worksheet"),
        icon("seedling")
      ),
      
      # Description paragraph
      p(
      class="textBox",
      style="margin-top:10px;",
      
      "This simple, interactive workforce planning worksheet allows people managers and team leaders to execute basic
      workforce planning tasks that support recruitment, team strategy, and business forecasting. Users indicate the roles
      within their team, cost per role estimates, and monthly desired headcounts. This leads to pragmatic calculations
      which provide insight into hiring needs, expected turnover, and other factors that contribute to the successful
      management of a high-performing team."
      ),
      br(),
      
      fileInput("loadWorksheet",label="Load Existing Worksheet",accept=".rds",multiple=F)
      
    ),

    div(
      class="box",
      
      # Step 1: Define team roles
      h3("Step 1: Define Team Roles"),
      p(
      class="textBox",
      "Indicate the roles that exist in your team now and the roles that
      will exist in the next 12 months. This ensures that you are planning ahead
      for all roles in your team. For example, type 'Data Analyst'."
      ),
      uiOutput("TypeRolesUI")
    ),

    div(
      class="box",
    
      # Step 2: Specify Typical Cost Per Role
      h3("Step 2: Annual Cost Per Role"),
      p(
      class="textBox",
      "Specify the typical annual cost ($) per employee in each role. This info is used
      to estimate spending over time on labor. For example, an analyst might cost the business
      about $55,000 per year."
      ),
      br(),
      rHandsontableOutput("spendHot")
    ),
    
    div(
      class="box",
      
      # Step 3: Add Desired Headcounts
      h3("Step 3: Add Desired Headcounts"),
      p(
      class="textBox",
      "Type-in the desired headcounts, which should reflect the number of employees,
      or FTEs, in each role at the start of the month (i.e. I need three associates working
      in my team at the start of August in order to properly manage the portfolio).",
      strong("Don't forget to periodically save your worksheet!")
      ),
      br(),
      rHandsontableOutput("hot"),
      uiOutput("downloadButtonUI")
    ),
      
    div(
      class="box",
      
      # Step 4: Calculate Change Metrics
      h3("Step 4: Calculate Change Metrics"),
      p(
      class="textBox",
      "Finally, press the 'Calculate' button to calculate relevant change metrics
      which help to plan ahead for the next 12 months. Use this data to develop an effective
      talent stratey and communicate your plans to others. The calculations consider the
      cost estimates and headcounts in the previous steps."
      ),
      uiOutput("calculateUI"),
      
      div(
        
        uiOutput("NoChangeAlert"),
        uiOutput("hires"),
        uiOutput("turnover"),
        uiOutput("headChange"),
        uiOutput("totalSpending")
        
      )
      
    )

  ),

  # Server client
  server = function(input,output,session){

    # Define reactive variables and shinyFile objects
    x = reactiveValues(
      aggs=c("Total Headcount","Total Compensation"),
      totalSpend=0
    )

    # Reactive variable to render the spend handsontable
    getSpendTable = reactive({

      # Update Cost Estimate Role UI
      new.roles = x$roles[!(x$roles %in% x$spend$Role)]
      if(length(new.roles)>0){

        new.spend = data.frame(Role=new.roles,Cost=0,stringsAsFactors=F)
        x$spend = rbind(x$spend,new.spend)

      }

      # Account for removed roles
      x$spend = x$spend[x$spend$Role %in% x$roles,]

      renderer = paste("function (instance, td, row, col, prop, value, cellProperties) {
                       Handsontable.renderers.NumericRenderer.apply(this, arguments);
                       if (col==0) {td.style.background = '#F0F0F0';td.style.color = 'black';td.align='left';cellProperties.readOnly='true';}
                       else {td.align='center';}}")

      # Render the cost per role handsontable
      output$spendHot = renderRHandsontable({

        rhandsontable(x$spend,rowHeaders=NULL) %>% 
          hot_cols(renderer=renderer) %>% 
          hot_col("Cost",format="$0,000")

      })

    })

    # Reactive variable to render the headcount handsontable
    getTable = reactive({

      # Add headcount totals if there are multiple roles
      x$df = x$df[!(x$df$Role %in% x$aggs),]

      # Add headcount totals
      head.totals = sapply(x$df[-1],as.numeric)
      if(nrow(x$df)>1){
        head.totals = colSums(head.totals)
      }
      head.totals = c("Role"="Total Headcount",head.totals)

      # Add spending totals based on cost estimates and headcounts
      spend.totals = sapply(x$df[-1],as.numeric)
      spend.totals = crossprod(x$spend$Cost,spend.totals)
      spend.totals = round(spend.totals/12)

      # Save grand total for the annual spending
      x$totalSpend = sum(spend.totals)

      spend.totals = format(spend.totals,big.mark=",",format='f')
      spend.totals = as.data.frame(spend.totals)
      spend.totals = cbind("Role"="Total Compensation",spend.totals)
      colnames(spend.totals) = colnames(x$df)

      # Combine aggregates and recount table
      x$df = rbind(x$df,head.totals,spend.totals)
      x$n = nrow(x$df)
      row.names(x$df) = NULL

      # Decide which style to render the handsontable with
      m = x$n-2
      renderer = paste("function (instance, td, row, col, prop, value, cellProperties) {
                       Handsontable.renderers.NumericRenderer.apply(this, arguments);
                       if (col==0 & row<",m,") {td.style.background = '#F0F0F0';td.style.color = 'black';td.align='left';cellProperties.readOnly='true';}
                       else if (row>=",m,") {td.style.background = '#F0F0F0';td.style.color = 'black';td.align='right';td.style.fontWeight='bold';cellProperties.readOnly='true';}
                       else {td.align='center';}}
                       ")

      # Render the rhandsontable object
      output$hot = renderRHandsontable({rhandsontable(x$df,rowHeaders=NULL) %>% hot_cols(renderer=renderer)})

      })

    # Observe headcount table to see if Calculate button should be visible
    observe({

      # Present the Calculate button if records exist in the table
      if(!is.null(x$df)){

        if(nrow(x$df)>0){

          output$calculateUI = renderUI({

            actionButton(inputId="Calculate",label="Calculate",icon=icon("calculator"))

          })

          output$downloadButtonUI = renderUI({

            downloadButton('saveWorksheet','Save Worksheet',style="background-color:green;color:white;margin-top:10px;")

          })

        }else{

          output$calculateUI = renderUI({""})
          output$downloadButtonUI = renderUI({""})

        }

      }

    })

    # Load Existing Worksheet
    observeEvent(input$loadWorksheet,{

      # Load the worksheet file (".rds")
      load(file=as.character(input$loadWorksheet$datapath))

      # Remove old months
      DF = DF[c(1,which(colnames(DF) %in% mns))]

      # Update reactive variables
      x$df = DF
      x$selected = DF$Role[!(DF$Role %in% x$aggs)]
      x$n = nrow(x$df)
      x$roles = x$selected
      x$spend = SPEND

      # Update the role input
      updateSelectizeInput(
        session=session,
        inputId="TypeRoles",
        choices=x$selected,
        selected=x$selected
      )

      # Render the handsontable
      getSpendTable()
      getTable()

    })

    # Save the worksheet
    output$saveWorksheet = downloadHandler(

      filename = "workforce-plan.rds",
      content = function(file) {

        DF = hot_to_r(input$hot)
        SPEND = hot_to_r(input$spendHot)
        save(DF,SPEND,file=file)

        }

    )

    # Role Input UI
    observe({

      output$TypeRolesUI = renderUI({

        selectizeInput(
          inputId="TypeRoles",
          label="Type-In Roles",
          multiple=T,
          choices=x$selected,
          selected=x$selected,
          options=list(
            create=T,
            plugins=list('remove_button','drag_drop')
          )
        )

      })

    })

    # Account for role additions and removals
    observeEvent(input$TypeRoles,{

      x$roles = sort(input$TypeRoles)

      # Account for added roles
      x$roles_add = x$roles[!(x$roles %in% x$df$Role)]
      if(length(x$roles_add)>0){

        df.add = data.frame(Role=x$roles_add,stringsAsFactors=F)
        df.add[mns] = 0
        x$df = rbind(x$df,df.add)

      }

      # Account for removed roles
      x$df = x$df[x$df$Role %in% x$roles,]

      # Render the cost estimate handsontable
      getSpendTable()

      # Render the headcount handsontable
      getTable()

    })

    # Account for changes to the hot table
    observeEvent(input$hot,{

      x$df = hot_to_r(input$hot)
      getTable()

    })

    # Account for changes to the spend Hot table
    observeEvent(input$spendHot,{

      x$spend = hot_to_r(input$spendHot)
      getSpendTable()
      getTable()

    })

    # Calculate descriptive metrics when the 'Calculate' button is pressed
    observeEvent(input$Calculate,{

      m = hot_to_r(input$hot)
      cols = m$Role
      m = t(m[-1])
      colnames(m) = cols
      m = data.table(m,keep.rownames=T)
      m = m[,!(colnames(m) %in% x$aggs),with=F]
      h = m[c(1,nrow(m)),-1]
      cols = colnames(m)[-1]
      m[,(cols):=lapply(.SD,as.numeric),.SDcols=cols]
      
      NA_SUM = sum(m[, lapply(.SD, function(x) sum(is.na(x)))])
      if(NA_SUM>0){
        
        output$hires = renderUI({""})
        output$turnover = renderUI({""})
        output$headChange = renderUI({""})
        output$totalSpending = renderUI({""})
        output$NoChangeAlert = renderUI({
          
          div(style="color:red;","Error: NA or empty values exist in the headcount table.")
          
        })
        
      }else{
        
        m[,(cols):=lapply(.SD,function(z) z-c(NA,z[-.N])),.SDcols=cols]
        m = melt.data.table(m,na.rm=T,id.vars="rn")
        m = m[value!=0]
        
        if(nrow(m)>0){
          
          output$NoChangeAlert = renderUI({""})
          m[,valuePrint:=paste0("<strong>",value,"</strong>")]
          
          # expected hires
          hires = m[value>0]
          if(nrow(hires)>0){
            
            hires[,value:=NULL]
            
            output$hires = renderUI({
              
              div(
                class="metric",
                div(
                  class="metricHeader",
                  "Expected Hires Per Month:"
                ),
                div(
                  class="smallPad",
                  HTML(kable(hires,col.names=NULL,format="html",escape=F))
                )
              )
              
            })
            
          }else{
            
            output$hires = renderUI({""})
            
          }
          
          # expected turnover
          turnover = m[value<0]
          
          if(nrow(turnover)>0){
            
            turnover[,value:=NULL]
            
            output$turnover = renderUI({
              
              div(
                class="metric",
                div(
                  class="metricHeader",
                  "Expected Turnover Per Month:"
                ),
                div(
                  class="smallPad",
                  HTML(kable(turnover,col.names=NULL,format="html",escape=F))
                )
              )
              
            })
            
          }else{
            
            output$turnover = renderUI({""})
            
          }
          
          # Headcount change
          h = as.data.frame(t(h),stringsAsFactors=F)
          h$V1 = as.numeric(h$V1)
          h$V2 = as.numeric(h$V2)
          h$Change = h$V2-h$V1
          h$Percent = 100*(h$Change/h$V1)
          h$Role = row.names(h)
          h = h[h$Change!=0,]
          
          if(nrow(h)>0){
            
            h$Percent = sprintf("%1.1f%%",h$Percent)
            h$Sign = ifelse(h$Change>0,"+","")
            h$Percent = paste0("(",h$Sign,h$Percent,")")
            h = h[c("Role","Change","Percent")]
            h$Change = paste0("<strong>",h$Change,"</strong>")
            h$Percent = paste0("<strong>",h$Percent,"</strong>")
            
            output$headChange = renderUI({
              
              div(
                class="metric",
                div(
                  class="metricHeader",
                  "Expected 12-Month Headcount Change:"
                ),
                div(
                  class="smallPad",
                  HTML(kable(h,col.names=NULL,row.names=F,format="html",escape=F))
                )
                
              )
              
            })
            
          }else{
            
            output$headChange = renderUI({""})
            
          }
          
          # Total Compensation
          if(x$totalSpend>0){
            
            total = paste0("$",format(x$totalSpend,big.mark=","))
            
            output$totalSpending = renderUI({
              
              div(
                class="metric",
                div(
                  class="metricHeader",
                  "Expected Total Annual Compensation:"
                ),
                div(
                  class="smallPad",
                  HTML(paste0("<span style='font-weight:bold'>",total,"</span"))
                )
                
              )
              
            })
            
          }else{
            
            output$totalSpending = renderUI({""})
            
          }
          
        }else{
          
          output$hires = renderUI({""})
          output$turnover = renderUI({""})
          output$headChange = renderUI({""})
          output$totalSpending = renderUI({""})
          output$NoChangeAlert = renderUI({
            
            div(style="color:red;","There aren't any changes in headcounts. There is nothing to analyze.")
            
          })
          
        }
        
      }

    })

  }

)
dalekube/hR documentation built on Jan. 25, 2021, 2:41 a.m.