Cryonics doesn’t have an especially long history or many patients, making it tractable to collect data on nearly all of them. Moreover, cryonicists tend to be inclined towards more and better documentation–after all, who knows what data will be important at revival time? Might as well store as much as possible. Also being of a generally transparent disposition (in the interest of de-mystifying the process for people who might be interested if the process and organization is laid bare before them), they tend to publish case information online:

That said, assembling this data isn’t a trivial task. Many cryonicists (or their survivors) prefer not to have their information shared publicly. Accordingly, the existing cryonics organizations’ public records are spotty. The existing organizations are also not the only one to have ever existed, nor are they the first. Finding records from defunct organizations imposes a deep degree of detection, inference, and guess work (not to mention earlier work and luck). This was, by far, the most time-consuming piece of this project, as data generation often is.

# Load from Google Sheets
cryonauts <- read_csv('https://docs.google.com/spreadsheets/d/e/2PACX-1vS7nOdzuAUs5bSoHkZw1gJTWJT-MVbMicXK8iIUIkZwFqUVh2zmC8Cl_QTz1j0kriMW3ycobYDDWFuG/pub?output=csv') %>%
  mutate(DorCDate = as.Date(DorCDate))

Cryonauts through time

To whet our appetite, let’s look at the growth of cryonics.

cryonauts %>%
  dplyr::filter(!is.na(DorCDate)) %>%
  mutate(cumulation = 1:nrow(.)) %>%
  plot_ly(x=~DorCDate, y=~cumulation, type = 'scatter', mode = 'lines')

This graph shows the number of people cryopreserved. As a sanity check, Futurism put together an infographic including a graph of the growth of cryonics that largely agrees with this (though their version looked only at Alcor, Cryonics Institute and KrioRus Statistics, instead of all recorded cases, leading to lower counts).

One important note on dates: KrioRus reports “cryopreservation date”, rather than the date of deanimation. However, it’s a bit difficult to tell what this means, since cryopreservation is a process which takes place over the course of several days. The other organizations all report the date of deanimation (except for TransTime, which reports nothing and whose cases must be inferred from other sources).

Let’s model it! I’m going to use a couple of models: linear (for posterity), quadratic (since it’s the most intuitive curve that might fit this well), exponential (because this actually looks exponential to me), and a linear model of the predictions of the others (basically to estimate the optimal weight of the other models).

Year <- rep(min(year(cryonauts$DorCDate), na.rm = TRUE):max(year(cryonauts$DorCDate), na.rm = TRUE), each=12)
Month <- rep(1:12, length(Year)/12)
yms <- data.frame(Year, Month)

monthly <- cryonauts %>%
  dplyr::filter(!is.na(DorCDate)) %>%
  mutate(
    Year = year(DorCDate),
    Month = month(DorCDate)
  ) %>%
  group_by(Year, Month) %>%
  dplyr::summarise(number = n()) %>%
  ungroup() %>%
  right_join(yms) %>%
  dplyr::filter(!(Year >= year(now()) & Month >= month(now()))) %>%
  mutate(
    number = ifelse(is.na(number), 0, number),
    cumulation = cumsum(number),
    logCum = log1p(cumulation),
    YM = Year + (Month-1)/12,
    YM2 = YM^2,
    date = as.Date(paste(Year, Month, "01", sep = "-"))
  )

LinM  <- lm(cumulation ~ YM, data = monthly)
LinP  <- LinM %>% predict %>% unname

QuadM <- lm(cumulation ~ YM + YM2, data = monthly)
QuadP <- QuadM %>% predict %>% unname

ExpM  <- lm(logCum ~ YM, data = monthly)
ExpP  <- ExpM %>% predict %>% unname %>% expm1

AvgM  <- lm(cumulation ~ LinP + QuadP + ExpP, data = cbind(monthly, LinP, QuadP, ExpP))
AvgP  <- AvgM %>% predict %>% unname

monthly %>%
  plot_ly(x=~date, y=~cumulation, type = 'scatter', mode = 'lines', name = "Cases") %>%
  add_lines(y=LinP, name="Linearly Predicted number of cases") %>%
  add_lines(y=QuadP, name="Quadratically Predicted number of cases") %>%
  add_lines(y=ExpP, name="Exponentially Predicted number of cases") %>%
  add_lines(y=AvgP, name="Ensemble Predicted number of cases")

OK, we have an ensemble model that does quite well based solely on growth rates. What does it say about the future of Cryonics?

Year <- rep(1:20+max(year(cryonauts$DorCDate), na.rm = TRUE), each=12)
Month <- rep(1:12, length(Year)/12)
Fyms <- data.frame(Year, Month) %>%
  mutate(
    YM = Year + (Month-1)/12,
    YM2 = YM^2,
    date = as.Date(paste(Year, Month, "01", sep = "-"))
  )

FLinP  <- LinM %>% predict(Fyms) %>% unname

FQuadP <- QuadM %>% predict(Fyms) %>% unname

FExpP  <- ExpM %>% predict(Fyms) %>% unname %>% expm1

FAvgP  <- AvgM %>% predict(cbind(Fyms, LinP=FLinP, QuadP=FQuadP, ExpP=FExpP)) %>% unname

plot_ly(Fyms, x=~date, y=FLinP, name="Linearly Predicted number of cases", type = 'scatter', mode = 'lines') %>%
  add_lines(y=FQuadP, name="Quadratically Predicted number of cases") %>%
  add_lines(y=FExpP, name="Exponentially Predicted number of cases") %>%
  add_lines(y=FAvgP, name="Ensemble Predicted number of cases")

It appears that Cryonics is unlikely to experience explosive growth in the next 20 years. Obviously, this discounts any substantive events, like a successful demonstration of a complete revival of a cryopreserved large animal (rabbit or dog (see also or pig) seem the likeliest cases).

So what about the cryonics patients themselves? What trends can we identify about them?

Age and Gender

The simplest demographic features are age (at time of deanimation) and gender. To start with, let’s look at gender. My preliminary suspicion is that men will vastly outnumber women. After all, it’s been reported that 85% of cryonics signups are men.

women <- cryonauts %>% filter(Gender=="Female")
men   <- cryonauts %>% filter(Gender=="Male")

w <- women %>%
  dplyr::filter(!is.na(DorCDate)) %>%
  mutate(
    c = 1,
    cumulation = cumsum(c)
  )

m <- men %>%
  dplyr::filter(!is.na(DorCDate)) %>%
  mutate(
    c = 1,
    cumulation = cumsum(c)
  )
  
plot_ly(m, x=~DorCDate, y=~cumulation, type='scatter', mode='lines', name="Men") %>%
  add_lines(data = w, x=~DorCDate, y=~cumulation, name="Women") %>%
  layout(
    xaxis = list(title = "Date"),
    yaxis = list(title = "Number of Cryonauts"),
    barmode = "overlay"
  )

Thus far, it seems men outnumber women roughly 3:2. However, the ratio was roughly 1:1 until the mid-90’s. This is much closer to gender parity than I expected. [Related]

What about the distribution of age? This should be a left-skewed distribution (older people are more likely to die than younger people). Moreover, We can weakly predict that women will enjoy a slightly more left-skewed curve, outliving men in the cryonics community just as they tend to in the larger community.

p <- ggplot(cryonauts, aes(Age, fill=Gender)) + geom_density(alpha = 0.5)
ggplotly(p)
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`

Unsurprisingly, the people who are cryopreserved are largely older. And it does look as though women outlive men by around 7 years in the cryonics community.

Does this match the curve of ages-at-death in the larger population? This is a surprisingly difficult question to answer! To start, let’s look at the mean age-at-deanimation of cryonics patients (along with the min and max ages, just for fun).

cryonauts %>%
  dplyr::filter(!is.na(DorCDate), !is.na(Age)) %>%
  mutate(
    MaxAge = cummax(Age),
    MeanAge = cummean(Age),
    MinAge = cummin(Age)
  ) %>%
  plot_ly(x=~DorCDate, y=~MaxAge, name="Oldest Patient Age", type = 'scatter', mode = 'lines', line = list(shape = "hv")) %>%
  add_lines(y=~MeanAge, name="Average Patient Age") %>%
  add_lines(y=~MinAge, name="Youngest Patient Age") %>%
  layout(
    yaxis = list(title = "Age at Deanimation"),
    xaxis = list(title = "Date")
  )

The minimum age drops precipitously. Intuitively, this is about what we should expect: we can’t cryopreserve people who aren’t born yet, so the minimum age is going to hit zero at some point in the future, and never decrease again.

The maximum age climbs, which is also to be expected. As more people die and enter cryostorage, some of them should, just by random draws from the Gompertz distribution, be older than the rest of the population. This should behave roughly like the curve of the record for the oldest person, gradually pushing up towards 120 or so (barring any major breakthroughs in longevity-extension efforts).

The mean population is the most interesting (and relevant to the motivating question). We expect that it should roughly trace the global life expectancy. However, because life expectancies are measured by country by year-of-birth, mapping from age at death (the data we have) to life expectancy (the data we need) is prohibitively difficult–we don’t generally know the patients’ birth country for one.

We can however, spot-check the mean age at death. The mean age of death has held steadily around 65 since the 2000’s. These people would have been born around 1950. According to Our World In Data, the world-wide life expectancy in 1950 was 48, and the industrialized world (US, Europe, USSR, and Oceania) was closer to 60. So Cryonicists are probably living at least a little longer than their generational cohort, on average. This may be a function of wealth, among other things: access to cryonics is expensive, and far from a priority budget item for most humans.

Procedural Preferences

Not all cryonic procedures are exactly the same, and no cryonics provider offers all options. In general, there are two different types: whole body, which is basically exactly what you think, and neuropreservation, which is cryopreservation of only the head. More recently, Oregon Cryonics has begun performing brain-only preservations. and finally, there are separate whole body and neuro preservations.

cryonauts %>%
  dplyr::filter(!is.na(DorCDate), !is.na(OriginalType)) %>%
  group_by(OriginalType) %>%
  dplyr::mutate(
    c = 1,
    cumulation = cumsum(c)
  ) %>%
  plot_ly(x=~DorCDate, y=~cumulation, type='scatter', mode='lines', color=~OriginalType) %>%
  layout(
    xaxis = list(title = "Date"),
    yaxis = list(title = "Number of Cryonauts")
  )

Suspension Failure

Perhaps the most important and interesting inferences we can make regard the likelihood that a suspended person will be brought back. Because this is completely unknown (until someone is successfully revived), we can only make inferences based on estimates of probabilities of the things that may prevent someone from being revived. And the one bottleneck about which we have data is suspension failure.

cryonauts %>%
  dplyr::filter(!is.na(DorCDate), Status != "Preserved") %>%
  mutate(
    c = 1,
    cumulation = cumsum(c)
  ) %>%
  plot_ly(x=~DorCDate, y=~cumulation, type='scatter', mode='lines') %>%
  layout(
    xaxis = list(title = "Date"),
    yaxis = list(title = "Number of Suspension Failures")
  )

Here we see the number of suspension failures over time. Note that I didn’t collect data on the date of the failure, so these are plotted against the date of deanimation, which should be good enough. Fortunately, there have been few enough that it almost makes the most sense to discuss them individually, rather than measure any aggregate statistics. Of the 29 known suspension failures, the lion’s share belong to the Cryonics Society of California. Led by the bold and hard-working but ill-fated Bob Nelson, CSC stored 10 cryonauts, of whom all but one were lost in the Chatsworth Disaster, hence the precipitous rise in the late 60’s. Several others were cases of survivors refusing to make maintenance payments. Sadly, only one cryopreservation attempted before 1974 has been maintained. Two were killed in the 9-11 World Trade Center attacks. Two were private cases that suffered a freezer failure. I do not know about many other cases.

Relative to the number of successful cases, these failures are looking less and less likely:

cryonauts %>%
  dplyr::filter(!is.na(DorCDate)) %>%
  mutate(
    failure = ifelse(Status=="Preserved", 0, 1),
    success = ifelse(Status=="Preserved", 1, 0),
    failures = cumsum(failure),
    successes = cumsum(success)
  ) %>%
  plot_ly(x=~DorCDate, y=~successes, type='scatter', mode='lines', name='Successful Suspensions') %>%
  add_lines(y=~failures, name='Failed Suspensions') %>%
  layout(
    xaxis = list(title = "Date"),
    yaxis = list(title = "Number of Cryonauts")
  )

As time wears on, the proportion of failures is decreasing. This is a very positive developmnetal direction, and so long as there aren’t any facilities crises, it looks to continue this way. As a proportion of current cryonics cases, this failure rate may be a reasonable estimate for probabilistic cryonics failures in the future. So, what is that proportion?

cryonauts %>%
  dplyr::filter(!is.na(DorCDate)) %>%
  mutate(
    c = 1,
    failure = ifelse(Status=="Preserved", 0, 1),
    failures = cumsum(failure),
    proportion = 1-(failures / cumsum(c))
  ) %>%
  plot_ly(x=~DorCDate, y=~proportion, type='scatter', mode='lines', name='Probability of Successful Suspensions') %>%
  layout(
    xaxis = list(title = "Date"),
    yaxis = list(title = "Proportion Preserved")
  )

94% and rising. This may form a useful piece of evidence for estimating the more general probability of cryonics succeeding. Here are some other attempts at estimating that probability:

Organizational History

What about the provider organizations?

cryonauts %>%
  dplyr::filter(!is.na(DorCDate), !is.na(OriginalProvider)) %>%
  group_by(OriginalProvider) %>%
  dplyr::mutate(
    c = 1,
    cumulation = cumsum(c)
  ) %>%
  plot_ly(x=~DorCDate, y=~cumulation, type='scatter', mode='lines', color=~OriginalProvider) %>%
  layout(
    xaxis = list(title = "Date"),
    yaxis = list(title = "Number of Cryonauts")
  )
## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors

Interesting, but only relevant to someone looking for information about the history of cryonics. Most of these organizations are defunct. Let’s just look at those that are currently servicing clients:

cryonauts %>%
  dplyr::filter(!is.na(DorCDate), !is.na(CurrentProvider)) %>%
  group_by(CurrentProvider) %>%
  dplyr::mutate(
    c = 1,
    cumulation = cumsum(c)
  ) %>%
  plot_ly(x=~DorCDate, y=~cumulation, type='scatter', mode='lines', color=~CurrentProvider) %>%
  layout(
    xaxis = list(title = "Date"),
    yaxis = list(title = "Number of Cryonauts")
  )

Much better. I didn’t realize that Alcor and CI are basically the same size, and almost always have been. Also, KrioRus is growing at almost exactly the same rate as the large American firms. Oregon Cryonics and YLSF are unlikely to grow as quickly, since they’re either accepting memberships on a limited basis (in the former case) or not open to signups in general (in the latter case). That just leaves Trans Time the oddball. I’ll be very interested to see if Southern Cryonics follows the same pattern as the other large providers, once it opens up.

Future Work

There are tons more interesting things that could be done here, but the ones that interest me require additional data collection:

Sources