Nothing
#' Calculate Signorino and Ritter's (1999) S for Similarity
#'
#' @description
#'
#' \code{srs()} takes two vectors and returns Signorino and Ritter's S statistic
#' communicating broadly understood "similarity" of interests or ratings.
#'
#' @return
#'
#' \code{srs()} takes two vectors and returns Signorino and Ritter's S statistic
#' communicating broadly understood "similarity" of interests or ratings.
#'
#' @details
#'
#' Be advised that Signorino and Ritter's (1999) treatment of the S statistic
#' used absolute distances when squared distances are more commonly used in the
#' world of distance and association metrics.
#'
#' There will sometimes be instances, assuredly with alliances, where not all
#' categories are observed. For example, the toy example I provide of Germany
#' and Russia in 1914 includes no 2s. In the language of "ratings", the "rating"
#' of 2 was available for Germany and Russia in 1914 but neither side used it.
#' The `levels` argument allows you to specify the full sequence of values that
#' could be observed, even if none were. It probably makes the most sense to
#' always use this argument, even if the default behavior operates as if you
#' won't.
#'
#' The function subsets to complete cases of the two vectors for which you want
#' an S score. If weights are included, the function further subsets to complete
#' cases including the weights as well.
#'
#' The function implicitly assumes that `x1` and `x2` are columns in a data
#' frame. One indirect check for this looks at whether `x1` and `x2` are the
#' same length. The function will stop if they're not.
#'
#' ## Several Comments on Weighting
#'
#' If it were my call to make, I'd caution against the IR standard of using
#' the composite index of national capabilities (CINC) as a weight on the
#' calculation of the S statistic. I expand a bit on this line of thinking on my
#' blog here:
#'
#' \url{https://svmiller.com/blog/2026/06/alliances-weighting-foreign-policy-similarity/}
#'
#' The following was my original entry into this documentation file and I'll
#' keep it as is for posterity. Conceptually, weighting by capabilities tries to
#' capture some kind of "importance" quantity. Related to the familiar
#' application of alliances, this would prioritize those states that could
#' conceivably bring more to the battlefield. In practice, this adds one
#' anachronism to another. Capabilities, as measured, are basically a nineteenth
#' century measurement for which estimates of energy consumption, iron and steel
#' production, and urban population size are given equal weight in composition
#' of the measure to military expenditures and military size. Alliances
#' themselves are somewhat antiquarian, certainly in what we want them to do for
#' this measure. If the question is "why must alliances be measures of foreign
#' policy similarity", the answer kind of reduces to "we have historical data on
#' them." If you want estimates for the 19th century, you have this, but then
#' are implicitly confessing your measure of foreign policy similarity is an
#' anachronism.
#'
#' There are other peculiarities too. The data on capabilities has always been
#' historically skewed to the right. Very few states have proportionally that
#' much weight. As the state system has expanded in size (i.e. as empires ended),
#' the relative weight at the top necessarily decreases. For example, the top
#' 3 states in capabilities in 1816 (the United Kingdom, Russia, and France)
#' combined for 61.8% of capabilities in a system of just 23 states. In 2016,
#' the top three states (China, the United States, and India) combined for 45%
#' of capabilities in a system of 195 states. New states are almost always small
#' states that possess almost no capabilities. 11 of 23 states in 1816 had less
#' than 1% of capabilities. That's about 48% of the system. In 2016, 176 of 195
#' states have less than 1% of capabilities. That's over 90% of the system. If
#' the idea is to identify the "important" foreign policy ties, I echo Haege's
#' (2011) contention that this approach is a second-best solution. It's
#' second-best to other metrics that better model chance-corrected agreement. It
#' just discards too much information and gives too much weight to great powers
#' and/or states that are conspicuously high on capabilities (e.g. India).
#'
#' Faithfully calculating a weighted S statistic (by system capabilities)
#' requires a weight that sums to 1. In the most literal sense of 1, there is
#' no year in the National Material Capabilities data (v. 2016) in which system
#' capabilities in a given year sum to 1. In almost 60% of cases/years, the
#' discrepancy doesn't look like a rounding error either. In 1860, all
#' capabilities sum to over 1.07! In the context of applications with Correlates
#' of War's CINC scores, you can still use the raw data because the function
#' doesn't assume the weights sum to 1. You'll see how in the denominator of
#' the formula.
#'
#' In applications to the Correlates of War system, as far as I am aware, there
#' are no CoW states for which there isn't a CINC estimate. If, for some reason,
#' a CINC score (or some other weight) is missing, the cases are dropped
#' *before* weights are applied.
#'
#' If weights are supplied, the weights must match the length of either `x1` or
#' `x2`. The function builds in an implicit assumption that the weights are a
#' column in the data frame you're using.
#'
#' The function will proportionalize your weights to sum to 1 if they do not sum
#' to 1 already.
#'
#'
#'
#' @param x1 a vector, and one assumes an integer
#' @param x2 a vector, and one assumes an integer
#' @param distances the type of distances between ratings/attachments to
#' estimate. Can be either "absolute" or "squared". Defaults to "absolute", but
#' see note in details section.
#' @param weights a vector of weights. Defaults to NULL for creating unweighted
#' S statistics
#' @param levels defaults to NULL, but an optional vector that defines the full
#' sequence of values that could be observed in `x1` and `x2`. If NULL, the
#' function looks for observed values.
#'
#' @examples
#'
#' srs(gmyrus14$gmy, gmyrus14$rus, distances = 'absolute', levels = c(0:3))
#' srs(gmyrus14$gmy, gmyrus14$rus, distances = 'squared', levels = c(0:3))
#' srs(gmyrus14$gmy, gmyrus14$rus, distances = 'absolute', weights = gmyrus14$syscap, levels = c(0:3))
#'
#' @references
#'
#' Signorino, Curtis S. and Jeffrey M. Ritter. "Tau-b or Not Tau-B: Measuring
#' the Similarity of Foreign Policy Positions." *International Studies Quarterly*
#' 43(1): 115–44.
#'
#' @importFrom stats complete.cases
#' @export
srs <- function(x1, x2, distances = "absolute", weights = NULL, levels = NULL) {
if(length(x1) != length(x2)) {
stop("`x1` and `x2` are not the same length.")
}
if (!is.null(weights) && (length(weights) != length(x1) || length(weights) != length(x2))) {
stop("`weights` must be the same length as `x1` and `x2` if you're going to provide it.")
}
if (is.null(levels)) {
use.these.levels <- sort(unique(c(x1, x2)))
} else {
use.these.levels <- levels
}
if(is.null(weights)) {
completetf <- complete.cases(x1, x2)
x1 <- x1[completetf]
x2 <- x2[completetf]
} else {
completetf <- complete.cases(x1, x2, weights)
x1 <- x1[completetf]
x2 <- x2[completetf]
weights <- weights[completetf]
}
## 1. Absolute Distances ----
if(distances == "absolute") {
if(is.null(weights)) {
## * Absolute Distances, No Weights -----
# Calculated observed S...
tab <- table(factor(x1, levels = use.these.levels),
factor(x2, levels = use.these.levels))
o <- prop.table(tab)
d <- abs(row(o) - col(o))
dd <- max(use.these.levels) - min(use.these.levels) # nrow(o) - 1 # nrow(o) - 1
S <- 1 - 2*sum(o*d)/dd
} else { # Okay, so you have weights... cue Shania Twain...
## * Absolute Distances, with Weights ----
# Calculate observed S, with weights...
o <- xtabs(weights ~
factor(x1, levels = use.these.levels) +
factor(x2, levels = use.these.levels))
# Check if o sums to 1... it must...
if(sum(o) != 1) {
o <- o/sum(o)
}
rmarg <- rowSums(o)
cmarg <- colSums(o)
d <- abs(row(o) - col(o))
dd <- max(use.these.levels) - min(use.these.levels) # nrow(o) - 1
S <- 1 - 2*sum(o*d)/dd
}
}
## 2. Squared Distances ----
if(distances == "squared") {
if(is.null(weights)) {
## * Squared Distances, No Weights -----
# Calculated observed S...
tab <- table(factor(x1, levels = use.these.levels),
factor(x2, levels = use.these.levels))
o <- prop.table(tab)
d <- abs(row(o) - col(o))^2
dd <- (max(use.these.levels) - min(use.these.levels))^2 # nrow(o) - 1
S <- 1 - 2*sum(o*d)/dd
} else { # Okay, so you have weights... cue Shania Twain...
## * Squared Distances, With Weights -----
# Calculate observed S, with weights...
o <- xtabs(weights ~
factor(x1, levels = use.these.levels) +
factor(x2, levels = use.these.levels))
# Check if o sums to 1... it must...
if(sum(o) != 1) {
o <- o/sum(o)
}
rmarg <- rowSums(o)
cmarg <- colSums(o)
d <- abs(row(o) - col(o))^2
dd <- (max(use.these.levels) - min(use.these.levels))^2 # nrow(o) - 1
S <- 1 - 2*sum(o*d)/dd
}
}
return(S)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.