# TODO: Add comment
# 
# Author: E.Korsching Aug 9, 2013
###############################################################################


### according to HANDBOOK OF INTER-RATER RELIABILITY, THIRD EDITION, 2012 by K. Gwet, ISBN 978-0-9708062-7-7

	
generalized.kappa.Gwet <- function(x){
	# x: matrix/df : rows: subjects, cols: raters (institutions)
	#
}



## weights
# if character type categories/scores first assign numbers in appropriate way (see Gwet p61ff)

# Ordinal Weights
ordinal.weights <- function(x){
	# calculates a (quadratic) weight matrix: Ordinal Weights
	# input: an (ascending, matrix independent of order!) vector of integer values (ordinal categories)
	len.x <- length(x)		# number of elements
	if(len.x<2){ cat("\n at least a vector with two values expected"); break }
	mat <- matrix(0,len.x,len.x)	# initialize with 0
	dimnames(mat)[[1]] <- as.character(round(x,2))
	dimnames(mat)[[2]] <- as.character(round(x,2))
	# maximum value
	M.max <- choose( max(x)-min(x)+1 , 2)	# combinations: choose(n,k): k out of n
	# matrix values
	for(i in 1:len.x){		# row wise
		for(j in 1:len.x){
			M.ij <- choose( max(c(i,j))-min(c(i,j))+1 , 2 )
			mat[i,j] <- 1 - M.ij/M.max
		}
	}
	return(mat)
}
#ordinal.weights(x=c(1,2,3,4,5))

# Identity Weights (ordinal+interval)
identity.weights <- function(x){
	# calculates a (quadratic) weight matrix: Identity Weights (ordinal+interval)
	# input: an (good to order, but matrix adjust to order) vector of integer values (categories)
	len.x <- length(x)		# number of elements
	if(len.x<2){ cat("\n at least a vector with two values expected"); break }
	mat <- matrix(0,len.x,len.x)	# initialize with 0
	dimnames(mat)[[1]] <- as.character(round(x,2))
	dimnames(mat)[[2]] <- as.character(round(x,2))
	# matrix values
	for(i in 1:len.x){		# row wise
		for(j in 1:len.x){
			if(i!=j){
				mat[i,j] <- 0
			}else{	# i==j
				mat[i,j] <- 1
			}
		}
	}
	return(mat)
}
#identity.weights(x=c(1,2,3))

# Linear Weights, Quadratic Weights (ordinal+interval)
linear.weights <- function(x, type="l"){
	# calculates a (quadratic) weight matrix: Linear, Quadratic Weights (ordinal+interval)
	# input: an (good to order, but matrix adjust to order) vector of integer values (categories)
	# type: "l":linear, "q":quadratic
	len.x <- length(x)		# number of elements
	if(len.x<2){ cat("\n at least a vector with two values expected"); break }
	mat <- matrix(0,len.x,len.x)	# initialize with 0
	dimnames(mat)[[1]] <- as.character(round(x,2))
	dimnames(mat)[[2]] <- as.character(round(x,2))
	# maximum value
	for(i in 1:len.x){		# row wise
		for(j in 1:len.x){
			if(i!=j){
				mat[i,j] <- abs((x[i]-x[j]))
			}
		}
	}
	M.max <- max(mat)
	if(type=="l"){
		# matrix values
		for(i in 1:len.x){		# row wise
			for(j in 1:len.x){
				if(i!=j){
					mat[i,j] <- 1 - mat[i,j] / M.max
				}else{	# i==j
					mat[i,j] <- 1
				}
			}
		}
	}
	if(type=="q"){
		# maximum value
		M.max <- M.max^2
		# matrix values
		for(i in 1:len.x){		# row wise
			for(j in 1:len.x){
				if(i!=j){
					mat[i,j] <- 1 - mat[i,j]^2 / M.max
				}else{	# i==j
					mat[i,j] <- 1
				}
			}
		}
	}
	return(mat)
}
#linear.weights(x=c(1,2,3), type="l")
#linear.weights(x=c(1,2,3), type="q")

# Radical Weights (ordinal+interval)
radical.weights <- function(x){
	# calculates a (quadratic) weight matrix: Radical Weights (ordinal+interval)
	# input: an (good to order, but matrix adjust to order) vector of integer values (categories)
	len.x <- length(x)		# number of elements
	if(len.x<2){ cat("\n at least a vector with two values expected"); break }
	mat <- matrix(0,len.x,len.x)	# initialize with 0
	dimnames(mat)[[1]] <- as.character(round(x,2))
	dimnames(mat)[[2]] <- as.character(round(x,2))
	# maximum value
	for(i in 1:len.x){		# row wise
		for(j in 1:len.x){
			if(i!=j){
				mat[i,j] <- sqrt( abs((x[i]-x[j])) )
			}
		}
	}
	M.max <- max(mat)
	# matrix values
	for(i in 1:len.x){		# row wise
		for(j in 1:len.x){
			if(i!=j){
				mat[i,j] <- 1 - mat[i,j] / M.max
			}else{	# i==j
				mat[i,j] <- 1
			}
		}
	}
	return(mat)
}
#radical.weights(x=c(1,2,3))

# Ratio Weights
ratio.weights <- function(x){
	# calculates a (quadratic) weight matrix: Ratio Weights
	# input: an (good to order, but matrix adjust to order) vector of values (categories)
	len.x <- length(x)		# number of elements
	if(len.x<2){ cat("\n at least a vector with two values expected"); break }
	mat <- matrix(0,len.x,len.x)	# initialize with 0
	dimnames(mat)[[1]] <- as.character(round(x,2))
	dimnames(mat)[[2]] <- as.character(round(x,2))
	# maximum,minumum value
	M.min <- min(x)
	M.max <- max(x)
	M.denom <- ((M.max-M.min) / (M.max+M.min))^2
	# matrix values
	for(i in 1:len.x){		# row wise
		for(j in 1:len.x){
			mat[i,j] <- 1 - ( ( ((x[i]-x[j]) / (x[i]+x[j]))^2 ) / M.denom )
		}
	}
	return(mat)
}
#ratio.weights(x=c(1.1,2.9,7))

# Circular Weights
circular.weights <- function(x, type="d"){
	# calculates a (quadratic) weight matrix: Circular Weights
	#  start and end of scale are close together (circular)
	# input: an (good to order, but matrix adjust to order) vector of values (categories)
	# type: "d":degree, "r":radian measure
	len.x <- length(x)		# number of elements
	if(len.x<2){ cat("\n at least a vector with two values expected"); break }
	mat <- matrix(0,len.x,len.x)	# initialize with 0
	# if degrees convert to radian measure - trigonometric functions in R need radians
	if(type=="d"){
		y <- degrees.to.radians(meas=x, type="d")
		#
		dimnames(mat)[[1]] <- as.character(round(x,2))
		dimnames(mat)[[2]] <- as.character(round(x,2))
	}else{
		y <- x
		z <- degrees.to.radians(meas=x, type="r")
		#
		dimnames(mat)[[1]] <- as.character(round(z,2))		# matrix description always in degrees
		dimnames(mat)[[2]] <- as.character(round(z,2))
	}
	# maximum value
	x.min <- min(y)
	x.max <- max(y)
	U <- x.max-x.min+1			# ???? +1
	for(i in 1:len.x){		# row wise
		for(j in 1:len.x){
			if(i!=j){
				mat[i,j] <- ( sin( pi*(y[i]-y[j])/U ) )^2
			}
		}
	}
	M.max <- max(mat)
	# matrix values
	for(i in 1:len.x){		# row wise
		for(j in 1:len.x){
			mat[i,j] <- 1 - ( mat[i,j] / M.max )
		}
	}
	return(mat)
}
#circular.weights(x=c(1,2,3,4,5), type="r")
#circular.weights(x=c(17.19,88.81,180), type="d")
#circular.weights(x=c(0.3,1.55,3.1415), type="r")

# Bipolar Weights
bipolar.weights <- function(x){
	# calculates a (quadratic) weight matrix: Bipolar Weights
	#  start and end of scale are close together (circular)
	# input: an (good to order, but matrix adjust to order) vector of values (categories)
	# type: "d":degree, "r":radian measure
	len.x <- length(x)		# number of elements
	if(len.x<2){ cat("\n at least a vector with two values expected"); break }
	mat <- matrix(0,len.x,len.x)	# initialize with 0
	dimnames(mat)[[1]] <- as.character(round(x,2))
	dimnames(mat)[[2]] <- as.character(round(x,2))
	# maximum value
	x.min <- min(x)
	x.max <- max(x)
	for(i in 1:len.x){		# row wise
		for(j in 1:len.x){
			if(i!=j){
				mat[i,j] <- (x[i]-x[j])^2 / ( ((x[i]+x[j])-2*x.min)*(2*x.max-(x[i]+x[j])) )
			}
		}
	}
	M.max <- max(mat)
	# matrix values
	for(i in 1:len.x){		# row wise
		for(j in 1:len.x){
			mat[i,j] <- 1 - ( mat[i,j] / M.max )
		}
	}
	return(mat)
}
#bipolar.weights(x=c(1,2,3,4,5))