inst/doc/adaptation.R

In spacesXYZ: CIE XYZ and some of Its Derived Color Spaces

## ----setup, include=FALSE-------------------------------------------------------------------------
knitr::opts_chunk$set(echo = TRUE)
options( width=100 )

## ---- echo=TRUE, message=FALSE--------------------------------------------------------------------
library( spacesXYZ )

## ---- echo=TRUE, message=FALSE--------------------------------------------------------------------
Ma = CAT( source='A', target='D65', method='bradford' )$Ma ;  Ma

## ---- echo=TRUE, message=FALSE--------------------------------------------------------------------
rowSums( Ma )

## ---- echo=TRUE, message=FALSE--------------------------------------------------------------------
theCAT	= CAT( source='A', target='D65', method='bradford' )
A  =  standardXYZ('A')
A %*% t(theCAT$M) - standardXYZ('D65')

## ---- echo=TRUE, message=TRUE---------------------------------------------------------------------
identical(  adaptXYZ( theCAT, A ), A %*% t(theCAT$M) )

## ---- echo=TRUE, message=TRUE---------------------------------------------------------------------
rowSums( CAT( source='A', target='D65', method='MCAT02' )$Ma )

## ---- echo=TRUE, message=TRUE---------------------------------------------------------------------
rowSums( CAT( source='A', target='D65', method='vonKries' )$Ma )

## ---- echo=TRUE, message=TRUE---------------------------------------------------------------------
whiteA = standardXYZ("A")[1, ]  ;  whiteB = standardXYZ("B")[1, ]
theCAT = CAT( whiteA, whiteB, method='MCAT02' )
T   = theCAT$M ; Ma = theCAT$Ma
res = eigen( t(T) )
X   = t(res$vectors)  ;  X = diag( 1 / rowSums(X) ) %*% X  # X is 'first cut' at the unknown Ma

## ---- echo=TRUE, message=TRUE---------------------------------------------------------------------
Ma ; X

## ---- echo=TRUE, message=TRUE---------------------------------------------------------------------
as.numeric(Ma %*% whiteB / Ma %*% whiteA) ; res$values

## ---- echo=TRUE, message=TRUE---------------------------------------------------------------------
perm = order( Ma %*% whiteB / Ma %*% whiteA,  decreasing=TRUE )  ; perm

## ---- echo=TRUE, message=TRUE---------------------------------------------------------------------
perm = order(perm) ; perm   
res$values[perm]
X = X[perm, ]  ;  X  ;  max( abs(X - Ma) )

## ---- echo=FALSE, results='asis'------------------------------------------------------------------
sessionInfo()