RGB2all.R

RGB2All<-function (data=RGB, R="R", G="G", B="B", name.ext="", deg.obs=2, illum="C"){

#Setting up variables in dataframe

data[[paste("X", name.ext, sep="")]]<-NA
data[[paste("Y", name.ext, sep="")]]<-NA
data[[paste("Z", name.ext, sep="")]]<-NA
data[[paste("L", name.ext, sep="")]]<-NA
data[[paste("a", name.ext, sep="")]]<-NA
data[[paste("b", name.ext, sep="")]]<-NA
data[[paste("C", name.ext, sep="")]]<-NA
data[[paste("H", 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
}


for (i in 1:length(data[[R]])){
if (is.na(data[[R]][i])) {
		#do nothing with it if it's NA
		print(paste("Row", i, "contains missing data.", sep=" "))
	} else {
	#RGB -> XYZ
	var_R <- ( data[[R]][i]/255)#R from 0 to 255
	var_G <- ( data[[G]][i]/255)#G from 0 to 255
	var_B <- ( data[[B]][i]/255)#B from 0 to 255
	
	if (var_R > 0.04045){
	 var_R <- ((var_R+0.055)/1.055)^2.4
	} else { (var_R <- var_R/12.92)
		}
	if (var_G > 0.04045) {
		var_G <- ((var_G+0.055)/1.055)^2.4
	} else {var_G <- var_G/12.92
		}
	if (var_B > 0.04045) {
		var_B <- ((var_B+0.055)/1.055)^2.4
	} else {var_B <- var_B/12.92
		}
	
	var_R <- var_R*100
	var_G <- var_G*100
	var_B <- var_B*100
	
	#Observer 2º, Illuminant D65
	data[[paste("X", name.ext, sep="")]][i] <- var_R * 0.4124 + var_G * 0.3576 + var_B * 0.1805
	data[[paste("Y", name.ext, sep="")]][i] <- var_R * 0.2126 + var_G * 0.7152 + var_B * 0.0722
	data[[paste("Z", name.ext, sep="")]][i]  <- var_R * 0.0193 + var_G * 0.1192 + var_B * 0.9505
	
	
	#XYZ-> CIE L*ab 
	var_X <- data[[paste("X", name.ext, sep="")]][i]/ref_X
	var_Y <- data[[paste("Y", name.ext, sep="")]][i]/ref_Y
	var_Z <- data[[paste("Z", name.ext, sep="")]][i]/ref_Z
	
	if ( var_X > 0.008856 ){
		var_X <- var_X^(1/3)
		} else {var_X <- ( 7.787 * var_X ) + ( 16 / 116 )
			}
	if ( var_Y > 0.008856 ){
		var_Y <- var_Y^(1/3)
		} else {var_Y <- ( 7.787 * var_Y ) + ( 16 / 116 )
			}
	if ( var_Z > 0.008856 ){
		var_Z <- var_Z^(1/3)
		} else {var_Z <- ( 7.787 * var_Z ) + ( 16 / 116 )
		}
	
	data[[paste("L", name.ext, sep="")]][i] <- ( 116 * var_Y ) - 16
	data[[paste("a", name.ext, sep="")]][i] <- 500 * ( var_X - var_Y )
	data[[paste("b", name.ext, sep="")]][i] <- 200 * ( var_Y - var_Z )
	
	
	#CIE L*ab -> CIE LCH
	#chroma
	data[[paste("C", name.ext, sep="")]][i] <- sqrt(data[[paste("a", name.ext, sep="")]][i]^2 + data[[paste("b", name.ext, sep="")]][i]^2)
	
	#Hue
	var_H <- atan2(data[[paste("b", name.ext, sep="")]][i], data[[paste("a", name.ext, sep="")]][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
	
	#RGB to HEX
	hex<-NA
	
	hex[1] <- '#';
	hex[2] <- HEXDIG[1+(data[[R]][i] / 16) %% 16];
	hex[3] <- HEXDIG[1+data[[R]][i] %% 16];
	hex[4] <- HEXDIG[1+(data[[G]][i] / 16) %% 16];
	hex[5] <- HEXDIG[1+data[[G]][i] %% 16];
	hex[6] <- HEXDIG[1+(data[[B]][i] / 16) %% 16];
	hex[7] <- HEXDIG[1+data[[B]][i] %% 16];
	
	data[[paste("Hex", name.ext, sep="")]][i]<-paste(hex, collapse="")
	}
	} #end loop
	return(data)
} #end function