Final Project

libraries

library(tidyverse)

## Warning: package 'tidyverse' was built under R version 4.3.3

## Warning: package 'ggplot2' was built under R version 4.3.3

## Warning: package 'tibble' was built under R version 4.3.3

## Warning: package 'tidyr' was built under R version 4.3.3

## Warning: package 'readr' was built under R version 4.3.3

## Warning: package 'purrr' was built under R version 4.3.3

## Warning: package 'forcats' was built under R version 4.3.3

## Warning: package 'lubridate' was built under R version 4.3.3

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.0     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(ggplot2)
#install.packages('cowplot')
library(cowplot)

## Warning: package 'cowplot' was built under R version 4.3.3

## 
## Attaching package: 'cowplot'
## 
## The following object is masked from 'package:lubridate':
## 
##     stamp

#install.packages('caret')
library(caret)

## Warning: package 'caret' was built under R version 4.3.3

## Loading required package: lattice
## 
## Attaching package: 'caret'
## 
## The following object is masked from 'package:purrr':
## 
##     lift

#install.packages("rpart.plot")
library(rpart.plot)

## Warning: package 'rpart.plot' was built under R version 4.3.3

## Loading required package: rpart

My boss said i can use our aggregated data, internal ID’s, first names, no identifying info. same with account and employer info.

who our union represents:

Cleaners, janitors, security guards, ushers, doormen, window cleaners

our most notable employers:

World Trade Center, Empire State Building, Madison Square Garden, Yankee stadium , Barclays Center, Metropolitan opera house, Port Authority, CUNY Graduate Center

jan 2023 to dec 2023

steward info, leader points, and purple points, turnout points (CRM-prod)

2023 stewards

SQL Query (CRMSQL): {eval=FALSE, sql connection=CRMSQL} SELECT P.v3personID as 'Member ID', D.divisionName AS 'Division', DI.divisionTypeName AS "Division Type", P.firstName, PSR.personalActivityPoints as 'Activity Points', PSR.totalLeadershipPoints as 'Leader Points', PSR.ADFcardPoints as 'ADF Points', PSR.membershipCardPoints as 'Member Card Points', PSR.turnoutPoints as 'Turnout Points', PSR.rewardType as 'Reward Type', PSR.suggestedRewardLevel as 'Reward', PSR.numofDaysSteward, PSR.numOfDaysOnBrigades, PSR.numOfDaysOnLOA, a.V3accountID as 'Account Id' from personsRoles PR LEFT JOIN persons P on P.v3personID = PR.v3personID LEFT JOIN accounts A on PR.v3accountID = A.v3accountID LEFT JOIN jobs J ON P.primaryJobID = J.jobID LEFT JOIN statuses S on S.statusID = J.statusID LEFT JOIN accounts AC on AC.accountID = J.accountID LEFT JOIN divisions D on AC.divisionID = D.divisionID LEFT JOIN divisionTypes DI ON AC.divisionTypeID = DI.divisionTypeID LEFT JOIN locations L on AC.locationID = L.locationID LEFT JOIN personsStewardRebates PSR on PSR.v3personID = P.v3personID WHERE PR.roleTypeID = 1 AND (PR.statusID = 1 OR PR.dateEnd > '01-01-2023') AND (A.dateStop > '01/01/2023' or A.dateStop is null) AND PSR.rebateYear = 2023 AND D.divisionName NOT LIKE '%615%' GROUP BY P.v3personID, D.divisionName, AC.fieldRepresentative, PSR.rewardType, P.firstName, P.lastName, PSR.personalActivityPoints, PSR.totalLeadershipPoints, PSR.ADFcardPoints, PSR.membershipCardPoints, PSR.turnoutPoints, PSR.rewardType, PSR.suggestedRewardLevel, PSR.numofDaysSteward, PSR.numOfDaysOnBrigades, PSR.numOfDaysOnLOA, L.locationName, a.V3accountID, DI.divisionTypeName, P.homePhone, P.cellPhone, P.email, S.statusName ORDER BY D.DivisionName, AC.fieldRepresentative

NY Commercial 2023 Steward Points, their attendance and attendance of people in their building

StewardPoints <- read.csv("https://raw.githubusercontent.com/GuillermoCharlesSchneider/DATA-607/main/Final%20Project/Purple%20Points%20by%20steward%20(with%20their%20account%20numbers).csv")

#subset just the stewards in the NY Commercial division (no LOA complaints)
StewardPoints <- StewardPoints[which(StewardPoints$Division == 'NY Commercial'),]

StewardPoints$Account.Id <- as.numeric(StewardPoints$Account.Id)

account info, complaints, complaint type? one hot encoding, claim types? (CRM-SQL)

SQL query (CRMprod): {eval=FALSE, sql connection=CRMprod} SELECT a.accountnumber, c.seiu32bj_claimtypename, count(c.seiu32bj_claimtypename) as 'Number of Complaints' FROM filteredseiu32bj_claim c LEFT JOIN filteredIncident i on i.incidentid = c.seiu32bj_complaint LEFT JOIN FilteredAccount a ON i.seiu32bj_account = a.accountid LEFT JOIN Filteredseiu32bj_steward s ON a.accountid = s.seiu32bj_stewardaccountlookup WHERE c.createdon >= '2023-01-01 00:00:00.000' AND c.createdon < '2024-01-01 00:00:00.000' AND a.seiu32bj_districtname = 'New York Metro' AND a.seiu32bj_division = 'NY Commercial' AND i.customeridname != 'Test Member' GROUP BY a.accountnumber, c.seiu32bj_claimtypename ORDER by a.accountnumber DESC

NY Commercial Total Complaints per account in 2023:

TotalComplaints <- read.csv("https://raw.githubusercontent.com/GuillermoCharlesSchneider/DATA-607/main/Final%20Project/Total%20Complaints%20Per%20Account.csv")

names(TotalComplaints)[1] <- "Account.Id"

#account id 
TotalComplaints$Account.Id <- as.numeric(TotalComplaints$Account.Id)

#remove complaints from EVENT, NULL, and NA job type workers
#TotalComplaints <- TotalComplaints[ -c(5,6,7) ]

NY Commercial Count of Complaint types per account in 2023:

ComplaintTypes <- read.csv("https://raw.githubusercontent.com/GuillermoCharlesSchneider/DATA-607/main/Final%20Project/Complaint%20Types%20Per%20account%20(convert%20to%20one%20hot).csv")

ComplaintTypes <- ComplaintTypes[which(ComplaintTypes$seiu32bj_claimtypename != 'Leave of Absence'),]

NY Commercial Count of Members per account in 2023: i filtered out the recent 2024 hires, and made sure to include members who left in 2024, but were on the roster in 2023, i think ultimately the number is very close to just pulling the current 2024 roster today, due to most places total job count staying relatively stable

SQL Query (CRMprod) {eval=FALSE, sql connection=} SELECT DISTINCT a.V3accountID as 'Account.Id', count(a.V3accountID) as 'Members' FROM [dbo].[jobs] j LEFT JOIN accounts a on j.accountID = a.accountID WHERE a.divisionID = 9 AND j.dateHired < '2024-01-01 00:00:00.000' AND (j.statusID = 1 or (j.dateTerminated > '2024-01-01 00:00:00.000')) AND (A.dateStop > '01/01/2023' or A.dateStop is null) GROUP by a.V3accountID ORDER by count(a.V3accountID) DESC

MemberCountPerAccount

MemberCountPerAccount <- read.csv("https://raw.githubusercontent.com/GuillermoCharlesSchneider/DATA-607/main/Final%20Project/MembersPerAccount.csv")

Cleaning:

#join in the total complaints for that account
MERGED <- StewardPoints %>% left_join(TotalComplaints)

## Joining with `by = join_by(Account.Id)`

MERGED <- MERGED %>% left_join(MemberCountPerAccount)

## Joining with `by = join_by(Account.Id)`

# NA's to 0
MERGED$FTComplaints[is.na(MERGED$FTComplaints)] <- 0
MERGED$PTComplaints[is.na(MERGED$PTComplaints)] <- 0
MERGED$TotalComplaints[is.na(MERGED$TotalComplaints)] <- 0
MERGED$FTAverageMembers[is.na(MERGED$FTAverageMembers)] <- 0
MERGED$PTAverageMembers[is.na(MERGED$PTAverageMembers)] <- 0
MERGED$FTMembers[is.na(MERGED$PTMembers)] <- 0
MERGED$PTMembers[is.na(MERGED$PTMembers)] <- 0
MERGED$TotalAverageMembers[is.na(MERGED$TotalAverageMembers)] <- 0
MERGED$TotalMembers[is.na(MERGED$TotalMembers)] <- 0

# removing the acccounts with 0 members. my guess is most of these are probably flipped accounts, another company took them over mid 2023, those members still exist but in a new account for a new employer, same steward
MERGED <- MERGED[which(MERGED$TotalMembers != 0),]

#keep just the year-long stewards
MERGED <- MERGED[which(MERGED$numofDaysSteward == 365),]

#removed the EVT workers. only 4 accounts, huge amounts of rotating temp workers, lots of complaints, no long relationship w/ their steward
#changed to removing the Event workers in the SQL query
#MERGED <- MERGED[which(MERGED$EVTMembers == 0),]

#add a new column of complaint rate, complaints / total members
#MERGED <- MERGED
MERGED$ComplaintRate <- MERGED$TotalComplaints / MERGED$TotalAverageMembers * 100

Total AVERAGE Member count variable: This is to account for turnover through the year. Take all the members who worked at location in 2023, Sum the Number of days worked by each employee, and divide by 365. This gives you a approximate “average roster size” for throughout all of 2023. Each member needs to be included, because each member has a opportunity to file a complaint while they work and are represented by the union, regardless of how short their work length was

OVERALL leadership points: Combining stewards by account. I added together the stewards for each account. bigger accounts often have multiple stewards.

GroupedStewards <- MERGED %>% group_by(Account.Id, FTComplaints,PTComplaints,TotalComplaints, FTAverageMembers, PTAverageMembers,TotalAverageMembers, FTMembers, PTMembers,TotalMembers,ComplaintRate) %>% summarise(totalActivityPoints = sum(Activity.Points),totalTurnoutPoints = sum(Turnout.Points) ,.groups = 'drop')
                                                                                                         
GroupedStewards

## # A tibble: 349 × 13
##    Account.Id FTComplaints PTComplaints TotalComplaints FTAverageMembers
##         <dbl>        <dbl>        <dbl>           <dbl>            <dbl>
##  1       9332            0            0               0             5.25
##  2       9362            0            0               0             3   
##  3      13482            1            0               1             1.19
##  4      13483            0            0               0             8.33
##  5      13502            0            0               0             2.16
##  6      13518            0            0               0             3   
##  7      13541            0            0               0             4.81
##  8      13803            5            0               5             9.17
##  9      13829            0            0               0             3   
## 10      14093            0            0               0             2   
## # ℹ 339 more rows
## # ℹ 8 more variables: PTAverageMembers <dbl>, TotalAverageMembers <dbl>,
## #   FTMembers <dbl>, PTMembers <dbl>, TotalMembers <dbl>, ComplaintRate <dbl>,
## #   totalActivityPoints <int>, totalTurnoutPoints <int>

Graphs:

There are 4 big accounts that are outside 100 members, but most of the accounts fall between this range i set up to easier visualize

ggplot(MERGED, aes(x=TotalAverageMembers, y=TotalComplaints)) + 
    geom_point(alpha=0.7)+
  xlim(0,100)+
  ylim(0,75)+
  geom_smooth(method=lm, color="lightblue", fill="#69b3a2", se=TRUE) 

## `geom_smooth()` using formula = 'y ~ x'

## Warning: Removed 9 rows containing non-finite outside the scale range
## (`stat_smooth()`).

## Warning: Removed 9 rows containing missing values or values outside the scale range
## (`geom_point()`).

ggplot(MERGED, aes(x=TotalAverageMembers, y=ComplaintRate)) + 
    geom_point(alpha=0.7)+
  ylim(0,200)+
  xlim(1,100)

## Warning: Removed 27 rows containing missing values or values outside the scale range
## (`geom_point()`).

  geom_smooth(method=lm , color="lightblue", fill="#69b3a2", se=TRUE) 

## geom_smooth: na.rm = FALSE, orientation = NA, se = TRUE
## stat_smooth: na.rm = FALSE, orientation = NA, se = TRUE, method = function (formula, data, subset, weights, na.action, method = "qr", model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE, contrasts = NULL, offset, ...) 
## {
##     ret.x <- x
##     ret.y <- y
##     cl <- match.call()
##     mf <- match.call(expand.dots = FALSE)
##     m <- match(c("formula", "data", "subset", "weights", "na.action", "offset"), names(mf), 0)
##     mf <- mf[c(1, m)]
##     mf$drop.unused.levels <- TRUE
##     mf[[1]] <- quote(stats::model.frame)
##     mf <- eval(mf, parent.frame())
##     if (method == "model.frame") 
##         return(mf)
##     else if (method != "qr") 
##         warning(gettextf("method = '%s' is not supported. Using 'qr'", method), domain = NA)
##     mt <- attr(mf, "terms")
##     y <- model.response(mf, "numeric")
##     w <- as.vector(model.weights(mf))
##     if (!is.null(w) && !is.numeric(w)) 
##         stop("'weights' must be a numeric vector")
##     offset <- model.offset(mf)
##     mlm <- is.matrix(y)
##     ny <- if (mlm) 
##         nrow(y)
##     else length(y)
##     if (!is.null(offset)) {
##         if (!mlm) 
##             offset <- as.vector(offset)
##         if (NROW(offset) != ny) 
##             stop(gettextf("number of offsets is %d, should equal %d (number of observations)", NROW(offset), ny), domain = NA)
##     }
##     if (is.empty.model(mt)) {
##         x <- NULL
##         z <- list(coefficients = if (mlm) matrix(NA, 0, ncol(y)) else numeric(), residuals = y, fitted.values = 0 * y, weights = w, rank = 0, df.residual = if (!is.null(w)) sum(w != 0) else ny)
##         if (!is.null(offset)) {
##             z$fitted.values <- offset
##             z$residuals <- y - offset
##         }
##     }
##     else {
##         x <- model.matrix(mt, mf, contrasts)
##         z <- if (is.null(w)) 
##             lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...)
##         else lm.wfit(x, y, w, offset = offset, singular.ok = singular.ok, ...)
##     }
##     class(z) <- c(if (mlm) "mlm", "lm")
##     z$na.action <- attr(mf, "na.action")
##     z$offset <- offset
##     z$contrasts <- attr(x, "contrasts")
##     z$xlevels <- .getXlevels(mt, mf)
##     z$call <- cl
##     z$terms <- mt
##     if (model) 
##         z$model <- mf
##     if (ret.x) 
##         z$x <- x
##     if (ret.y) 
##         z$y <- y
##     if (!qr) 
##         z$qr <- NULL
##     z
## }
## position_identity

CL1 <- ggplot(GroupedStewards, aes(x=totalActivityPoints, y=ComplaintRate, size = TotalAverageMembers)) + 
    geom_point(alpha=0.7) +
  ylim(0,200)

CL2 <- ggplot(GroupedStewards, aes(x=totalTurnoutPoints, y=ComplaintRate, size = TotalAverageMembers)) + 
    geom_point(alpha=0.7)+
  ylim(0,200)

plot_grid(CL1, CL2, labels = c('A', 'B'), label_size = 12)

## Warning: Removed 6 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Removed 6 rows containing missing values or values outside the scale range
## (`geom_point()`).

ggplot(MERGED, aes(x=Activity.Points, y=ComplaintRate, size =TotalAverageMembers)) + 
    geom_point(alpha=0.7)+
  ylim(0,200)+
  geom_smooth() 

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'

## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_smooth()`).

## Warning: The following aesthetics were dropped during statistical transformation: size.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
##   the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
##   variable into a factor?

## Warning: Removed 7 rows containing missing values or values outside the scale range
## (`geom_point()`).

ggplot(MERGED, aes(x=Turnout.Points, y=ComplaintRate, size=TotalAverageMembers)) + 
    geom_point(alpha=0.7)+
  ylim(0,200)+
  geom_smooth() 

## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'

## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_smooth()`).

## Warning: The following aesthetics were dropped during statistical transformation: size.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
##   the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
##   variable into a factor?

## Warning: Removed 7 rows containing missing values or values outside the scale range
## (`geom_point()`).

machine learning – decision tree

https://www.modernstatisticswithr.com/mlchapter.html#mlmethods

tc <- trainControl(method = "LOOCV")

m <- train(ComplaintRate ~ Activity.Points + Turnout.Points + FTAverageMembers + PTAverageMembers + TotalAverageMembers,
           data = MERGED,
           trControl = tc,
           method = "rpart",
           tuneGrid = expand.grid(cp = 0))

m2 <- train(ComplaintRate ~ totalActivityPoints + totalTurnoutPoints + FTAverageMembers + PTAverageMembers + TotalAverageMembers,
           data = GroupedStewards,
           trControl = tc,
           method = "rpart",
           tuneGrid = expand.grid(cp = 0))

m

## CART 
## 
## 427 samples
##   5 predictor
## 
## No pre-processing
## Resampling: Leave-One-Out Cross-Validation 
## Summary of sample sizes: 426, 426, 426, 426, 426, 426, ... 
## Resampling results:
## 
##   RMSE      Rsquared     MAE     
##   323.0354  0.001064295  64.94875
## 
## Tuning parameter 'cp' was held constant at a value of 0

prp(m$finalModel)

prp(m$finalModel,
    box.palette = "BuRd",
    shadow.col = "gray",
    nn = TRUE,
    type =3,
    extra = 1,
    cex = 0.5,
    compress=TRUE,
    fallen.leaves = TRUE)

Trying instead with grouped stewards

prp(m2$finalModel)

prp(m2$finalModel,
    box.palette = "BuRd",
    shadow.col = "gray",
    nn = TRUE,
    type =3,
    extra = 1,
    cex = 0.5,
    compress=TRUE,
    fallen.leaves = TRUE)

## ACTUAL vs PREDICTED

actualAndPredictedData = data.frame(Account.Id = MERGED$Account.Id, StewardName = MERGED$firstName, Steward.Id = MERGED$Member.ID, actualValue = MERGED$ComplaintRate, 
                                    predictedValue = predict(m,MERGED))

ggplot(actualAndPredictedData,aes(x = actualValue, y = predictedValue)) +
ylim(0,200)+
xlim(0,250)+
geom_point()

## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_point()`).

#write.csv(actualAndPredictedData, "actualAndPredictedData.csv")