The Data

df <- read.csv("UFO_Sightings_Data_1.csv",header=TRUE)

library(ggplot2)
library(dplyr)
library(usmap)
library(plotly)
We will be analyzing UFO sighting data that has been collected from November 11, 1906 to May 8, 2014. There have been thousands of reported sightings and this data set contains over 80k sighting reports. I obtained this data from Kaggle.com and it is titled “UFO Sightings”.

The columns include the following:

colnames(df)
##  [1] "datetime"             "date.sighted"         "year.sighted"        
##  [4] "city"                 "state"                "country"             
##  [7] "shape"                "duration..seconds."   "duration..hours.min."
## [10] "comments"             "date.posted"          "latitude"            
## [13] "longitude"

Questions

We will look into answering and analyzing the following about the UFO sightings data, with an end goal to see if we can predict the count of sightings based on selected years.

  1. What country reported the most sightings?

  2. Which US state had the most sightings reported?

  3. Which US city reported the most sightings?

  4. What shape of UFO was most frequently observed?

  5. Count of top 4 most sighted shapes reported by year.

  6. Year with the most sightings reported.

  7. Trend of sightings for recent years.

  8. Linear regression model.

  9. A prediction based off our linear regression model.

Total Sightings by Country

What country reported the most sightings?

Country_Sightings = na.omit(df$country)
Country_Counts = table(Country_Sightings)
df_Country_Counts = as.data.frame(Country_Counts)
names(df_Country_Counts) = c("Country", "Sightings")
df_Country_Counts = df_Country_Counts[order(-df_Country_Counts$Sightings), ]
df_Country_Counts

We can see the US reported the most sightings with a count of 65,114. This makes up around 81% of the total reports. Unfortunately the country data contains blank entries with 9,670 sightings not specifying a country. These were included in this specific summary as it is significant in representing the overall totals, due to the large volume of sightings that do not specify a country.

Top Sightings by United States

Which US state had the most sightings reported?

df_filtered = df[!is.na(df$state) & df$state != "" & df$country == "us", ]
US_Sightings = na.omit(df_filtered$state)
State_Counts = table(US_Sightings)
df_State_Counts = as.data.frame(State_Counts)
names(df_State_Counts) = c("State", "Sightings")
df_State_Counts = df_State_Counts[order(-df_State_Counts$Sightings), ]

top5_States = head(df_State_Counts, 5)

ggplot(top5_States, aes(x = reorder(State, -Sightings), y = Sightings)) + geom_bar(stat = "identity", fill = "green") + geom_text(aes(label = Sightings, vjust = -0.3)) + labs(title = "Top 5 States in the US with Most Sightings", x = "State", y = "Count of Sightings")

California had the most sightings reported, with a total of 8,912 sightings. This is significantly higher than the next highest state, Washington, which has a total of 3,966. It is interesting the top two states are on the west coast. Florida and Texas follow behind with totals close to that of Washinton.

Top 5 Sightings by City in the US

Which US city had the most sightings reported?

df_filtered = df[!is.na(df$city) & df$city != "" & df$country == "us", ]
City_US_Sightings = na.omit(df_filtered$city)
City_Counts = table(City_US_Sightings)
df_City_Counts = as.data.frame(City_Counts)
names(df_City_Counts) = c("city", "Sightings")
df_City_Counts = df_City_Counts[order(-df_City_Counts$Sightings), ]

top5_Cities = head(df_City_Counts, 5)

ggplot(top5_Cities, aes(x = reorder(city, - Sightings), y = Sightings)) + geom_bar(stat = "identity", fill = "blue") + geom_text(aes(label = Sightings, vjust = -0.3)) + labs(title = "Top 5 Cities in the US with Most Sightings", x = "Cities", y = "Count of Sightings")

Seattle had the most sightings reported with a total of 524, followed by phoenix with 454. This is interesting since California had the highest total sightings, however a city in Washington had the highest totals by city. This could be due to reports where the cities or states were not entered as we’ve excluded null entries for the city and state plots. It could also mean that the sightings are more spread out across California since it is a larger state and covers a greater coastal length.

UFO Shapes Observed

What shape of UFO was most frequently observed?

Shapes_Filtered = df[!is.na(df$shape) & df$shape != "", ]
Shapes = na.omit(df$shape)
Shapes_Table = table(Shapes) 
Shape_Counts = as.data.frame(Shapes_Table)
names(Shape_Counts) = c("Shape", "Sightings")
Shape_Counts = Shape_Counts[order(-Shape_Counts$Sightings), ]
Shape_Counts_Top4 = head(Shape_Counts, 4)
Shape_Counts_Top4

Lights were observed more than double the frequency of the second most observed shape, the triangle. Triangle and circle shapes were both very close in total sightings.

UFO Shapes Sighted by Year Observed

Lets check out the top 4 most sighted shapes of UFOs by year.

df_filtered = df %>% filter(!is.na(shape) & shape != "" & date.sighted !="") %>% count(date.sighted, shape) 

Top4_Shapes_Sighted = df_filtered %>% group_by(shape) %>% summarize(total_sightings = sum(n)) %>% arrange(desc(total_sightings)) %>% head(4) %>% pull(shape)

df_filtered_top4 = df_filtered %>% filter(shape %in% Top4_Shapes_Sighted)
df_filtered_top4 = df_filtered_top4 %>% mutate(Year = as.numeric(substr(date.sighted,1,4)))
df_filtered_top4 = df_filtered_top4 %>% group_by(Year, shape) %>% summarize(total_sightings = sum(n))

ggplot(df_filtered_top4, aes(x = Year, y = total_sightings, shape = shape, group = shape)) + geom_point() + scale_shape() + labs(title = "Top 4 UFO Shapes Sighted by Year", x = "Year Reported", y = "Number of Sightings") + facet_wrap(~ shape)

Due to there being so many sightings over the span of so many years, these plots are difficult to read individually. However, we can see a positive trend where the sightings reported drastically increased in more recent years.

Year with Most Sightings Reported

Lets find out what year had the most reported sightings and how many sightings were reported for that year.

df_filtered = df[!is.na(df$year.sighted) & df$year.sighted != "", ]
Year_Max_Sightings = max(table(df_filtered$year.sighted))

Year_Counts = table(df_filtered$year.sighted)
Max_Year = names(Year_Counts)[which.max(Year_Counts)]

The year with the most sightings reported was 2012.There were a total of 7356 sightings reported.

Sightings for Years 2010 - 2014

Lets look at how many sightings were reported in the span of 2010 to 2014 (2014 being the most recent year in the data) since we now know 2012 was the year with the most reported sightings.

df_filtered = df %>% filter(!is.na(df$date.sighted) & df$date.sighted != "") %>% mutate(Year = as.numeric(substr(date.sighted, 1, 4))) %>% filter(Year >= 2010)

df_Date_Counts = df_filtered %>% group_by(Year) %>% summarize(Sightings = n())

ggplot(df_Date_Counts, aes(x = Year, y = Sightings)) + geom_bar(stat = "identity", fill = "lightblue") + geom_text(aes(label = Sightings, vjust = -0.3)) + labs(title = "Sightings from Year 2010 and Greater", x = "Year Sighted", y = "Count of Sightings")

It is intresting to see there was an upward trend from 2010 leading to 2012. And 2013 had very high reports of sighting as well. 2014 had a major decrease, although we only have data through May of that year so it is expected to be less. It would be interesting to see if the numbers remained high in more recent years, possibly due to awareness and increase in ease of reporting due to technology.

Linear Regression Model

Below I’ve built an interactive linear regression model of the UFO sightings from the years 2000 to 2014.

df_filtered = df %>% filter(!is.na(df$date.sighted) & df$date.sighted != "") %>% mutate(Year = as.numeric(substr(date.sighted, 1, 4))) %>% filter(Year >= 2000)

df_Date_Counts = df_filtered %>% group_by(Year) %>% summarize(Sightings = n())

g = ggplot(df_Date_Counts, aes(x = Year, y = Sightings)) + geom_point() + geom_smooth(method = "lm", color = "orange") + labs(title = "Sightings from Year 2000 and Greater", x = "Year Sighted", y = "Count of Sightings")

mod = lm(Sightings ~ Year, data = df_Date_Counts)
summary(mod)
## 
## Call:
## lm(formula = Sightings ~ Year, data = df_Date_Counts)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3241.5  -307.0   -52.7   321.6  2191.6 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)  
## (Intercept) -333936.61  146415.90  -2.281   0.0401 *
## Year            168.54      72.95   2.310   0.0379 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1221 on 13 degrees of freedom
## Multiple R-squared:  0.2911, Adjusted R-squared:  0.2365 
## F-statistic: 5.337 on 1 and 13 DF,  p-value: 0.03793
ggplotly(g)

We can see a positive upward trend in sightings over the years since 2000. Lets see if we can add the “predict” function to estimate how many sightings there will be in the years 2015 and 2025.

2015 and 2025 Predictions

Since we only have data up until May 2014, lets see the count of sightings our regression model will predict for years 2015 and 2025.

New_Year_2015 = data.frame(Year = 2015)
Year_2015 = predict(mod, New_Year_2015)

New_Year_2025 = data.frame(Year = 2025)
Year_2025 = predict(mod, New_Year_2025)

Predict_Year_2015 = round(Year_2015)
Predict_Year_2025 = round(Year_2025)
The count prediction for 2015 is 5670.

The prediction for 2015 would be right in line with that of the completed 2014 year’s prediction.

The count prediction for 2025 is 7355.

This count prediction for 2025 is very close to that of 2012.

It will be fun to see how accurate the prediction is!

Thank you!

Citations

Anna Wolak, November 13, 2019, “UFO Sightings”, National UFO Reporting Center, https://www.kaggle.com/datasets/NUFORC/ufo-sightings