###MITRIE NOAMER PC1000 ##### #this has some local directory references #the AD1000 network differs from AD1400 network. It has 3 NOAMER Pcs instead of 2; and no SWM network. #Fig. 1. Proxy principal components: the rst principal component of the North American ITRDB network #of Mann et al., 1998. (1) Using the normalisation as in Mann et al. 1998, (2) as (1), but using full variance #for normalisation rather than detrended variance, (3) normalised and centred on the whole series, (4) #centred only (5) as archived by MBH1998. 21-year running means. #`mbh98' is the collection of proxies used by Mann et al., (1998) which extend back to AD1400. `mbhx' and `mbh98x' are variations of `mbh' and #`mbh98' respectively in which the proxy principal components have been recalculated. #### MITRIE CODING #5 cases: mbh,mbhl,mbhx,std,cen by 00,01 by pc1,pc2,pc3 #mbh: using the standardisation of mbh: centred and standardised on detrended-variance of last 79 years. #mbhx: centred and standardised on variance of last 79 years #mbhl: centred and standardised on detrended-variance of last 125 years #cen: centred on the whole period. #std: centred and normalised on the whole period. # [1] "mppc01_itrdb_namer_1000_mbh_00" "mppc02_itrdb_namer_1000_mbh_00" "mppc03_itrdb_namer_1000_mbh_00" # [4] "mppc01_itrdb_namer_1000_mbhl_00" "mppc02_itrdb_namer_1000_mbhl_00" "mppc03_itrdb_namer_1000_mbhl_00" # [7] "mppc01_itrdb_namer_1000_mbhx_00" "mppc02_itrdb_namer_1000_mbhx_00" "mppc03_itrdb_namer_1000_mbhx_00" #[10] "mppc01_itrdb_namer_1000_std_00" "mppc02_itrdb_namer_1000_std_00" "mppc03_itrdb_namer_1000_std_00" #[13] "mppc01_itrdb_namer_1000_cen_00" "mppc02_itrdb_namer_1000_cen_00" "mppc03_itrdb_namer_1000_cen_00" #[16] "mppc01_itrdb_namer_1000_mbh_01" "mppc02_itrdb_namer_1000_mbh_01" "mppc03_itrdb_namer_1000_mbh_01" #[19] "mppc01_itrdb_namer_1000_mbhl_01" "mppc02_itrdb_namer_1000_mbhl_01" "mppc03_itrdb_namer_1000_mbhl_01" #[22] "mppc01_itrdb_namer_1000_mbhx_01" "mppc02_itrdb_namer_1000_mbhx_01" "mppc03_itrdb_namer_1000_mbhx_01" #[25] "mppc01_itrdb_namer_1000_std_01" "mppc02_itrdb_namer_1000_std_01" "mppc03_itrdb_namer_1000_std_01" #[28] "mppc01_itrdb_namer_1000_cen_01" "mppc02_itrdb_namer_1000_cen_01" "mppc03_itrdb_namer_1000_cen_01" ###COMPARE TO PC COLLECTION FOR MBH98 #30 cases #5 types: mbh,mbhl,mbhx,std,cen #(2+1) pcs: # pc1,pc2,swm PC1 #2 slections 00,01: 30 Pcs # [1] "mppc01_itrdb_namer_1400_mbh_00" "mppc02_itrdb_namer_1400_mbh_00" "mppc01_itrdb_namer_1400_mbhl_00" # [4] "mppc02_itrdb_namer_1400_mbhl_00" "mppc01_itrdb_namer_1400_mbhx_00" "mppc02_itrdb_namer_1400_mbhx_00" # [7] "mppc01_itrdb_namer_1400_std_00" "mppc02_itrdb_namer_1400_std_00" "mppc01_itrdb_namer_1400_cen_00" #[10] "mppc02_itrdb_namer_1400_cen_00" "mppc01_stahle_swm_1400_mbh_00" "mppc01_stahle_swm_1400_mbhl_00" #[13] "mppc01_stahle_swm_1400_mbhx_00" "mppc01_stahle_swm_1400_std_00" "mppc01_stahle_swm_1400_cen_00" #[16] "mppc01_itrdb_namer_1400_mbh_01" "mppc02_itrdb_namer_1400_mbh_01" "mppc01_itrdb_namer_1400_mbhl_01" #[19] "mppc02_itrdb_namer_1400_mbhl_01" "mppc01_itrdb_namer_1400_mbhx_01" "mppc02_itrdb_namer_1400_mbhx_01" #[22] "mppc01_itrdb_namer_1400_std_01" "mppc02_itrdb_namer_1400_std_01" "mppc01_itrdb_namer_1400_cen_01" #[25] "mppc02_itrdb_namer_1400_cen_01" "mppc01_stahle_swm_1400_mbh_01" "mppc01_stahle_swm_1400_mbhl_01" #[28] "mppc01_stahle_swm_1400_mbhx_01" "mppc01_stahle_swm_1400_std_01" "mppc01_stahle_swm_1400_cen_01" ###### #COLLATE MBH1000 PC1s AS SAVED BY MITRIE ####### ################## #### N. B. ##### #the zip file has been previous downloaded and unzipped into a directory "C:/climate/data/mitrie" ############ ################# library(ncdf) url<- "c:/climate/data/mitrie" loc<-file.path(url, "mitrie_new_proxy_pcs_1000_v01.nc" ) # fred<-open.ncdf(loc) mbh.pc1000<-array(NA,dim=c(981,30)) for (i in 1:30) { v1 <- fred$var[[i]] mbh.pc1000[,i] <- get.var.ncdf( fred, v1 ) # by default, reads ALL the data } col0<-c("black","red","blue") ### in this network the 01 values are identical to the 00 values fred<-mbh.pc1000[,1:15]-mbh.pc1000[,16:30] max(fred) #0 ################# ###PC EMULATION emulation<-array(NA,dim=c(981,30)) eigen.NOAMER<-array(NA, dim=c(27,30)) ######################################## ##MONTE CARLO SIMULATIONS OF HOCKEY STICKS ON TRENDLESS PERSISTENT SERIES ######################## #LOAD NOAMER NETWORK, EXTEND BY PERSISTENCE AND TRUNCATE TO 1980 loc<-"c:/climate/data/mann/UVA/NOAMER.txt" tree<-read.table(loc,header=TRUE,sep="\t") #collated AD1400 network tree<-ts(tree[,2:ncol(tree)],start=tree[1,1],end=tree[nrow(tree),1]) temp<-!is.na(tree[1,]) tree<-tree[,temp] dates<-tsp(tree)# [1] 1400 1992 1 tree<-tree[1:581,] id<-dimnames(tree)[[2]] ;id<-strip(id,2) id[67]<-substr(id[67],1,5) #strip excess letter in MBH code #LOAD COLLATION OF DETAILS (NOT ARCHIVED) #load("c:/climate/data/tree/northamerica.details.tab") #temp<-!is.na(match(details$id,id)) &(details$start<1001)&!is.na(details$start) #sum(temp) #27 #details$id[temp] #network<-details$id[temp] network<-c("ar052","az510","ca528","ca529","ca530","ca533","ca534","ca535", "co522","co524","ga002","ga003","la001","nc008","nm560","nm572","nv037","nv510", "nv512","nv513","nv514","nv515","nv516","nv517","ut508","ut509","va021") #JUCKES: SELECT SERIES THAT GO BACK TO AD1000 # AR052,AZ510, CA528, CA529, CA534, CA530, CA533, # CO522, CO524, GA002, GA003, LA001, NC008, NM560, NM572, NV510, # NV512, NV513, NV514, NV515, NV516, NV517, UT508 UT509, VA021 #excludes ca535; nv037 both of which end slightly before 1980. Meth Walk; Upper Timber Creek #COLLATE NOAMER 1000 NETWORK url<-"c:/climate/data/new" #whatever works at Mann's FTP site #ftp://holocene.evsc.virginia.edu/pub url<-file.path(url,"TREE/ITRDB/NOAMER") tree<-NULL for (i in 1:27) { loc<-file.path(url,paste(as.character(network[i]),"txt",sep=".")) test<-read.table(loc) tree<-ts.union(tree,ts(test[,2],start=test[1,1])) } dim(tree) #7993 27 tree<-ts(tree[(1000:1980)-tsp(tree)[1]+1,],start=1000) dimnames(tree)[[2]]<-network temp81<-!is.na(tree[981,]) tree<-extend.persist(tree) ##COLS 1-3 mbh_00 tree.mannomatic<-mannomatic(tree) pca.mannomatic<-prcomp(tree.mannomatic[,temp81],center=FALSE) emulation[,1:3]<-pca.mannomatic$x[,1:3] c(cor(emulation[,1],mbh.pc1000[,1]), cor(emulation[,2],mbh.pc1000[,2]), cor(emulation[,3],mbh.pc1000[,3]))# [1] 1 -1 1 eigen.NOAMER[temp81,1:3]<-pca.mannomatic$rotation[,1:3] pca.mannomatic<-prcomp(tree.mannomatic,center=FALSE) emulation[,16:18]<-pca.mannomatic$x[,1:3] c(cor(emulation[,16],mbh.pc1000[,16]), cor(emulation[,17],mbh.pc1000[,17]), cor(emulation[,18],mbh.pc1000[,18]))# [1] 0.9996325 -0.9824019 0.9843859 eigen.NOAMER[temp81,16:18]<-pca.mannomatic$rotation[,1:3] c(cor(emulation[,1],mbh.pc1000[,16]), cor(emulation[,2],mbh.pc1000[,17]), cor(emulation[,3],mbh.pc1000[,18]))# [1] 1 -1 1 #this is the same ??!!?? #so they didn't include the two extendable series ##cols 4-6: #mbhl: centred and standardised on detrended-variance of last 125 years tree.mannomatic<-mannomatic(tree,M=124) pca<- prcomp(tree.mannomatic[,temp81],center=FALSE) emulation[,4:6]<-pca$x[,1:3] c(cor(emulation[,4],mbh.pc1000[,4]), cor(emulation[,5],mbh.pc1000[,5]), cor(emulation[,6],mbh.pc1000[,6]))# [1] 1 -1 1 eigen.NOAMER[temp81,4:6]<-pca.mannomatic$rotation[,1:3] ##cols 7-9 #mbhx: centred and standardised on variance of last 79 years tree.mannomatic<-mannomatic(tree,sdmethod="undetrended") pca<-prcomp(tree.mannomatic[,temp81],center=FALSE) emulation[,7:9]<-pca$x[,1:3] c(cor(emulation[,7],mbh.pc1000[,7]), cor(emulation[,8],mbh.pc1000[,8]), cor(emulation[,9],mbh.pc1000[,9]))# [1] 1 -1 1 eigen.NOAMER[temp81,7:9]<-pca.mannomatic$rotation[,1:3] ##cols 10-12 std: centred and normalised on the whole period. tree.scaled<-scale(tree) pca<- prcomp(tree.scaled[,temp81]) emulation[,10:12]<-pca$x[,1:3] c(cor(emulation[,10],mbh.pc1000[,10]), cor(emulation[,11],mbh.pc1000[,11]), cor(emulation[,12],mbh.pc1000[,12]))# [1] -1 -1 1 eigen.NOAMER[temp81,10:12]<-pca.mannomatic$rotation[,1:3] ###cols 9-10 COVARIANCE #cen: centred on the whole period. tree.centered<-scale(tree,scale=FALSE) pca<-prcomp(tree.centered[,temp81]) emulation[,13:15]<-pca$x[,1:3] c(cor(emulation[,13],mbh.pc1000[,13]), cor(emulation[,14],mbh.pc1000[,14]), cor(emulation[,15],mbh.pc1000[,15]))# [1] -1 1 1 eigen.NOAMER[temp81,13:15]<-pca$rotation[,1:3] ##NOAMER EIGENVECTOR COEFFICIENTS apply(eigen.NOAMER[,1:15],2,sum,na.rm=T) [1] -3.638404 -2.342265 1.775849 -3.638404 -2.342265 1.775849 -3.638404 -2.342265 1.775849 -3.638404 -2.342265 1.775849 4.410650 0.793342 1.442053 #flipping practices need to be checked ## apply(emulation[401:981,1:15],2,hockeystat) #[1] -1.56587633 0.08454269 0.01150145 -1.55197253 0.02861589 -0.15730569 -1.55560261 0.10233753 0.01366491 1.40157502 0.53193215 -0.03713254 #[13] 0.76107209 0.63996578 1.19287948