NOTE:Citation from WIKI
A BGM-109 Tomahawk flying in November 2002
The Tomahawk Land Attack Missile (TLAM) is a long-range, all-weather, jet-powered, subsonic cruise missile that is primarily used by the United States Navy and Royal Navy in ship- and submarine-based land-attack operations.
It was designed and initially produced in the 1970s by General Dynamics as a medium- to long-range, low-altitude missile that could be launched from a surface platform. The missile’s modular design accommodates a wide variety of warhead, guidance, and range capabilities. At least six variants and multiple upgraded versions have been introduced since then, including air-, sub-, and ground-launched variants and conventional and nuclear-armed ones. As of 2019, only non-nuclear, sea-launched variants are currently in service.
For more information about TOMAHAWK see https://en.wikipedia.org/wiki/Tomahawk_(missile)
Here we use open source historical record “SLCM Tomahawk Flight Test History,” 17 February 1982 [JCMPO] published in The Evolution of the Cruise Missile by KENNETH P. WERRELL, Maxwell Air Force Base, Alabama, 1985, pages 265-270.
We apply Tabula 1.2.1 (https://tabula.technology/) for exporting PDF tables into CSV files. Having completed with some dull routine operations we got five data frames. Here is the first one.
cruise1 <- read.csv("cruise1.csv")
cruise1
## Item Date Number Platform Type Remarks X
## 1 1 13Feb76 T4 :1 HTTL AF Launch and boost . S
## 2 2 15Feb76 T6 :1 HTTL AF Launch and boost . S
## 3 3 28Mar76 T7 :1 A/C AF Integration of missile, S
## 4 engine and guidance
## 5 26Apr76 T8 :1 A/C AF Flutter stability &
## 6 control . S
## 7 5 16May76 T8:2 A/C AF Flight envelope
## 8 expansion . S
## 9 6 5Jun76 T9 :1 A/C LA Integration of missile,
## 10 engine and guidance . S
## 11 7 11Jun76 T8:3 A/C AF Flight envelope S
## 12 expansion .
## 13 8 16Jul76 T9:2 A/C LA Nav, TERCOM, and
## 14 terrain following S
## 15 9 30Jul76 T9:3 A/C LA Nav, TERCOM, and
## 16 terrain following . F
## 17 10 8Aug76 T8:4 A/C AF Airspeed calibration and
## 18 low-level flight . S
## 19 I I 27Aug76 T10 :1 A/C LA Aero performance
## 20 buildup . S
## 21 12 ISep76 T8:5 A/C AF Terminal maneuver &
## 22 flight envelope expand . S
## 23 13 30Sep76 T10 :2 A/C LA Simulated operational
## 24 mission . S
## 25 14 140ct 76 TI 1 :1 AfC AF Aero performance
## 26 buildup . S
## 27 15 15Nov76 T11 :2 A/C AF Aero performance
## 28 buildup . S
## 29 16 7Dec76 T12 :1 A/C AS Expand over-the-horizon
## 30 (OTH) area search and
## 31 acquire target . S/S
## 32 17 29Jan77 T10 :3 A/C LA Scene matching area
## 33 correlation (SMAC) S
All in all we got the final file with test results (true,false) only.
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
load(file = "cruise_all.dat")
head(cruise_all)
## V2 V4 V5 V6 V7
## 1 13Feb76 HTTL AF Launch and boost . S
## 2 15Feb76 HTTL AF Launch and boost . S
## 3 28Mar76 A/C AF Integration of missile, S
## 4 engine and guidance
## 5 26Apr76 A/C AF Flutter stability &
## 6 control . S
cruise_all_2 <- cruise_all%>%filter(V7!="")
cruise_test <- recode(cruise_all_2$V7,S="Success",'S/S'="Success",'F/F'="Failure",
'S/F'="Failure",'SIS'="Success",F="Failure")
cruise_test_data <- recode(cruise_test,Success=TRUE,Failure=FALSE)
cruise_test_data
## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE FALSE TRUE TRUE
## [12] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [23] FALSE TRUE TRUE FALSE TRUE TRUE TRUE TRUE TRUE FALSE FALSE
## [34] TRUE FALSE FALSE TRUE TRUE TRUE TRUE TRUE FALSE FALSE TRUE
## [45] TRUE TRUE FALSE FALSE TRUE TRUE TRUE FALSE TRUE TRUE FALSE
## [56] FALSE TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [67] FALSE TRUE TRUE FALSE TRUE TRUE FALSE FALSE
summary(cruise_test_data)
## Mode FALSE TRUE
## logical 19 55
NS <- sum(cruise_test_data)
NALL <-length(cruise_test_data)
prop_success <- NS/NALL
prop_success
## [1] 0.7432432
As we see TOMAHAWK has got 74.3% reliability according to the test results during flight test program (1976-1982). Can we make out something else applying current data? Let’s see!
binom.test(NS,NALL,0.8)
##
## Exact binomial test
##
## data: NS and NALL
## number of successes = 55, number of trials = 74, p-value = 0.2437
## alternative hypothesis: true probability of success is not equal to 0.8
## 95 percent confidence interval:
## 0.6284351 0.8377956
## sample estimates:
## probability of success
## 0.7432432
One can see that TOMAHAWK has made great success during flight test program.
We apply TOMAHAWK flight test data for the proportion of success as function of the current test event using beta prior as Bayesian likelihood.
#The prop_model function - Rasmus Bååth R code
# This function takes a number of successes and failuers coded as a TRUE/FALSE
# or 0/1 vector. This should be given as the data argument.
# The result is a visualization of the how a Beta-Binomial
# model gradualy learns the underlying proportion of successes
# using this data. The function also returns a sample from the
# posterior distribution that can be further manipulated and inspected.
# The default prior is a Beta(1,1) distribution, but this can be set using the
# prior_prop argument.
# Make sure the packages tidyverse and ggridges are installed, otherwise run:
# install.packages(c("tidyverse", "ggridges"))
# Example usage:
# data <- c(TRUE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE)
# prop_model(data)
prop_model <- function(data = c(), prior_prop = c(1, 1), n_draws = 10000,
gr_name="Proportion graph") {
library(tidyverse)
data <- as.logical(data)
# data_indices decides what densities to plot between the prior and the posterior
# For 20 datapoints and less we're plotting all of them.
data_indices <- round(seq(0, length(data), length.out = min(length(data) + 1, 40)))
# dens_curves will be a data frame with the x & y coordinates for the
# denities to plot where x = proportion_success and y = probability
proportion_success <- c(0, seq(0, 1, length.out = 100), 1)
dens_curves <- map_dfr(data_indices, function(i) {
value <- ifelse(i == 0, "Prior", ifelse(data[i], "Success", "Failure"))
label <- paste0("n=", i)
probability <- dbeta(proportion_success,
prior_prop[1] + sum(data[seq_len(i)]),
prior_prop[2] + sum(!data[seq_len(i)]))
probability <- probability / max(probability)
data_frame(value, label, proportion_success, probability)
})
# Turning label and value into factors with the right ordering for the plot
dens_curves$label <- fct_rev(factor(dens_curves$label, levels = paste0("n=", data_indices )))
dens_curves$value <- factor(dens_curves$value, levels = c("Prior", "Success", "Failure"))
graph_label <- paste("Prior likelihood distribution Beta(a =",
as.character(prior_prop[1]),", b =",
as.character(prior_prop[2]),")")
p <- ggplot(dens_curves, aes(x = proportion_success, y = label,
height = probability, fill = value)) +
ggridges::geom_density_ridges(stat="identity", color = "white", alpha = 0.8,
panel_scaling = TRUE, size = 1) +
scale_y_discrete("", expand = c(0.01, 0)) +
scale_x_continuous("Proportion of success") +
scale_fill_manual(values = hcl(120 * 2:0 + 15, 100, 65), name = "", drop = FALSE,
labels = c("Prior ", "Success ", "Failure ")) +
ggtitle(paste0(gr_name, ": ", sum(data), " successes, ", sum(!data), " failures"),
subtitle = graph_label) +
labs(caption = "based on Rasmus Bååth R code") +
theme_light() +
theme(legend.position = "top")
print(p)
# Returning a sample from the posterior distribution that can be further
# manipulated and inspected
posterior_sample <- rbeta(n_draws, prior_prop[1] + sum(data), prior_prop[2] + sum(!data))
invisible(posterior_sample)
}
prop_model(data = cruise_test_data,
prior_prop = c(1,1),gr_name = "TOMAHAWK 1976-1982 test events")
## ── Attaching packages ───────────────────────────────────────────────── tidyverse 1.2.1 ──
## ✔ ggplot2 3.2.1 ✔ readr 1.3.1
## ✔ tibble 2.1.3 ✔ purrr 0.3.2
## ✔ tidyr 1.0.0 ✔ stringr 1.4.0
## ✔ ggplot2 3.2.1 ✔ forcats 0.4.0
## ── Conflicts ──────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## Warning: `data_frame()` is deprecated, use `tibble()`.
## This warning is displayed once per session.
prop_model(data = cruise_test_data,
prior_prop = c(2,2),gr_name = "TOMAHAWK 1976-1982 test events")