lab2all.R

Lab2All<-function(data=Lab, L="L", a="a", b="b", name.ext="", deg.obs=2, illum="C"){

#Setting up variables in dataframe
data[[paste("C", name.ext, sep="")]]<-NA
data[[paste("H", name.ext, sep="")]]<-NA
data[[paste("X", name.ext, sep="")]]<-NA
data[[paste("Y", name.ext, sep="")]]<-NA
data[[paste("Z", name.ext, sep="")]]<-NA
data[[paste("R", name.ext, sep="")]]<-NA
data[[paste("G", name.ext, sep="")]]<-NA
data[[paste("B", name.ext, sep="")]]<-NA
data[[paste("Hex", name.ext, sep="")]]<-NA
HEXDIG<-c('0', '1', '2', '3', '4', '5', '6', '7',
    '8', '9', 'A', 'B', 'C', 'D', 'E', 'F')

#tristimulus values in dataframe
tristim<-structure(list(deg.observer = c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L), illuminant = structure(c(1L, 
2L, 3L, 4L, 5L, 6L, 8L, 9L, 7L, 1L, 2L, 3L, 4L, 5L, 6L, 8L, 9L, 
7L), .Label = c("A", "C", "D50", "D55", "D65", "D75", "F11", 
"F2", "F7"), class = "factor"), X = c(109.85, 98.074, 96.422, 
95.682, 95.047, 94.972, 99.187, 95.044, 100.966, 111.144, 97.285, 
96.72, 95.799, 94.811, 94.916, 103.28, 95.792, 103.866), Y = c(100L, 
100L, 100L, 100L, 100L, 100L, 100L, 100L, 100L, 100L, 100L, 100L, 
100L, 100L, 100L, 100L, 100L, 100L), Z = c(35.585, 118.232, 82.521, 
92.149, 108.883, 122.638, 67.395, 108.755, 64.37, 35.2, 116.145, 
81.427, 90.926, 107.304, 120.641, 69.026, 107.687, 65.627)), .Names = c("deg.observer", 
"illuminant", "X", "Y", "Z"), class = "data.frame", row.names = c(NA, 
-18L))

#checking illuminant and degree observer for validity
#and saving reference values used for further calculations
#defaults are for Minolta Colorimeter CR series
if (!deg.obs %in% tristim$deg.observer){
	print("You've entered an invalid Observer angle. Please enter 2 or 10 and try again.")
} else if (!illum %in% tristim$illuminant){
	print("You've entered an invalid Illuminant. Please enter A, C, D50, D55, D65, D75, F2, F7, F11 in quotes and try again.")	
} else {
	ref_X<-subset(tristim, deg.observer==deg.obs & illuminant==illum)$X
	ref_Y<-subset(tristim, deg.observer==deg.obs & illuminant==illum)$Y
	ref_Z<-subset(tristim, deg.observer==deg.obs & illuminant==illum)$Z
}

#all formulas derived from easyRGB.com

#CIE L*ab -> XYZ
for (i in 1:length(data[[L]])){
	if (is.na(data[[L]][i])) {
		#do nothing with it if it's NA
		print(paste("Row", i, "contains missing data.", sep=" "))
	} else {
	#CIE L*ab -> CIE LCH
	#chroma
	data[[paste("C", name.ext, sep="")]][i] <- sqrt(data[[a]][i]^2 + data[[b]][i]^2)
	
	#Hue
	var_H <- atan2(data[[b]][i],data[[a]][i]) #Quadrant by signs
	
	if (var_H>0){
		var_H<-(var_H/pi)*180
		} else {
			var_H<-360-(abs(var_H)/pi)*180
			}
			
	data[[paste("H", name.ext, sep="")]][i]<-var_H

		

#CIE L*ab -> XYZ
		var_Y = ((data[[L]][i])+16)/116
		
		var_X = (data[[a]][i]) / 500 + var_Y
		
		var_Z = var_Y-(data[[b]][i])/200
				
		if ( var_Y^3 > 0.008856 ) {
			var_Y = var_Y^3
		} else {
			var_Y = ( var_Y - 16 / 116 ) / 7.787
			}
		if ( var_X^3 > 0.008856 ) {
			var_X = var_X^3
		} else {
			var_X = ( var_X - 16 / 116 ) / 7.787
		}
		if ( var_Z^3 > 0.008856 ) {
			var_Z = var_Z^3
		} else {
			var_Z = ( var_Z - 16 / 116 ) / 7.787
		}
		
		data[[paste("X", name.ext, sep="")]][i] = ref_X * var_X
		data[[paste("Y", name.ext, sep="")]][i] = ref_Y * var_Y
		data[[paste("Z", name.ext, sep="")]][i] = ref_Z * var_Z
		
	
	#XYZ -> RGB
		var_X = data[[paste("X", name.ext, sep="")]][i] / 100
		var_Y = data[[paste("Y", name.ext, sep="")]][i] / 100
		var_Z = data[[paste("Z", name.ext, sep="")]][i] / 100
		
		var_R = var_X * 3.2406 + var_Y * -1.5372 + var_Z * -0.4986
		var_G = var_X * -0.9689 + var_Y * 1.8758 + var_Z *  0.0415
		var_B = var_X * 0.0557 + var_Y * -0.2040 + var_Z *  1.0570
		
		if ( var_R > 0.0031308 ){
			var_R = 1.055 * ( var_R ^ ( 1 / 2.4 ) ) - 0.055
		} else if ( var_R <= 0) {
			var_R = 0
		} else {
			var_R = 12.92 * var_R
		}
		if ( var_G > 0.0031308 ) {
			var_G = 1.055 * ( var_G ^ ( 1 / 2.4 ) ) - 0.055
		} else if ( var_G <= 0) {
			var_G = 0
		} else {
			var_G = 12.92 * var_G
		}
		if ( var_B > 0.0031308 ) {
			var_B = 1.055 * ( var_B ^ ( 1 / 2.4 ) ) - 0.055
		} else if ( var_B <= 0){
			var_B = 0
		} else {
			var_B = 12.92 * var_B
		}
		
		data[[paste("R", name.ext, sep="")]][i] = var_R * 255
		data[[paste("G", name.ext, sep="")]][i] = var_G * 255
		data[[paste("B", name.ext, sep="")]][i] = var_B * 255	
	
		
	#RGB to HEX
		hex<-NA
		
		hex[1] <- '#';
		hex[2] <- HEXDIG[1+((round(data[[paste("R", name.ext, sep="")]][i]) / 16) %% 16)];
		hex[3] <- HEXDIG[1+(round(data[[paste("R", name.ext, sep="")]][i]) %% 16)];
		hex[4] <- HEXDIG[1+((round(data[[paste("G", name.ext, sep="")]][i]) / 16) %% 16)];
		hex[5] <- HEXDIG[1+(round(data[[paste("G", name.ext, sep="")]][i]) %% 16)];
		hex[6] <- HEXDIG[1+((round(data[[paste("B", name.ext, sep="")]][i]) / 16) %% 16)];
		hex[7] <- HEXDIG[1+(round(data[[paste("B", name.ext, sep="")]][i]) %% 16)];
		
		data[[paste("Hex", name.ext, sep="")]][i]<-paste(hex, collapse="")
	}
	} #end loop
	return(data)
} #end function