#RMSE and CCC function

require(epiR)

RMSE <- function(k,l) {
     if(is.list(l)==TRUE) {iter <- length(l)} else {iter=1}
     for(i in 1:iter) {
	if(is.list(k)==TRUE) { o <- k[[i]]} else {o <- k}
	if(is.list(l)==TRUE) { p <- l[[i]]} else {p <- l}
	d <- data.frame(o, p)
	d$res=d$o-d$p
	d <- subset(d, is.na(d$res)==FALSE)
	o <- d$o
	p <- d$p
	res <- d$res
	meano <- mean(o, na.rm=TRUE)
	meanp <- mean(p, na.rm=TRUE)
	PMeanBias <- t.test(res)$p.value
	PMeanBias <- ifelse(PMeanBias < 0.0001, 0.0001, PMeanBias)
	PSlope <- anova(lm(res~p))[1,5]
	PSlope <- ifelse(PSlope < 0.0001, 0.0001, PSlope)
	res2=res^2;
	rm=sqrt(mean(res2, na.rm=TRUE));
	uss=sum(res2, na.rm=TRUE);
	lo <- ifelse(is.na(o)==FALSE, 1, 0)
	n=sum(lo);
	meano=mean(o, na.rm=TRUE);
	mb=sum(res, na.rm=TRUE)/n;
	sse <- anova(lm(res~p))[2,2];
	msb <- mb^2;
	mspe <- rm^2;
	msre <- sse/n;
	msslope <- mspe-msre-msb;
	mean <- msb/mspe*100;
	slope <- msslope/mspe*100;
	residual <- msre/mspe*100;
	check <- mean+slope+residual
	rsr <- rm/sd(o, na.rm=TRUE)
	ccc <- epi.ccc(o,p)$rho.c[1]
	rmp = rm/meano*100
	mb <- mean(res, na.rm=TRUE)
	sb <- coef(lm(res~p))[2]
	Values <- format(c(n, meano, meanp, rm, rmp, mean, slope, residual, mb, 
		sb, PMeanBias, PSlope, rsr, ccc[,1]), digits=4, scientific=FALSE)
	Statistic <- c("N", "Observed Mean", "Predicted Mean", "RMSE", "RMSE, % mean", 
		"Mean Bias, % MSE", "Slope Bias, % MSE", "Dispersion, % MSE", 
		"Mean Bias", "Slope Bias", "P-Mean Bias", "P-Slope Bias", "RSR", "CCC")
	if(i==1) {
		out <- data.frame(Statistic,Values)
	}
	else {
		out <- cbind(out, Values)
	}
     }
     return(out)
}