NRA Imperial Meeting 2023 Analysis

Introduction

Background & Aims

The NRA imperial meeting is the largest meeting gathering of TR shooters in the world. Hopefully, you all know what the imperial is…

There are many misconceptions about the imperial, particularly with squadding (i.e. time, target etc), for example some claim that it is much easier to get a higher score if you are on the left or Stix, or that the early details have a much better chance of getting on a prize-list as there is less wind. However, this is demonstrably untrue.

This document aims to show that the only factor in determining how well you do in the imperial is you. I have tried to include data to dispel the most commonly repeated myths, as well as some other interesting data from the imperial.

How to use

Three easy steps:

1. At the very top right of this document there will be a button that says Code ▼. Hit this button, and click “Hide all Code”. This removes the code from the document and makes it easier to read (that is, unless you for some reason want to see the code…)

2. Read the erudite analysis above each graph.

3. Enjoy the sublime beauty of the pretty pictures.

Contact

If you do have any questions please contact the author at: stats@lgsk.tech

Caveats of the dataset

This data set is from the 2023 NRA Imperial Meeting, and as such, the data is only from one year. Additionally, it only includes those who shot the grand agg, and as such, the data is not representative of the entire field. However, it is still a large data set, and as such, the data is still useful. I am waiting to hear back from the NRA on whether they can supply me with a full data set.

Where

Some of the most common myths involve where you are on the range. As shown below, this has little to no effect on your score.

• The red line shows the average on each target.

• The plethora of tiny points is called “jitter”, and shows each individual score from from the data-set, but “jiggled” slightly so that they don’t overlap.

2&10s on Century Range

data <- dbGetQuery(con, "SELECT squadding.target target, imperial.score score from squadding, imperial where squadding.name = imperial.name and imperial.comp=squadding.comp and not distance=1000 and not distance=900 and imperial.toCount=10;")

data$target <- as.factor(data$target)

# Calculate average score for each target
average_scores <- aggregate(score ~ target, data, mean)

# Plot average scores with line
p <- ggplot(average_scores, aes(x=target, y=score, group=1)) + geom_line(color="red")

# Add individual scores with jitter
p <- p + geom_jitter(data=data, aes(x=target, y=score), size=0.1, alpha=0.3)

# Add labels and title
#limit axis to 35-50
#make sure the labels don't overlap
# make plot scale more sensible
p <- p + labs(x="Target", y="Average Score") + ggtitle("Average score by target on Century [all classes]") + ylim(40,50) + theme(axis.text.x = element_text(angle = 90, hjust = 1)) 

print(p)

Warning: Removed 111 rows containing missing values (`geom_point()`).

As you can see, the average remains generally flat, with the variance likely being due to natural variance, however there is a slight dent around targets 62-77. However this dent is less then a point on average, and is likely due to natural variance.

2&10s on Stickledown Range

data <- dbGetQuery(con, "SELECT squadding.target target, imperial.score score from squadding, imperial where squadding.name = imperial.name and imperial.comp=squadding.comp and (distance=1000 or distance=900) and imperial.toCount=10;")

data$target <- as.factor(data$target)

# Calculate average score for each target
average_scores <- aggregate(score ~ target, data, mean)

# Plot average scores with line
p <- ggplot(average_scores, aes(x=target, y=score, group=1)) + geom_line(color="red")

# Add individual scores with jitter
p <- p + geom_jitter(data=data, aes(x=target, y=score), size=0.1, alpha=0.3)

# Add labels and title
#limit axis to 35-50
#make sure the labels don't overlap
# make plot scale more sensible
p <- p + labs(x="Target", y="Average Score") + ggtitle("Average score by target on Stix [all classes]") + theme(axis.text.x = element_text(angle = 90, hjust = 1)) + ylim(35,50)

print(p)

Warning: Removed 39 rows containing missing values (`geom_point()`).

And as on century, no real difference between targets.

T Class on Century

data <- dbGetQuery(con, "SELECT squadding.target target, imperial.score score from squadding, imperial where imperial.class='T' and squadding.name = imperial.name and imperial.comp=squadding.comp and not distance=1000 and not distance=900 and imperial.toCount=10;")

data$target <- as.factor(data$target)

# Calculate average score for each target
average_scores <- aggregate(score ~ target, data, mean)

# Plot average scores with line
p <- ggplot(average_scores, aes(x=target, y=score, group=1)) + geom_line(color="red")

# Add individual scores with jitter
p <- p + geom_jitter(data=data, aes(x=target, y=score), size=0.1, alpha=0.3)

# Add labels and title
#limit axis to 35-50
#make sure the labels don't overlap
# make plot scale more sensible
p <- p + labs(x="Target", y="Average Score") + ggtitle("Average score by target on Century [T Class]") + theme(axis.text.x = element_text(angle = 90, hjust = 1)) + ylim(40,50)

print(p)

Warning: Removed 16 rows containing missing values (`geom_point()`).

And once more, there is little to no variation between targets, however it is important to isolate T class, as generally scores are move affected by wind etc, while O, A and X classes tend to get more consistent scores.

Obviously this data-set is less useful, as in Imperial 23, the only 2&10 shoots on Stix were in extremely windy conditions. To make this data more useful, we once again need to use a boxplot to show distribution more clearly.

data <- dbGetQuery(con, "SELECT squadding.butt target, imperial.score score from squadding, imperial where imperial.class='T' and squadding.name = imperial.name and imperial.comp=squadding.comp and not distance=1000 and not distance=900 and imperial.toCount=10;")

data$target <- as.factor(data$target)

p <- ggplot(data, aes(target, score)) + geom_boxplot() + geom_jitter(alpha=0.5, size=0.5) + ylim(40, 50)

print(p)

Warning: Removed 12 rows containing non-finite values (`stat_boxplot()`).
Warning: Removed 17 rows containing missing values (`geom_point()`).

To make this more readable, I have only displayed the butts of the targets, as there are far too many targets on century to make this readable. Interestingly, there seems to be a slight increase in the median score on butt 14 (Targets 37-48).

T Class on Stickeldown

data <- dbGetQuery(con, "SELECT squadding.target target, imperial.score score from squadding, imperial where imperial.class='T' and squadding.name = imperial.name and imperial.comp=squadding.comp and (distance=1000 or distance=900) and imperial.toCount=10;")

data$target <- as.factor(data$target)

# Calculate average score for each target
average_scores <- aggregate(score ~ target, data, mean)

# Plot average scores with line
p <- ggplot(average_scores, aes(x=target, y=score, group=1)) + geom_line(color="red")

# Add individual scores with jitter
p <- p + geom_jitter(data=data, aes(x=target, y=score), size=0.1, alpha=0.3)

# Add labels and title
#limit axis to 35-50
#make sure the labels don't overlap
# make plot scale more sensible
p <- p + labs(x="Target", y="Average Score") + ggtitle("Average score by target on Stix [T Class]") + theme(axis.text.x = element_text(angle = 90, hjust = 1)) + ylim(35,50)

print(p)

Warning: Removed 11 rows containing missing values (`geom_point()`).

Obviously this dataset is less useful, as in Imperial 23, the only 2&10 shoots on stix were in extremely windy conditions. To make this data more useful, we once again need to use a boxplot.

data <- dbGetQuery(con, "SELECT squadding.butt target, imperial.score score from squadding, imperial where imperial.class='T' and squadding.name = imperial.name and imperial.comp=squadding.comp and (distance=1000 or distance=900) and imperial.toCount=10;")

data$target <- as.factor(data$target)

p <- ggplot(data, aes(target, score)) + geom_boxplot() + geom_jitter(alpha=0.2, size=0.2) + ylim(32.5, 50)

print(p)

Warning: Removed 5 rows containing non-finite values (`stat_boxplot()`).
Warning: Removed 5 rows containing missing values (`geom_point()`).

As we can see here, there is such a huge variance across scores that there is not really any point trying to draw any conclusions, other then that most T classes did shockingly at long range, due to the obscene wind conditions. Interestingly, shooting seems to be a lot more consistent on butt 1 (Targets 11-19).

When

Perhaps the biggest myth when it comes to scores is that the timing of your detail has a huge effect on your score. This is demonstrably untrue, as shown below with the average scores for each detail on century.

data <- dbGetQuery(con, "SELECT squadding.target target, squadding.time time, imperial.score score from squadding, imperial where squadding.name = imperial.name and imperial.comp=squadding.comp and not squadding.time='14:30' and not distance=1000 and not distance=900 and imperial.toCount=10;")

# Convert time from HH:MM:SS to HH:MM

data$time <- substr(data$time, 1, 5)

data$time <- as.factor(data$time)

# Boxplot of scores by time

p <- ggplot(data, aes(time, score)) + geom_boxplot() + geom_jitter(size=0.2, alpha=0.5) + ylim(40, 50)

print(p)

Warning: Removed 28 rows containing non-finite values (`stat_boxplot()`).
Warning: Removed 117 rows containing missing values (`geom_point()`).

And now on stix:

data <- dbGetQuery(con, "SELECT squadding.target target, squadding.time time, imperial.score score from squadding, imperial where squadding.name = imperial.name and imperial.comp=squadding.comp and not squadding.time='14:30' and (distance=1000 or distance=900) and imperial.toCount=10;")

data$time <- substr(data$time, 1, 5)
data$time <- as.factor(data$time)

# Boxplot of scores by time

p <- ggplot(data, aes(time, score)) + geom_boxplot() + geom_jitter(size=0.2, alpha=0.5) + ylim(35, 50)
print(p)

Warning: Removed 17 rows containing non-finite values (`stat_boxplot()`).
Warning: Removed 39 rows containing missing values (`geom_point()`).

And now to look specifically at one day, the 16th of July. The red line is the wind speed for each hour.

coeff <- 2.35

con <- dbConnect(MariaDB(), user='shootmgr', password='DavidNuthall', dbname='stats', host='localhost')

data <- dbGetQuery(con, "SELECT squadding.target target, squadding.time time, imperial.score score from squadding, imperial where squadding.name = imperial.name and imperial.comp=squadding.comp and not squadding.time='14:30' and not distance=1000 and not distance=900 and imperial.toCount=10 and squadding.date='2023-07-16';")

weather <- dbGetQuery(con, "SELECT windspeed, datetime from weather where datetime>'2023-07-16 07:00:00' and datetime<'2023-07-16 19:00:00';")

dbDisconnect(con)
# extract time from datetime

weather$datetime <- substr(weather$datetime, 12, 16)

data$time <- substr(data$time, 1, 5)

# Plot a graph with two x and y axes, with one for the boxplot and one for the wind speed
#`geom_line()`: Each group consists of only one observation.
# ℹ Do you need to adjust the group aesthetic?

weather <- weather[order(weather$datetime), ]

# Plot with ordered data
p <- ggplot(data, aes(time, score)) +
  geom_boxplot() +
  geom_jitter(size = 0.2, alpha = 0.5) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  geom_point(data = weather, aes(x = datetime, y = windspeed * coeff), color = "red") +
  geom_line(data=weather, aes(x=datetime, y= windspeed*coeff, group=1), color = "red") +
  scale_y_continuous(name="Scores", sec.axis = sec_axis(~./coeff, name = "Wind Speed (mph)")) + ylim(40, 50)

Scale for y is already present.
Adding another scale for y, which will replace the existing scale.

print(p)

Warning: Removed 11 rows containing non-finite values (`stat_boxplot()`).
Warning: Removed 59 rows containing missing values (`geom_point()`).
Warning: Removed 1 rows containing missing values (`geom_point()`).
Warning: Removed 1 row containing missing values (`geom_line()`).