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()