Created
March 15, 2018 18:02
-
-
Save bhive01/24c34db4dc7b459141e9bbb28e3997c1 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment