R/sim.R

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
sim <-
function(x, which.ones=NULL)
{
  if(NROW(x)==1){
    x.is.scalar <- TRUE
    n <- x
    if(is.null(which.ones)){
      where.indicators <- 2:n
    }else{
      where.indicators <- which.ones
    }
  }else{
    x.is.scalar <- FALSE
    n <- NROW(x)
    x <- as.zoo(x)
    x.index <- index(x)
    xIsRegular <- is.regular(x, strict=TRUE)
    if(xIsRegular && frequency(x)>1 ){
      xIndexObs <- floor(as.numeric(x.index))
      xCycle <- as.numeric(cycle(x))
      xIndexAsChar <- paste(xIndexObs, "(", xCycle, ")", sep="")
      xFrequency <- frequency(x)
    }else{
      xIndexAsChar <- as.character(x.index)
    }
    if(is.null(which.ones)){
      where.indicators <- 2:n
    }else{
      where.indicators <- which(x.index %in% which.ones)
      if(length(where.indicators)==0) stop("'which.ones' not in index")
    } #end if(is.null(which.ones))
  } #end if(NROW(x)==1)else(..)

  n.where.indicators <- length(where.indicators)
  loop.indx <- 1:n.where.indicators
  mSIS <-matrix(0,n,n.where.indicators)
  tmp <- function(i){ mSIS[ c(where.indicators[i]:n) ,i] <<- 1 }
  tmp <- sapply(loop.indx,tmp)
  if(x.is.scalar){
    colnames(mSIS) <- paste("sis", where.indicators, sep="")
    mSIS <- as.zoo(mSIS)
  }else{
    colnames(mSIS) <- paste("sis",
      xIndexAsChar[where.indicators], sep="")
    if(xIsRegular && frequency(x)>1 ){
      mSIS <- zooreg(mSIS, frequency=xFrequency,
        start=c(xIndexObs[1],xCycle[1]))
    }else{
      mSIS <- zoo(mSIS, order.by=x.index)
    }
  }
  return(mSIS)
}

Questions? Problems? Suggestions? or email at ian@mutexlabs.com.

Please suggest features or report bugs with the GitHub issue tracker.

All documentation is copyright its authors; we didn't write any of that.