#
###################################################
# COMPENDIUM OF CUSTOM FUNCTIONS www.solv.ca/FigRs
# Created by Gottfried Pestal (Solv Consulting Ltd.)
# Version 1 - September 14, 2012
###################################################

############################################################################

# custom function to imitate Excel's percentrank() function
perc.rank<-function(x){
	rank.x<-rank(x, ties.method="min")
	perc.rank.x <- (rank.x-1)/(max(rank.x)-1)
	perc.rank.x
	}

# example
perc.rank(c(1,3,2,4,5,6,7,3,44,5,22,3,3,44,56,90,876,2,0,0,123))



############################################################################

# custom function to plot percent ranks as deviations from median
perc.rank.plot<-function(x,ma=NULL,yrs.lab=c(1950,2010),type="fancy"){
# x is a time series stored in an array, with year labels as dim names
# ma specifies whether to plot a moving average. if ma is a number it defines the period for the avg
	
	if(type=="spark"){barplot(perc.rank(x)-0.5, ylim=c(-0.5,0.5),col="darkblue",border="darkblue", xlab="", ylab="",axes=FALSE,axisnames=FALSE)}


	if(type=="fancy"){
		x.ticks<-barplot(perc.rank(x)-0.5, ylim=c(-0.5,0.5),col="lightblue",border="lightblue", xlab="", ylab="",axes=FALSE,axisnames=FALSE)
		abline(h=c(-0.5,0,0.5),col="gray")
		text(rep(-3,3), c(-0.5,0,0.5),adj=1,labels=c("Min","Median","Max"),xpd=NA,cex=1.4)
		if(!is.null(ma)){lines(x.ticks,filter(perc.rank(x)-0.5,filter=rep(1/ma,ma) ,sides=1),col="red",lwd=2)}
		axis(side=1,at=x.ticks[seq(1,length(x.ticks),by=10)],labels = seq(yrs.lab[1],yrs.lab[2],10),cex.axis=1.4)
	} # end type=fancy
} # end perc.rank.plot




############################################################################



# custom function to plot time series
ts.plot<-function(x,y,xlim=c(1950,2010),grid=pretty(y,n=4),grid.label=TRUE, ma=NULL, minmaxpts=TRUE){
# ma specifies whether to plot a moving average. if ma is a number it defines the period for the avg
	# set the switch between writing full numbers and using scientific notation in labels
	options(scipen=3)
	# plot the time seris
	plot(x,y, xlim=xlim,ylim=c(min(grid),max(grid)),type="l",col="blue",axes=FALSE,xlab="",ylab="",lwd=1,xpd=TRUE)
	# add gridlines
	segments(x0=rep(xlim[1]+2,length(grid)) , y0=grid, x=rep(xlim[2],length(grid)) , y1=grid  ,col="grey",lty=2,xpd=TRUE)
	if(grid.label){text(x=rep(xlim[1]-1,length(grid)),y=grid,labels=prettyNum(grid,big.mark=","),cex=1.4, adj=1,xpd=TRUE)}
	# add year axis
	axis(side=1,at=seq(xlim[1],xlim[2],10),labels = seq(xlim[1],xlim[2],10),cex.axis=1.4)

	#calc and plot moving avg
	if(!is.null(ma)){lines(x, filter(y,filter=rep(1/ma,ma) ,sides=1),col="red",lwd=2,lty=1)}
	

	if(minmaxpts==TRUE){
		# calc, plot, and label max point
		points(x[y==max(y,na.rm=TRUE)],y[y==max(y,na.rm=TRUE)],col="dark blue",pch=21,bg="green",lwd=1.2, cex=2)
		text(x[y==max(y,na.rm=TRUE)],y[y==max(y,na.rm=TRUE)] ,labels=paste(prettyNum(round(y[y==max(y,na.rm=TRUE)],0),big.mark=",")," (",x[y==max(y,na.rm=TRUE)],")",sep=""),pos=2,cex=1.4)

		# calc, plot, and label min point
		points(x[y==min(y,na.rm=TRUE)],y[y==min(y,na.rm=TRUE)],col="dark blue",pch=21,bg="red",lwd=1.2, cex=2)
		text(x[y==min(y,na.rm=TRUE)],y[y==min(y,na.rm=TRUE)] ,labels=paste(prettyNum(round(y[y==min(y,na.rm=TRUE)],0),big.mark=",")," (",x[y==min(y,na.rm=TRUE)],")",sep=""),pos=2,cex=1.4)
		} # end if minmax pts =TRUE
} # end ts.plot function



############################################################################



# custom function to plot sensitivity ranges
sens.range.plot <- function(x,fig.labels=NULL,box.w=0.2,labels.cex=1){
 # x is an array with the following dimensions:
 #	    - one row for each scenario (i.e. suite of simulations)
 #	    - two columns: min and max outcome for each scenario
 #        - two (for now) layers with data for the two bars in each set      
 # labels is a list with the following parts: 
 #	    - pm for performance measure
 #        - barsets for the x-axis label below each set of bars
 #        - bars for the labels on each bar in the first set

 # NOTE: FOR NOW HANDLES ONLY PROBABILITY OUTPUT (0,1) FOR THE PERFORMANCE MEASURE
 # NOTE: FOR NOW HANDLES 2 BARS/SET

	num.bar.sets<-length(x[,1,1])
	if(is.null(fig.labels)){labels<-list(title="Title", pm="Performance Measure",barsets=dimnames(x)[[1]],bars=dimnames(x)[[3]])}
	if(!is.null(fig.labels)){labels<-fig.labels}
	plot(1:num.bar.sets,seq(0.2,1,0.2),bty="none",type="n",xlim=c(0.5,num.bar.sets+0.5),ylim=c(0,1), axes=FALSE,xlab="",ylab=labels$pm,cex.lab=labels.cex)

	axis(side=1,at=1:num.bar.sets,labels = labels$barsets ,cex.axis=labels.cex)
	axis(side=2,at=seq(0,1,0.2) ,labels = paste(seq(0,100,20),"%",sep="") ,cex.axis=0.95*labels.cex)

	rect((1:num.bar.sets)-box.w, x[,1,1], 1:num.bar.sets,x[,2,1], border="darkblue",col="lightgray", lwd=1) 
	rect((1:num.bar.sets), x[,1,2], (1:num.bar.sets)+box.w,x[,2,2], border="darkblue",lwd=1) 

	text(c(1-(box.w),1+(box.w)),c(max(x[1,,1]),max(x[1,,2]))+0.04,labels=labels$bars,xpd=TRUE,cex=labels.cex)
	title(main=labels$title,cex.main=1.5*labels.cex, line=1)

} # end sens.range.plot




############################################################################



#custom function to create bubble plot with path
bubbleplot <- function(x.vec,y.vec,radius.vec,current.pt,xrange,yrange,xlabel,ylabel,maintitle){
	plot(x.vec[current.pt],y.vec[current.pt],xlim=xrange, ylim=yrange,type="p",col="darkblue", xlab=xlabel,ylab=ylabel,bty="n",cex=1.2,cex.lab=1.6,cex.axis=1.6)
	symbols(x.vec[current.pt],y.vec[current.pt],radius.vec[current.pt],add=TRUE, inches=FALSE, pch=19,fg="darkgray",bg="lightgray",xpd=TRUE)
	points(x.vec[current.pt],y.vec[current.pt],pch=19,col="darkblue")
	lines(x.vec,y.vec,col="darkblue")
	title(main=maintitle,adj=0.2,cex.main=1.8)
} # end custom function bubbleplot



#