interpPairs: interpolate between pairs of vectors in a list

Description

This does two things:

Computes a .proportion interpolation between pairs by passing each pair with .proportion to interpChar. interpChar does standard linear interpolation with numerics and interpolates based on the number of characters with non-numerics.
Discards rows of interpolants for which .proportion is outside validProportion. If object is a list, corresponding rows of other vectors of the same length are also discarded.

NOTE: There are currently discrepancies between the documentation and the code over defaults when one but not both elements of a pair are provided. The code returns an answer. If that's not acceptable, provide the other half of the pair. After some experience is gathered, the question of defaults will be revisited and the code or the documentation will change.

Usage

interpPairs(object, ...) 
# S3 method for call
interpPairs(object, 
    nFrames=1, iFrame=nFrames, 
    endFrames=round(0.2*nFrames), 
    envir = parent.frame(), 
    pairs=c('1'='\\.0$', '2'='\\.1$', replace0='', 
                replace1='.2', replace2='.3'),     
    validProportion=0:1, message0=character(0), ...)
# S3 method for function
interpPairs(object, 
    nFrames=1, iFrame=nFrames, 
    endFrames=round(0.2*nFrames), 
    envir = parent.frame(), 
    pairs=c('1'='\\.0$', '2'='\\.1$', replace0='', 
                replace1='.2', replace2='.3'),     
    validProportion=0:1, message0=character(0), ...)
# S3 method for list
interpPairs(object, 
    .proportion, envir=list(), 
        pairs=c('1'='\\.0$', '2'='\\.1$', replace0='', 
                replace1='.2', replace2='.3'),     
        validProportion=0:1, message0=character(0), ...)

Arguments

object

A call, function, list or data.frame with names possibly matching pairs[1:2].

When names matching both of pairs[1:2], they are converted to potentially common names using sub(pairs[i], pairs[3], ...). When matches are found among the potentially common names, they are passed with .proportion to interpChar to compute an interpolation. The matches are removed and replaced with the interpolant, shortened by excluding any rows for which .proportion is outside validProportion.

Elements with "common names" that do not have a match are replaced by elements with the common names that have been shortened by omitting rows with .proportion outside validProportion. Thus, if x.0 is found without x.1, x.0 is removed and replaced by x.

nFrames

number of distinct plots to create.

iFrame

integer giving the index of the single frame to create. Default = nFrames.

An error is thrown if both iFrame and .proportion are not NULL.

endFrames

Number of frames to hold constant at the end.

.proportion

a numeric vector assumed to lie between 0 and 1 specifying how far to go from suffixes[1] to suffixes[2]. For example, if x.0 and x.1 are found and are numeric, x = x.0 + .proportion * (x.1 - x.0). Rows of x and any other element of object of the same length are dropped for any .proportion outside validProportion.

An error is thrown if both iFrame and .proportion are not NULL.

envir

environment / list to use with codeobject, which can optionally provide other variables to compute what gets plotted; see the example below using this argument.

pairs

a character vector of two regular expressions to identify elements of object between which to interpolate and three replacements.

(1) The first of the three replacements is used in sub to convert each pairs[1:2] name found to the desired name of the interpolate. Common names found are then passed with .proportion to interpChar, which does the actual interpolation.

(2, 3) interpPairs also calls checkNames(object, avoid = pairs[c(1, 3, 2, 5)]). This confirms that object has names, and all such names are unique. If object does not have names or has some duplicate names, the make.names is called to fix that problem, and any new names that match pairs[1:2] are modified using sub to avoid creating a new match. If the modification still matches pairs[1:2], it generates an error.

validProportion

Range of values of .proportion to retain, as noted with the discussion of the object argument.

message0

a character string passed to interpChar to improve the value of diagnostic messages

…

optional arguments for sub

Value

a list with elements containing the interpolation results.

Details

*** FUNCTION ***

First interpPairs.function looks for arguments firstFrame, lastFrame, and Keep. If any of these are found, they are stored locally and removed from the function. If iFrame is provided, it is used with with these arguments plus nFrames and endFrames to compute .proportion.

If .proportion is outside validProportion, interpPairs does nothing, returning enquote(NULL).

If any(.proportion) is inside validProportion, interpPairs.function next uses grep to look for arguments with names matching pairs[1:2]. If any are found, they are passed with .proportion to interpChar. The result is stored in the modified object with the common name obtained from sub(pairs[i], pairs[3], ...), i = 1, 2.

The result is then evaluated and then returned.

*** LIST ***

1. ALL.OUT: if(none(0<=.proportion<=1))return 'no.op' = list(fun='return', value=NULL)

2. FIND PAIRS: Find names matching pairs[1:2] using grep. For example, names like x.0 match the default pairs[1], and names like x.1 match the default pairs[1].

3. MATCH PAIRS: Use sub(pairs[i], pairs[3], ...) for i = 1:2, to translate each name matching pairs[1:2] into something else for matching. For example, he default pairs thus translates, e.g., x.0 and x.1 both into x. In the output, x.0 and x.1 are dropped, replaced by x = interpChar(x.0, x.1, .proportion, ...). Rows with .proportion outside validProportion are dropped in x. Drop similar rows of any numeric or character vector or data.frame with the same number of rows as x or .proportion.

4. Add component .proportion to envir to make it available to eval any language component of object in the next step.

5. Loop over all elements of object to create outList, evaluating any expressions and computing the desired interpolation using interpChar. Computing xleft in this way allows xright to be specified later as quote(xleft + xinch(0.6)), for example. This can be used with a call to rasterImageAdj.

6. Let N = the maximum number of rows of elements of outList created by interpolation in the previous step. If .proportion is longer, set N = length(.proportion). Find all vectors and data.frames in outList with N rows and delete any rows for which .proportion is outside validProportion.

7. Delete the raw pairs found in steps 1-3, retaining the element with the target name computed in steps 4 and 5 above. For other elements of object modified in the previous step, retain the shortened form. Otherwise, retain the original, unevaluated element.

Examples

Run this code

# NOT RUN {
###
###
### 1.  interpPairs.function
###
###

##
## 1.1.  simple 
##
plot0 <- quote(plot(0))
plot0. <- interpPairs(plot0)
# check 
# }
# NOT RUN {
all.equal(plot0, plot0.)
# }
# NOT RUN {
##
## 1.2.  no op 
##
noop <- interpPairs(plot0, iFrame=-1)
# check
# }
# NOT RUN {
all.equal(noop, enquote(NULL))
# }
# NOT RUN {
##
## 1.3.  a more typical example
## example function for interpPairs 
tstPlot <- function(){
  plot(1:2, 1:2, type='n')
  lines(firstFrame=1:3, 
        lastFrame=4, 
        x.1=seq(1, 2, .5), 
        y.1=x, 
        z.0=0, z.1=1, 
        txt.1=c('CRAN is', 'good', '...'), 
        col='red')
}
tstbo <- body(tstPlot)
iPlot <- interpPairs(tstbo[[2]])
# check 
iP <- quote(plot(1:2, 1:2, type='n'))
# }
# NOT RUN {
all.equal(iPlot, iP)
# }
# NOT RUN {
iLines <- interpPairs(tstbo[[3]], nFrames=5, iFrame=2)
# check:  
# .proportion = (iFrame-firstFrame)/(lastFrame-firstFrame)
#  = c(1/3, 0, -1/3)
# }
# NOT RUN {
<!-- %# if x.0 = x.1 and y.0 = y.1 by default  -->
# }
# NOT RUN {
<!-- %iL <- quote(lines(x=c(1, 1.5), y=c(1, 1.5),  -->
# }
# NOT RUN {
<!-- %                  z=c(1/3, 0),  -->
# }
# NOT RUN {
<!-- %                  txt=c('CR', '') )) -->
# }
# NOT RUN {
# if x.0 = 0 and y.0 = 0 by default:  
iL <- quote(linex(x=c(1/3, 0), y=c(1/9, 0), z=c(1/3, 0), 
           tst=c('CR', '')))
##
##**** This example seems to give the wrong answer
##**** 2014-06-03:  Ignore for the moment 
##           
# }
# NOT RUN {
<!-- %\dontshow{stopifnot(} -->
# }
# NOT RUN {
#all.equal(iLines, iL)
# }
# NOT RUN {
<!-- %\dontshow{)} -->
# }
# NOT RUN {
##
## 1.4.  Don't throw a cryptic error with NULL 
##
ip0 <- interpPairs(quote(text(labels.1=NULL)))
  
  
###
###
### 2.  interpPairs.list
###
###

##
## 2.1.  (x.0, y.0, x.1, y.1) -> (x,y)
##
tstList <- list(x.0=1:5, y.0=5:9, y.1=9:5, x.1=9,
                ignore=letters, col=1:5)
xy <- interpPairs(tstList, 0.1)
# check 
xy. <- list(ignore=letters, col=1:5, 
            x=1:5 + 0.1*(9-1:5), 
            y=5:9 + 0.1*(9:5-5:9) )
# New columns, 'x' and 'y', come after 
# columns 'col' and 'ignore' already in tstList 
# }
# NOT RUN {
all.equal(xy, xy.)
# }
# NOT RUN {
##
## 2.2.  Select the middle 2:  
##      x=(1-(0,1))*3:4+0:1*0=(3,0)
##
xy0 <- interpPairs(tstList[-4], c(-Inf, -1, 0, 1, 2) )
# check 
xy0. <- list(ignore=letters, col=3:4, x=c(3,0), y=7:6)

# }
# NOT RUN {
all.equal(xy0, xy0.)
# }
# NOT RUN {
##
## 2.3.  Null interpolation because of absence of y.1 and x.0  
##
xy02 <- interpPairs(tstList[c(2, 4)], 0.1)
# check 
#### NOT the current default answer;  revisit later.  
xy02. <- list(y=5:9, x=9)

# NOTE:  length(x) = 1 = length(x.1) in testList
# }
# NOT RUN {
<!-- %\dontshow{stopifnot(} -->
# }
# NOT RUN {
#all.equal(xy02, xy02.)
# }
# NOT RUN {
<!-- %\dontshow{)} -->
# }
# NOT RUN {
##
## 2.4.  Select an empty list (make sure this works)
##
x0 <- interpPairs(list(), 0:1)
# check 
x0. <- list()
names(x0.) <- character(0)
# }
# NOT RUN {
all.equal(x0, x0.)
# }
# NOT RUN {
##
## 2.5.  subset one vector only 
##
xyz <- interpPairs(list(x=1:4), c(-1, 0, 1, 2))
# check 
xyz. <- list(x=2:3)
# }
# NOT RUN {
all.equal(xyz, xyz.)
# }
# NOT RUN {
##
## 2.6.  with elements of class call
##
xc <- interpPairs(list(x=1:3, y=quote(x+sin(pi*x/6))), 0:1)
# check
xc. <- list(x=1:3, y=quote(x+sin(pi*x/6)))
# }
# NOT RUN {
all.equal(xc, xc.)
# }
# NOT RUN {
##
## 2.7. text
##
#  2 arguments 
j.5 <- interpPairs(list(x.0='', x.1=c('a', 'bc', 'def')), 0.5)
# check  
j.5. <- list(x=c('a', 'bc', ''))
# }
# NOT RUN {
all.equal(j.5, j.5.)
# }
# NOT RUN {
##
##  2.8.  text, 1 argument as a list 
##
j.50 <- interpPairs(list(x.1=c('a', 'bc', 'def')), 0.5)
# check  
# }
# NOT RUN {
all.equal(j.50, j.5.)
# }
# NOT RUN {
##
## 2.9.  A more complicated example with elements to eval
##
logo.jpg <- paste(R.home(), "doc", "html", "logo.jpg",
                  sep = .Platform$file.sep)
if(require(jpeg)){
  Rlogo <- try(readJPEG(logo.jpg))
  if(!inherits(Rlogo, 'try-error')){
# argument list for a call to rasterImage or rasterImageAdj   
    RlogoLoc <- list(image=Rlogo,
      xleft.0 = c(NZ=176.5,CH=172,US=171,  
                  CN=177,RU= 9.5,UK= 8),
      xleft.1 = c(NZ=176.5,CH=  9,US=-73.5,
                  CN=125,RU= 37, UK= 2),
      ybottom.0=c(NZ=-37,  CH=-34,US=-34,  
                  CN=-33,RU= 48, UK=47),
      ybottom.1=c(NZ=-37,  CH= 47,US= 46,  
                  CN= 32,RU=55.6,UK=55),
      xright=quote(xleft+xinch(0.6)),
      ytop = quote(ybottom+yinch(0.6)),
      angle.0 =0,
      angle.1 =c(NZ=0,CH=3*360,US=5*360, 
                 CN=2*360,RU=360,UK=360)
    )

    RlogoInterp <- interpPairs(RlogoLoc, 
            .proportion=rep(c(0, -1), c(2, 4)) )
# check 
# }
# NOT RUN {
  all.equal(names(RlogoInterp), 
      c('image', 'xright', 'ytop', 
        'xleft', 'ybottom', 'angle'))
# }
# NOT RUN {
# NOTE:  'xleft', and 'ybottom' were created in interpPairs, 
# and therefore come after 'xright' and 'ytop', which were 
# already there.  

##
## 2.10.  using envir
##
    RlogoDiag <- list(x0=quote(Rlogo.$xleft), 
                  y0=quote(Rlogo.$ybottom), 
                  x1=quote(Rlogo.$xright), 
                  y1=quote(Rlogo.$ytop) ) 

    RlogoD <- interpPairs(RlogoDiag, .p=1, 
                    envir=list(Rlogo.=RlogoInterp) ) 
# }
# NOT RUN {
<!-- %  RlogoD. <- RlogoInterp[c('xleft', 'ybottom', 'xright', 'ytop')] -->
# }
# NOT RUN {
<!-- %  names(RlogoD.) <- c('x0', 'y0', 'x1', 'y1') -->
# }
# NOT RUN {
    all.equal(RlogoD, RlogoDiag)
# }
# NOT RUN {
  }
}
##
## 2.11.  assign;  no interp but should work   
##
tstAsgn <- as.list(quote(op <- (1:3)^2))
intAsgn <- interpPairs(tstAsgn, 1)

# check 
intA. <- tstAsgn 
names(intA.) <- c('X', 'X.3', 'X.2')
# }
# NOT RUN {
all.equal(intAsgn, intA.)
# }
# NOT RUN {
#   op <- par(...)
tstP <- quote(op <- par(mar=c(5, 4, 2, 2)+0.1))
tstPar <- as.list(tstP)
intPar <- interpPairs(tstPar, 1)

# check 
intP. <- list(quote(`<-`), quote(op), 
              quote(par(mar=c(5, 4, 2, 2)+0.1)) )
names(intP.) <- c("X", 'X.3', 'X.2')
# }
# NOT RUN {
all.equal(intPar, intP.)
# }
# NOT RUN {
intP. <- interpPairs(tstP)
# }
# NOT RUN {
all.equal(intP., tstP)
# }
# NOT RUN {
##
## NULL 
## 
# }
# NOT RUN {
all.equal(interpPairs(NULL), quote(NULL)) 
# }

Run the code above in your browser using DataLab