For this example I’ll be using the Meko et al. 2007 tree-ring reconstruction of the Colorado River’s annual natural flow at Lees Ferry, AZ (extending from A.D. 762-2005). You can check out the data yourself. I’ll be loading it in an R example below.

The heart of this relies on FindDrought, a function that returns a simple binary mask to determine whether a particular year is a “drought year” or not. Here, I’m defining drought as years of below-mean flow, broken by two or more years of above average flow.

FindDrought <- function(x, averageflow=mean(x)) {
  # Determines whether a given time period is in a drought, given a record.
  #
  # Args:
  #   x: A vector of annual stream flow observations.
  #   averageflow: If you want to specify a flow average for finding droughts.
  #
  # Returns:
  #   A vector indicating whether drought present (TRUE) or not present (FALSE).
  foo <- rep(TRUE, length(x))
  foo[x >= averageflow] <- FALSE
  runs <- rle(foo)
  runs$values[runs$lengths < 2 & runs$values == FALSE] <- TRUE
  return(inverse.rle(runs))
}

Having defined what years are and are not droughts, we can then use this information in the DefineDrought. This function loops through and collects basic characteristics about each drought event, returning each drought’s start year, stop year, duration, and “intensity” (the sum of anomalies).

DefineDrought <- function(x, y, averageflow=mean(y)) {
  # Determines basic characteristics of droughts in a given flow time series.
  #
  # Args:
  #   x: Year of time series observation, in a vector format.
  #   y: Time series or vector of river flow observations.
  #   averageflow: If you want to specify a flow average for finding droughts.
  #
  # Returns:
  #   A data frame with columns giving:
  #   1) The starting period of a drought - "start".
  #   2) The period a drought stops - "stop".
  #   3) The number of periods that the drought was present - "duration".
  #   4) The sum of anomalies for the drought period - "anom.sum".
  drought.present <- FindDrought(y, averageflow = averageflow)
  start <- c()
  stop <- c()
  duration <- c()
  anom.sum <- c()
  temp.start <- FALSE
  temp.duration <- 0
  temp.anom.sum <- 0
  # There is likely a more elegant way to handle this aside form loops.
  for (obs in 1:length(y)) {
    if (drought.present[obs] == FALSE) {
      temp.start <- FALSE
      temp.duration <- 0
      temp.anom.sum <- 0
    }
    else if (drought.present[obs] == TRUE) {
      if (!temp.start)
        temp.start <- x[obs]
      temp.duration <- temp.duration + 1
      temp.anom.sum <- temp.anom.sum + (y[obs] - averageflow)
      if ((drought.present[obs + 1] == FALSE) | (obs + 1 > length(y))) {
        start <- append(start, temp.start)
        stop <- append(stop, x[obs])
        duration <- append(duration, temp.duration)
        anom.sum <- append(anom.sum, temp.anom.sum)
      }
    }
  }
  return(data.frame(start, stop, duration, anom.sum))
}

If this tugs at your bobber, you can put this to use in a simple interactive session:

lees <- read.table('ftp://ftp.ncdc.noaa.gov/pub/data/paleo/treering/reconstructions/northamerica/usa/upper-colorado-flow2007.txt',
  header = TRUE,
  skip = 158,  # To skip the meta data.
  na.strings = 'NULL')

# Drum-roll, please.
lees.droughts <- DefineDrought(x = lees$Year, y = lees$RecMAF)

'data.frame':	169 obs. of  4 variables:
 $ start   : int  762 770 774 779 786 790 797 805 812 822 ...
 $ stop    : int  767 771 774 781 786 794 799 809 819 830 ...
 $ duration: num  6 2 1 3 1 5 3 5 8 9 ...
 $ anom.sum: num  -2.51 -1.81 -2.33 1.14 -5.89 ...

You’ll note that this is very sensitive to the slightest decline in streamflow. You are able to tweak DefineDrought‘s sensitivity by manually specifying a mean flow value and passing this as an argument. However, especially in exploratory analysis, I’ve found it best to simply sort or filter from this default list so that we can see the entire range of values, even in single year “droughts”.

There you have it! Beats sifting through a time series and manually defining droughts by hand. My next post will (hopefully) be a continuation of this, showing how I’ve used this information to visualize drought onset and impact with ggplot2.

As always, I’m happy to hear questions, comments, corrections or concerns!

EDIT: Updated the FindDrought function based on Cameron Bracken‘s sagely wisdom. Many thanks for introducing me to rle()!

Trust me. It’s cool.

…and you’ll want to put your NetID username and password in there, for the last two entries.

Fairly straightforward once you get it.

It would be nice to do this without looping. If anyone has a clever way to do this, please do let me know.

# 2011-03-04
# v0.01

MovingCor <- function(x, y, window.size=21, method="pearson") {
  # Computes moving correlations between two vectors with symmetrical windows.
  #
  # Args:
  #   x: One of the two vectors whose correlation is to be calculated.
  #   y: The other vector. Note that it must be of the same length as x.
  #   window.size: The size of windows to be used for each calculated
  #                correlation. Note that if even numbers are chosen, the
  #                window will not be skewed as there will be one extra value
  #                on the upper-side of the window. Default size is 21.
  #   method: The method of correlation. May be: "pearson", "kendall", or
  #           "spearman". Default is "pearson".
  #
  # Returns:
  #   A vector of the moving correlations.
  n <- length(x)
  # Setup a few catches for error handling.
  if (TRUE %in% is.na(y) || TRUE %in% is.na(x)) {
    stop("Arguments x and y cannot have missing values.")
  }
  if (n &lt;= 1 || n != length(y)) {
    stop("Arguments x and y have different lengths: ",
         length(x), " and ", length(y), ".")
  }
  out <- rep(NA, round(window.size/2))  # Stuffing the returned vector.
  for (value in seq(from = 1, to = n - (window.size - 1))) {
    value.end &lt;- value + (window.size - 1)
    out <- append(out, cor(x[value:value.end],
                           y[value:value.end],
                           method = method))
  }
  out <- append(out, rep(NA, n - length(out)))  # Finish stuffing.
  return(out)
}

EDIT:
There are more nimble functions out there for this, and other window-related tasks. See the caTools‘s runmean function. The package zoo also has a number of quick functions including rollmean and the more general rollapply.

Drawn by ‘BostonDanceParty’. I claim no rights to this work. You can find the original here.

Sorry for having another content-less post. I still have not quiiiiiite finish the manuscript I am trying to wrap up. I have also had quite a bit of blogging/writing for class and so, I am afraid this old girl gets put on the back burner.

Anyways, yes, I know I’m a bit late in recommending this, but, if you have not taken the time to see this gem of the cinema, I strongly recommend it. It is good in the painful, “I-don’t-think-this-could-possibly-get-any-worse” kind of way.

When I first saw this I thought my head might explode with the sheer awesomeness of the moment.

I suggest night mode if you’re looking for a challenge. Also, music type 3 FTW.

A Declaration of the Independence of Cyberspace

Governments of the Industrial World, you weary giants of flesh and steel, I come from Cyberspace, the new home of Mind. On behalf of the future, I ask you of the past to leave us alone. You are not welcome among us. You have no sovereignty where we gather.

We have no elected government, nor are we likely to have one, so I address you with no greater authority than that with which liberty itself always speaks. I declare the global social space we are building to be naturally independent of the tyrannies you seek to impose on us. You have no moral right to rule us nor do you possess any methods of enforcement we have true reason to fear.

Governments derive their just powers from the consent of the governed. You have neither solicited nor received ours. We did not invite you. You do not know us, nor do you know our world. Cyberspace does not lie within your borders. Do not think that you can build it, as though it were a public construction project. You cannot. It is an act of nature and it grows
itself through our collective actions.

You have not engaged in our great and gathering conversation, nor did you create the wealth of our marketplaces. You do not know our culture, our ethics, or the unwritten codes that already provide our society more order than could be obtained by any of your impositions.

You claim there are problems among us that you need to solve. You use this claim as an excuse to invade our precincts. Many of these problems don’t exist. Where there are real conflicts, where there are wrongs, we will identify them and address them by our means. We are forming our own Social Contract . This governance will arise according to the conditions of our world, not yours. Our world is different.

Cyberspace consists of transactions, relationships, and thought itself, arrayed like a standing wave in the web of our communications. Ours is a world that is both everywhere and nowhere, but it is not where bodies live.

We are creating a world that all may enter without privilege or prejudice accorded by race, economic power, military force, or station of birth.

We are creating a world where anyone, anywhere may express his or her beliefs, no matter how singular, without fear of being coerced into silence or conformity.

Your legal concepts of property, expression, identity, movement, and context do not apply to us. They are based on matter, There is no matter here.

Our identities have no bodies, so, unlike you, we cannot obtain order by physical coercion. We believe that from ethics, enlightened self-interest, and the commonweal, our governance will emerge . Our identities may be distributed across many of your jurisdictions. The only law that all our constituent cultures would generally recognize is the Golden Rule. We hope we will be able to build our particular solutions on that basis. But we
cannot accept the solutions you are attempting to impose.

In the United States, you have today created a law, the Telecommunications Reform Act, which repudiates your own Constitution and insults the dreams of Jefferson, Washington, Mill, Madison, DeToqueville, and Brandeis. These dreams must now be born anew in us.

You are terrified of your own children, since they are natives in a world where you will always be immigrants. Because you fear them, you entrust your bureaucracies with the parental responsibilities you are too cowardly to confront yourselves. In our world, all the sentiments and expressions of humanity, from the debasing to the angelic, are parts of a seamless whole, the global conversation of bits. We cannot separate the air that chokes from the air upon which wings beat.

In China, Germany, France, Russia, Singapore, Italy and the United States, you are trying to ward off the virus of liberty by erecting guard posts at the frontiers of Cyberspace. These may keep out the contagion for a small time, but they will not work in a world that will soon be blanketed in bit-bearing media.

Your increasingly obsolete information industries would perpetuate themselves by proposing laws, in America and elsewhere, that claim to own speech itself throughout the world. These laws would declare ideas to be another industrial product, no more noble than pig iron. In our world, whatever the human mind may create can be reproduced and distributed infinitely at no cost. The global conveyance of thought no longer requires your factories to accomplish.

These increasingly hostile and colonial measures place us in the same position as those previous lovers of freedom and self-determination who had to reject the authorities of distant, uninformed powers. We must declare our virtual selves immune to your sovereignty, even as we continue to consent to your rule over our bodies. We will spread ourselves across the Planet so that no one can arrest our thoughts.

We will create a civilization of the Mind in Cyberspace. May it be more humane and fair than the world your governments have made before.

- John Perry Barlow, 1996

I promise I’ll start posting more material… as soon as I get my manuscript shipped.

I picked this off of reddit… Nothing helps me procrastinate like kittens and their antics.