Data Source

We fetched the most up-to-date data from the FAA Aircraft Registry.

Detecting FBI Planes

From our initial analysis and John Wiseman’s google spreadsheet, we collected the following list of suspected FBI shell companies:

fbi_registrants <- c(
  "OBR LEASING",
  "KQM AVIATION",
  "OTV LEASING",
  "NBY PRODUCTIONS",
  "PXW SERVICES",
  "PSL SURVEYS",
  "NG RESEARCH",
  "FVX RESEARCH",
  "RKT PRODUCTIONS",
  "LCB LEASING",
  "NBR AVIATION",
  "KLJ AVIATION",
  "OTV LEASING",
  "YAMASEC USA LLC",
  "PSL SURVEYS",
  "AV FLIGHT INC",
  "NATIONAL AIRCRAFT LEASING CORP",
  "AIRCRAFT ASSOCIATES INC",
  "WORLDWIDE AIRCRAFT LEASING CORP",
  "AEROGRAPHICS INC"
)

To detect potential planes, we first filter out all records that match these registrant names:

# initial crop
fbi_planes <- d[d$name %in% fbi_registrants, ]

Next, we expand our search to all addresses which exactly match the addresses in the initial set:

mk_address_string <- function(x) {
  paste(x$street, x$street2, x$city, x$state, x$zip)
}

# list of strings for exact matching
fbi_address_strings <- mk_address_string(fbi_planes)
all_address_strings <- mk_address_string(d)

# find more with exact same addresses 
fbi_planes <- d[all_address_strings %in% fbi_address_strings, ]

Here’s a final list of suspected FBI Shell Companies:

t <- as.data.frame(table(fbi_planes$name))
names(t) <- c('Name', 'Plane_Count')
t <- t[order(t$Plane_Count, decreasing=T), ]
kable(t)
Name Plane_Count
9 NATIONAL AIRCRAFT LEASING CORP 27
2 AIRCRAFT ASSOCIATES INC 12
22 WORLDWIDE AIRCRAFT LEASING CORP 8
15 OBR LEASING 7
6 KQM AVIATION 6
16 OTV LEASING 6
4 FVX RESEARCH 5
12 NBY PRODUCTIONS 5
13 NG RESEARCH 5
17 PSL SURVEYS 5
18 PXW SERVICES 5
19 RKT PRODUCTIONS 4
7 LCB LEASING 3
8 NATIONAL AIRCRAFT LEASING 3
11 NBR AVIATION 3
1 AEROGRAPHICS INC 2
10 NATIONAL AIRCRAFT LEASING CORPORATION 2
20 UNITED STATES DEPARTMENT OF JUSTICE 2
3 AV FLIGHT INC 1
5 KLJ AVIATION 1
14 NORTHWEST AIRCRAFT LEASING CORP 1
21 US DEPT OF JUSTICE 1
23 YAMASEC USA LLC 1

Trend Analysis / Plane Models

Here are some basic plots of when planes were registered / last acted upon:

It seems like most of the planes were registered in 2010.

fbi_planes$cert_issue_date <- ymd(fbi_planes$cert_issue_date)
fbi_planes$cert_date_month <- floor_date(fbi_planes$cert_issue_date, "month")

cert_by_month <- ddply(fbi_planes, "cert_date_month", summarize, count=length(cert_date_month))
cert_by_month$cumsum <- cumsum(cert_by_month$count)

ggplot(cert_by_month, aes(x=cert_date_month, y=cumsum)) + 
  geom_area(fill=BLUE) + 
  theme_enigma() + 
  xlab('Certification Date') + 
  ylab('Total Planes') + 
  labs(title='FBI Planes By Certification Date')

Most of the planes have been active in the past three years:

fbi_planes$last_action_date <- ymd(fbi_planes$last_action_date)
fbi_planes$last_action_date_month <- floor_date(fbi_planes$last_action_date, "month")

last_action_by_month <- ddply(fbi_planes, "last_action_date_month", summarize, count=length(last_action_date_month))

ggplot(last_action_by_month, aes(x=last_action_date_month, y=count)) + 
  geom_bar(fill=BLUE, stat='identity') + 
  theme_enigma() + 
  xlab('Date of Last Action') + 
  ylab('Count') + 
  labs(title='FBI Planes By Date of Last Action')

Top 5 Plane Models:

model_counts <- ddply(fbi_planes, "mfr_mdl_code", summarise, count=length(mfr_mdl_code))
model_counts$mfr_mdl_code[model_counts$mfr_mdl_code=='2072703'] <- "CESSNA 182T"
model_counts$mfr_mdl_code[model_counts$mfr_mdl_code=='2073301'] <- "CESSNA 206H"
model_counts$mfr_mdl_code[model_counts$mfr_mdl_code=='2073303'] <- "CESSNA T206H"
model_counts$mfr_mdl_code[model_counts$mfr_mdl_code=='2073701'] <- "CESSNA 208B"
model_counts$mfr_mdl_code[model_counts$mfr_mdl_code=='1182206'] <- "BELL 407"

model_counts <- model_counts[order(model_counts$count, decreasing=T), ]
kable(head(model_counts, 5))
mfr_mdl_code count
11 CESSNA 182T 55
13 CESSNA 206H 13
14 CESSNA T206H 13
17 CESSNA 208B 7
7 BELL 407 6