########################################################################################### ## Retrieve consolidated Global LOTA Data from ProcessTrends.com ## ## Plots trends for all 5 LOTA series for latest month ## ## ## ## ## RClimate_trends_5_series_for_latest_month.R ## ## Orig Oct 26, 2010 ## ########################################################################################### source("http://processtrends.com/files/RClimate.txt") library(ggplot2);library(plotrix) mon_name <- c("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre") lota <- get_lota() mon_n <- as.numeric(substring(lota$yr_mon, 5,6)) yr_n <- as.numeric(substring(lota$yr_mon, 1,4)) series <- c("GISS", "Hadley", "NOAA", "RSS", "UAH") lota_df <- data.frame(yr_n,mon_n, lota) which_mon<- 9 ## loop to subset lota for each series for which_mon month par(mfcol=c(3,2)); par(mar=c(0.5,1,0,0)); par(oma=c(3.5,3.5,4,1)) for (s in 1:5) { lota_mon <- subset(lota_df, lota_df$mon_n == which_mon) plot(lota_mon$yr_frac, lota_mon[,s+4],type="o",ylim=c(-.9, 1), las=1, xlab="", las=1,pch=16, cex=0.6, col="black", axes=F) abline(h=0, col="grey") #lissage loess/30 ans polynome degree 1 regloess=loess(lota_mon[,s+4]~ lota_mon$yr_frac, lota_df, span = 30/((max(lota_mon$yr_frac)-min(lota_mon$yr_frac))+1), degree = 1) u=lota_mon$yr_frac v=predict(regloess, u) points(u, v, type = "l", lwd = 2.5, col= "blue") c <- nrow(lota_mon) last_a <- signif(lota_mon[c,s+4],3) last_yr <- lota_mon[c,1] last_val_note <- paste(last_yr, " Anom @ ", last_a, sep="") points(lota_mon[c,3], lota_mon[c,s+4], type = "p",pch=16, col = "red", cex=0.75) text(1885, 0.5, last_val_note, adj=0) points(1883, 0.5, type="p", pch=16, cex=0.85, col = "red") axis(3, at=NULL, labels=F, tcl=0.5) axis(4, at=NULL, labels=F, tcl=0.5) ifelse (s != 3 & s!= 5, axis(1, at=NULL, labels=F, tcl=0.5), axis(1, at=NULL, labels=T)) ifelse (s <= 3, axis(2, at=NULL, labels=T, las=1, cex=0.75), axis(2, at=NULL, tcl=0.5,labels=F)) box() text(1890, 0.7, series[s], adj=0, font=2) } title<- paste("Anomalies de Températures Globales \n Lissage Loess/30 ans - Mois de ", mon_name[which_mon], sep="") mtext(title, 3,1,adj=0.5, cex=1, outer=T, font=2) mtext("Température Anomalie - C", 2,2,adj=0.5, outer=T) mtext("D Kelly O'Day - http://chartgraphs.wordpress.com + modif ChristianP", 1,2, adj = 0, cex = 0.7, outer=TRUE) mtext(format(Sys.time(), "%m/%d/ %Y"), 1, 2, adj = 1, cex = 0.7, outer=TRUE) ################################################################################################### ## loop to calc months ranks by series m_anom <- numeric(5) m_rank <- numeric(5) for (s in 1:5) { s_rank <-rank(lota_mon[,s+4], na.last="keep", ties.method="max") s_rank_max <- max(s_rank, na.rm=T) s_pos <- (s_rank_max +1)-s_rank s_df <- data.frame(lota_mon$yr_n, lota_mon[,s+4],s_pos) names(s_df) <- c("yr", "anom", "postion") s_df_s <- s_df[order(-s_df$anom),] m_anom[s]<- signif(s_df_s[s_df_s$yr==2010,2],2) m_rank[s] <- s_df_s[s_df_s$yr==2010,3] } #### Make table showing rankings baseline <- c("1951-1980", "1961-1990", "1961-1990", "1979-1998", "1979-1998") st_yr <- c(rep(1880,3), rep(1979,2)) ranking <- data.frame(series, baseline, m_anom, m_rank) names(ranking) <- c("Series", "Moyennes", "Anom °C","Rangs") plot_tab <- function() { # par(mar=c(2,2,2,1));par(oma=c(1,1,1,1)) # par(fin=c(5,4)) table_title <- paste(mon_name[which_mon],"", last_yr," Récapitulatif", sep="") plot(x=c(0,1,2,3), y= c(0,1,2,3), type="n", axes=F,ann=F, xlim=c(0,4), ylim=c(0,4)) addtable2plot(2,1.5,ranking,bty="o",display.rownames=F,hlines=T,cex=1, title=table_title, xjust=0.5, yjust=0.5) } plot_tab()