## Online Resource 1: R script for range shift analysis
##
## Informing Conservation by Identifying Range Shift Patterns 
##    across Breeding Habitats and Migration Strategies
##
##	Biodiversity and Conservation 
##
## Torre J. Hovick*, Brady W Allred, Devan A. McGranahan**, Michael W. Palmer, 
##		R. Dwayne Elmore, Samuel D. Fuhlendorf
##		*corresponding author of paper; torre.hovick@gmail.com	
##    ** author of R script; mcgranah@alumni.grinnell.edu
#
# Load data 
	load("C:/.../ranges.d.Rdata") # Load raw species abundance data
#	
# Load required packages
	library(SDMTools) 	# v. 1.1-221
	library(plyr) 		# http://www.jstatsoft.org/v40/i01/
#
##
## 	C o n f i d e n c e  I n t e r v a l  C a l c u l a t i o n
##	(assumes data preparation steps (below) are completed)
##
	#
	#	The CI function 
	#
		CI.auto <- function(x) {
			m0 <- x$early.wt.mean  
			m1 <- x$late.wt.mean 
			sp0 <- x$early.wt.sd	
			sp1 <- x$late.wt.sd
			n <- 1000
			xdiff<-rep(9999,n)
			 for(i in 1:n){
				x0<-rnorm(n,m0,sp0)
				x1<-rnorm(n,m1,sp0)
				xdiff[i] <- mean(x1)-mean(x0) }
					ci.range<-array(NA,c(1,3))
					colnames(ci.range) <- c("ciL","lat.diff","ciU")
					ci.range[1,] <- c(sort(xdiff)[round(.05*n)], 
										mean(xdiff), 
										sort(xdiff)[round(.95*n)]) 
					return(as.data.frame(ci.range))
				}
	#
	# Calculate species- and group-level CIs on lat change
	#
		spp.cf <- ddply(.data=spp.wt.dat, .(species), .fun=CI.auto)
			spp.cf <- merge(spp.wt.dat[,1:2], spp.cf, by.x = "species", by.y = "species") 
			spp.cf <- merge(hab.mig, spp.cf, by.x = "species", by.y = "species") 
		br.cf <- ddply(.data=br.wt.dat, .(breeding), .fun=CI.auto)
		mig.cf <- ddply(.data=mig.wt.dat, .(migration), .fun=CI.auto)
	#	
	# Calculate mean shift across all species
	#
		spp.shift <- merge(spp.cf[,c(1,5)], count(ranges.d, vars = "species", 
								wt_var = "count"),  
							by.x = "species", by.y = "species")
		mean.shift <- data.frame(wt.mean.lat=round(with(spp.shift, 
									wt.mean(lat.diff, freq)), 3), 
								wt.sd.lat=round(with(spp.shift, 
									wt.sd(lat.diff, freq)), 3) ) 
		mean.shift <- data.frame(mean.shift, wt.mean.km=round(I(mean.shift$wt.mean.lat*110.574), 3), 
									wt.sd.km=round(I(mean.shift$wt.sd.lat*110.574), 3) ) 
##
## 	D a t a  P r e p a r a t i o n
##		
	##
	## Species - level 
	##
	# Calculating weighted means, SD by period
	# wt.mean
		sp.wt.av.early <- ddply(.data=subset(ranges.d, period=="early"), 
					.variables=c("species"), summarize, wt.mean(latitude, count) )
			colnames(sp.wt.av.early)[[2]] <- "wt.mean"
		sp.wt.av.late <- ddply(.data=subset(ranges.d, period=="late"), 
					.variables=c("species"), summarize, wt.mean(latitude, count) )
			colnames(sp.wt.av.late)[[2]] <- "wt.mean"
	# sp.wt.sd
		sp.wt.sd.early <- ddply(.data=subset(ranges.d, period=="early"), 
					.variables=c("species"), summarize, wt.sd(latitude, count) )
			colnames(sp.wt.sd.early)[[2]] <- "wt.sd"
		sp.wt.sd.late <- ddply(.data=subset(ranges.d, period=="late"), 
					.variables=c("species"), summarize, wt.sd(latitude, count) )
			colnames(sp.wt.sd.late)[[2]] <- "wt.sd"
	# Combine weighted data for CI calculation
			spp.wt.dat <- data.frame(species=sp.wt.av.early$species, 
						early.wt.mean=sp.wt.av.early$wt.mean,
						early.wt.sd=sp.wt.sd.early$wt.sd,
						late.wt.mean=sp.wt.av.late$wt.mean, 
						late.wt.sd=sp.wt.sd.late$wt.sd) 
	##
	## Breeding  
	##
	# Calculating weighted means, SD by period
	# wt.mean
		br.wt.av.early <- ddply(.data=subset(ranges.d, period=="early"), 
					.variables=c("breeding"), summarize, wt.mean(latitude, count) )
			colnames(br.wt.av.early)[[2]] <- "br.wt.mean"
		br.wt.av.late <- ddply(.data=subset(ranges.d, period=="late"), 
					.variables=c("breeding"), summarize, wt.mean(latitude, count) )
			colnames(br.wt.av.late)[[2]] <- "br.wt.mean"
	# br.wt.sd
		br.wt.sd.early <- ddply(.data=subset(ranges.d, period=="early"), 
					.variables=c("breeding"), summarize, wt.sd(latitude, count) )
			colnames(br.wt.sd.early)[[2]] <- "br.wt.sd"
		br.wt.sd.late <- ddply(.data=subset(ranges.d, period=="late"), 
					.variables=c("breeding"), summarize, wt.sd(latitude, count) )
			colnames(br.wt.sd.late)[[2]] <- "br.wt.sd"
	# Combine weighted data for CI calculation
			br.wt.dat <- data.frame(breeding=br.wt.av.early$breeding, 
						early.wt.mean=br.wt.av.early$br.wt.mean,
						early.wt.sd=br.wt.sd.early$br.wt.sd,
						late.wt.mean=br.wt.av.late$br.wt.mean, 
						late.wt.sd=br.wt.sd.late$br.wt.sd) 
	##
	## Migration 
	# Calculating weighted means, SD by period
	# wt.mean
		mig.wt.av.early <- ddply(.data=subset(ranges.d, period=="early"), 
					.variables=c("migration"), summarize, wt.mean(latitude, count) )
			colnames(mig.wt.av.early)[[2]] <- "mig.wt.mean"
		mig.wt.av.late <- ddply(.data=subset(ranges.d, period=="late"), 
					.variables=c("migration"), summarize, wt.mean(latitude, count) )
			colnames(mig.wt.av.late)[[2]] <- "mig.wt.mean"
	# mig.wt.sd
		mig.wt.sd.early <- ddply(.data=subset(ranges.d, period=="early"), 
					.variables=c("migration"), summarize, wt.sd(latitude, count) )
			colnames(mig.wt.sd.early)[[2]] <- "mig.wt.sd"
		mig.wt.sd.late <- ddply(.data=subset(ranges.d, period=="late"), 
					.variables=c("migration"), summarize, wt.sd(latitude, count) )
			colnames(mig.wt.sd.late)[[2]] <- "mig.wt.sd"
	# Combine weighted data for CI calculation
			mig.wt.dat <- data.frame(migration=mig.wt.av.early$migration, 
						early.wt.mean=mig.wt.av.early$mig.wt.mean,
						early.wt.sd=mig.wt.sd.early$mig.wt.sd,
						late.wt.mean=mig.wt.av.late$mig.wt.mean, 
						late.wt.sd=mig.wt.sd.late$mig.wt.sd)