R/RcppExports.R

In FIACH: Retrospective Noise Control for fMRI

# This file was generated by Rcpp::compileAttributes
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

badData <- function(X, meds=NULL, mads=NULL, nMads=1.96, t=0) {
  calc<-FALSE
  X<-as.matrix(X)
  if(is.null(meds) | is.null(mads)){calc<-TRUE} 
  if(calc){meds<-colMedian(X);mads<-colMad(X)}  
  .Call('FIACH_badData', PACKAGE = 'FIACH', X, meds, mads, nMads, t)
}

colMad <- function(X) {
  X<-as.matrix(X)
  .Call('FIACH_colMad', PACKAGE = 'FIACH', X)
}

colMedian <- function(X) {
  X<-as.matrix(X)
  .Call('FIACH_colMedian', PACKAGE = 'FIACH', X)
}

colsd <- function(X) {
  X<-as.matrix(X)
  .Call('FIACH_colsd', PACKAGE = 'FIACH', X)
}

convolve1d <- function(x, fir, subtractMed = TRUE) {
  x<-as.matrix(x)
  N <- nrow(x)
  L <- length(fir)
  nconv <- N + L - 1
  Nfft <- nextn(nconv)
  .Call('FIACH_convolve1d', PACKAGE = 'FIACH', x, fir, Nfft, subtractMed)
}

fftN<-function(X,N=NULL) {
  X<-as.matrix(X)
  n<-nrow(X)
  if(is.null(N)){N<-nextn(n)}
  .Call('FIACH_fftN', PACKAGE = 'FIACH', X, N)
}

gmm <- function(x, k, imeans=NULL, isd = NULL, ilambda=NULL, print=FALSE, tol=1e-8, maxit = 1000L) {
  if(is.null(imeans)|is.null(isd)|is.null(ilambda)){
    imeans<-numeric(1)
    isd<-numeric(1)
    ilambda<-numeric(1)
    print("Some initial values were NULL: therefore random initial values were chosen")
  }
  ret<-.Call('FIACH_gmm', PACKAGE = 'FIACH', x, k, imeans, isd, ilambda, print, tol, maxit)
  ret$x<-x
  class(ret)<-"gmm"
  return(ret)
}

hampel <- function(x, k=3, t0=3) {
  x<-as.matrix(x)
  .Call('FIACH_hampel', PACKAGE = 'FIACH', x, k, t0)
}

pseudo <- function(x, y = NULL, residuals = FALSE, keepMean = FALSE,includeIntercept = TRUE) {
  x<-as.matrix(x)
  if (is.null(y)){y<-matrix(NA,1,1)}else{
    y<-as.matrix(y)
  }
  
  .Call('FIACH_pseudo', PACKAGE = 'FIACH', x, y, residuals, keepMean,includeIntercept)
}

rowMad <- function(X) {
  X<-as.matrix(X)
  .Call('FIACH_rowMad', PACKAGE = 'FIACH', X)
}

rowMedian <- function(X) {
  X<-as.matrix(X)
  .Call('FIACH_rowMedian', PACKAGE = 'FIACH', X)
}

rowsd <- function(X) {
  X<-as.matrix(X)
  .Call('FIACH_rowsd', PACKAGE = 'FIACH', X)
}

sepConvolve3d <- function(x, kernX, kernY, kernZ) {
  dims <- dim(x)
  if(length(dims)>4){stop("This function only accepts objects three or four dimensions")}
  if(length(dims)<3){stop("This function only accepts objects with three or four dimensions")}
  
  nconv <- dims[1:3] + c(length(kernX), length(kernY), length(kernZ)) - 1
  Nffts <- nextn(nconv)
  
  if(length(dims)==3){
    ret<-.Call('FIACH_sepConvolve3d', PACKAGE = 'FIACH', x, kernX, kernY, kernZ, Nx=Nffts[1], Ny=Nffts[2], Nz=Nffts[3])
  }else{
    ret<-array(dim = dims)
    for(i in 1:dims[4]){
      ret[,,,i]<-.Call('FIACH_sepConvolve3d', PACKAGE = 'FIACH', x[,,,i], kernX, kernY, kernZ, Nx=Nffts[1], Ny=Nffts[2], Nz=Nffts[3])  
    }
  }
  return(ret)
}


zeroNa <- function(input) {
  if(is.vector(input)){input<-as.matrix(input)}
  d<-dim(input)
  if(length(d)>4){stop("This function only accepts objects with less than five dimensions")}
  
  if(length(d)<=3){
  ret<-.Call('FIACH_zero_na', PACKAGE = 'FIACH', input)
  }else{
    ret<-array(dim = d)
    for(i in 1:d[4]){
    ret[,,,i]<-.Call('FIACH_zero_na', PACKAGE = 'FIACH', input[,,,i])  
    }
  }
  return(ret)
  }

dilate <- function(input, k) {
  if(is.vector(input)){input<-as.matrix(input)}
     
  .Call('FIACH_dilate', PACKAGE = 'FIACH', input, k)
}

erode <- function(input, k) {
  if(is.vector(input)){input<-as.matrix(input)}
  .Call('FIACH_erode', PACKAGE = 'FIACH', input, k)
}
.icombine<-function(X,dim){
  .Call('FIACH_icombine', PACKAGE = 'FIACH', X, dim)
}

.dcombine<-function(X,dim){
  .Call('FIACH_dcombine', PACKAGE = 'FIACH', X, dim)
}