R/utils.R

Defines functions .get_volume .check.map .fix.mask .cut.file.names .fix.names.neuR.data

#creo una paletta colori e la setto come deault
pal.uno=c("#445577","#ffcc00","#00A08A","#FF0000","#45abff")
palette(pal.uno)
####################

.get_volume <- function(D,map){
  if(is.character(map)) return(D@data[[map]]) else
    if(is.numeric(map)) return(map)
}

##################
.check.map<- function(obj,map){
  checks=sapply(map,function(m)   obj@info$nvoxels!=ncol(m))
  if(any(checks)) warning("maps: ",paste(names(map)[checks],sep=",")
                          , " have sizes different from ",paste(dim(obj),collapse="x"))
  checks=which(names(map)%in%names(obj@data))
  if(any(checks)) warning("maps: ",paste(names(map)[checks],sep=","), " already exist")
  map
}

####################
#     reading, check and cleaning the mask file
.fix.mask<- function(mask,D4=NULL){
  #se รจ un file name legge il file
  if(is.character(mask))
    mask=f.read.analyze.volume(mask)  
  #forza ad essere un array 3D prendendo le dim da D4
  if(!is.null(D4))
    mask=array(mask,dim(D4)[1:3]) else
      #oppure le sue stesse dim
      mask=array(mask,dim(mask)[1:3])
  mask
}



##########
.cut.file.names <-function(files,max.length=15){
  nms=sapply(files,function(x)
        substr(x,start=max(1,nchar(x)-max.length+1),
               stop=nchar(x)))
  names(nms)=NULL
  nms
}

##########
.fix.names.neuR.data <- function(D3,prefix2ndDim="v",prefix3rdDim="pc"){
  if(is.null(dimnames(D3))) dimnames(D3)[[1]]=list()
  if(is.list(D3)){
    lapply(D3,.fix.names.neuR.data)
  } else{
  if(is.null(dimnames(D3)[[1]])) 
      dimnames(D3)[[1]]=1:nrow(D3)
  if(is.null(dimnames(D3)[[2]])) 
    dimnames(D3)[[2]]=paste(prefix2ndDim,sep="",1:ncol(D3))
  if(is.null(dimnames(D3)[[3]])) 
    if(dim(D3)[3]>1) dimnames(D3)[[3]]=paste(prefix3rdDim,sep="",1:dim(D3)[3]) else dimnames(D3)[[3]] = ""
  }
  D3
}
livioivil/neuR documentation built on May 21, 2019, 6:43 a.m.