Lab 11: Decision Trees I: Detecting Fraudulent Transactions EDA
Learning Objectives
- exploratory data analysis (EDA)
- exploring data depends on context (domain knowledge)
- creating features (predictors)
- review of
group_by(),summarize(),inner_join() - dealing with
NAsinsummarize()usingna.rm=TRUE - avoid over-plotting with
alpha=..andgeom_jitter()
1. Introduction
This lab and the next one are adapted from chapter 4 in Data Mining with R by Luis Torgo. The data contains over 400 thousand sales reports with the following variables:
- ID - ID of the sales person
- Prod - ID of the product sold
- Quant - number of reported units sold
- Val - reported total value of the sale
- Insp - this variable has three possible values:
okif the report was inspected and found valid,fraudif the report was inspected but found fraudulent, andunknif the report was not inspected.
2. Exploring the data
library(tidyverse)
library(stargazer)
data <- read_csv("sales.csv")
glimpse(data)## Observations: 401,146
## Variables: 5
## $ ID <chr> "v1", "v2", "v3", "v4", "v3", "v5", "v6", "v7", "v8", "v...
## $ Prod <chr> "p1", "p1", "p1", "p1", "p1", "p2", "p2", "p2", "p2", "p...
## $ Quant <dbl> 182, 3072, 20393, 112, 6164, 104, 350, 200, 233, 118, 23...
## $ Val <dbl> 1665, 8780, 76990, 1100, 20260, 1155, 5680, 4010, 2855, ...
## $ Insp <chr> "unkn", "unkn", "unkn", "unkn", "unkn", "unkn", "unkn", ...We see that there are over 400 thousand sales reports. Let’s first look at the quantitative variables: Val' andQuant`.
data <- as.data.frame(data)
stargazer(select(data,Val, Quant), type="text", median = TRUE, digits = 0)##
## ============================================================================
## Statistic N Mean St. Dev. Min Pctl(25) Median Pctl(75) Max
## ----------------------------------------------------------------------------
## Val 399,964 14,617 69,713 1,005 1,345 2,675 8,680 4,642,955
## Quant 387,304 8,442 918,351 100 107 168 738 473,883,883
## ----------------------------------------------------------------------------There is a pretty wide range in the quantity variable, but it appears that the minimum sale is 100 units. The range in the total value of the sales report is, not surprisingly, also wide and skewed. Also, there are missing values (NA’s) in both quantity and value.
Let’s take a look at the character variables. First, let’s see how many different values each takes on.
n_distinct(data$Prod)## [1] 4548n_distinct(data$ID)## [1] 6016table(data$Insp)##
## fraud ok unkn
## 1270 14462 385414We see that there are lots of different sales people (6,016 of them), and lots of different products (4,548 of them). Importantly, it appears that only a small fraction of reports has been inspected as over 385 thousand reports have unknown status. Of the roughly 15 thousand inspected reports only a small fraction is fraudulent, 8%. Thus, there is significant class imbalance in the variable we are trying to predict. Let’s do a few central tendency statistics by Insp.
IN-CLASS EXERCISE 1: Calculate median of value and quantity for ‘ok’, ‘fraudulent’ and ‘unknwn’ transactions.
Hopefully, the above exercise showed that we need to be careful about missing values. Since there are missing values in both Val and Quant we will use the option na.rm=TRUE inside the mean() and median() functions. This option (rm stands for remove) tells mean() and median() to ignore missing values. Otherwise, if there was any missing value within a group, mean() and median() would return an NA. In other words, we calculate mean and median over all the non-missing values within each group.
sum <- data %>% group_by(Insp) %>%
summarize(av_Val=mean(Val,na.rm=TRUE), av_Quant=mean(Quant,na.rm=TRUE),
med_Val=median(Val,na.rm=TRUE), med_Quant=median(Quant,na.rm=TRUE))
sum## # A tibble: 3 x 5
## Insp av_Val av_Quant med_Val med_Quant
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 fraud 93200. 945504. 6790 737
## 2 ok 60797. 35784. 13635 432.
## 3 unkn 12629. 4260. 2620 166We see that inspected transactions are decidedly larger in terms of value and quantity than uninspected ones (status unkn). We see that in terms of average value fraudulent transactions are bigger, but in terms of median value they appear smaller. Quantity is bigger for fraudulent both in terms of average and median. Clearly, there are some complex relationships among value, quantity and fraudulent/ok status. Let’s plot the data to see if we can shed some light.
We have two quantitative variables, Val and Quant which we can plot on the x and y axes. We also have qualitative variable Insp which we can map to color. Since we saw pretty big range for both value and quantity, we will use log scales. Also, since we have about 400 thousand observations we should reduce over-plotting by making the points transparent using the alpha= aesthetic.
ggplot(data, aes(x=Quant, y=Val, color=Insp)) + geom_point(alpha=0.25) +
scale_x_continuous(trans="log", breaks=c(1000,10000,100000,1000000,10000000,100000000))+
scale_y_continuous(trans="log", breaks=c(1000,10000,100000,1000000,10000000)) 
It looks like the fraudulent transactions are scattered around the edges of the ‘cloud’ of observations. They either have high value and low quantity or low value and relatively high quantity. This suggests that unit price (Val/Quant) may be unusual for fraudulent transactions.
Let’s examine the unit price for each product. Identical products should cost roughly the same. If there is a big deviation of the unit price from what the product typically sells for, we should probably examine that sales report. To calculate a ‘typical unit price’ we should ideally use only inspected sales reports that were deemed ‘ok’ so that we know the price is accurate. However, only 798 out of total of 4548 products were inspected and deemed ‘ok’. Since the vast majority of reports is ‘ok’ we will use all reports that were not fraudulent. Note that we again use the na.rm=TRUE option so that we get a typical price (mean or median) for each product even if some reports for a product had missing values for Val or Quant.
uprice <- data %>% filter(Insp!="fraud") %>% group_by(Prod) %>%
summarize(av_uprice=mean(Val/Quant,na.rm=TRUE),
med_uprice=median(Val/Quant,na.rm=TRUE))
uprice <- as.data.frame(uprice)
stargazer(uprice, type="text", median = TRUE, digits =1)##
## ====================================================================
## Statistic N Mean St. Dev. Min Pctl(25) Median Pctl(75) Max
## --------------------------------------------------------------------
## av_uprice 4,546 19.7 129.5 0.1 6.8 13.3 20.4 8,157.3
## med_uprice 4,546 15.0 137.3 0.02 6.0 11.2 15.7 9,204.2
## --------------------------------------------------------------------Given that some of the unit prices may come from fraudulent reports we will use median unit price as a measure of a typical price for a product. This may eliminate undue influence of a fraudulent reports. Let’s merge the medium product price back into our data and calculate a relative price as the deviation from median price. We will calculate the deviation from median price as the difference between unit price and the median unit price divided by the average of unit price and median unit price. This method will keep the relative price between -200 and +200 percent. (This will make it easier to visualize.)
data <- full_join(data, uprice, by="Prod") %>%
mutate(rel_uprice = (Val/Quant-med_uprice)/((Val/Quant+med_uprice)/2)*100)
stargazer(select(filter(data, Insp=="ok"),rel_uprice), median=TRUE, type="text")##
## ===========================================================================
## Statistic N Mean St. Dev. Min Pctl(25) Median Pctl(75) Max
## ---------------------------------------------------------------------------
## rel_uprice 14,347 14.623 72.591 -197.683 -36.241 0.412 67.798 196.462
## ---------------------------------------------------------------------------stargazer(select(filter(data, Insp=="fraud"),rel_uprice), median=TRUE, type="text")##
## ===========================================================================
## Statistic N Mean St. Dev. Min Pctl(25) Median Pctl(75) Max
## ---------------------------------------------------------------------------
## rel_uprice 1,199 -0.088 173.075 -200.000 -179.113 -32.933 186.939 199.687
## ---------------------------------------------------------------------------We see that ok transactions tend to have relatively higher unit prices than fraudulent transactions.(I would expect the opposite, i.e. sales people inflating prices.) There is also a big difference in the standard deviation of the relative unit price among the fraudulent transactions versus the ok transactions. Relative prices vary a lot more among the fraudulent transactions. Let’s plot the relative unit prices to get a better sense of how they are distributed withing ok and fraud transactions. In addition to alpha parameter, we can avoid over-plotting by adding a geom_jitter() which will add small random shifts the position of our data points. Here we restrict the jitter to horizontal shifts by setting height=0.
ggplot(data, aes(x=Insp, y=rel_uprice, color=Insp)) + geom_point(alpha=0.25) + geom_jitter(height = 0)
Wow, this graph clearly shows that unit prices of fraudulent transactions are off.
Finally, let’s focus on the missing values - we have lots of them. Let’s create a new variable missing that describes whether Val, Quant, both, or none are missing. We will use function ifelse(). We will also make this variable a factor (it will be useful when we make predictions).
data <- data %>%
mutate(missing = as.factor(case_when(
is.na(Val) & is.na(Quant) ~ "both missing",
is.na(Val) ~ "Val missing",
is.na(Quant) ~ "Quant missing",
TRUE ~ "no missing")))
table(data$missing)##
## both missing no missing Quant missing Val missing
## 888 387010 12954 294We see that missing quantity is much more frequent than missing value. Still, there is probably something suspicious about reports with missing values.
IN-CLASS EXERCISE 2: Create a visual representation of the distribution of observations across values of Insp and simultaneously across values of missing.
We have at least two solid candidates, rel_uprice and missing, for predicting fraudulent reports. We will do just that using a new algorithm called decision trees in lab 12.