# R/displayFunctions.R In arf3DS4: Activated Region Fitting, fMRI data analysis (3D).

```#############################################
# arf3DS4 S4 DISPLAY FUNCTIONS				#
# Wouter D. Weeda							#
# University of Amsterdam					#
#############################################

#[CONTAINS]
#makeColors
#sliceColor
#makeDiscreteImage
#newprogressElement
#writeProgress

makeDiscreteImage <-
function(datavec,zerotol=1e-03)
#make a discritezed image of a datavector (divide into steps relative to zero-point)
{
#define maxsteps
maxsteps = 64

datavec[abs(datavec)<zerotol]=0

wzero = datavec[-which(datavec==0)]

if(length(which(wzero[wzero>0]>0))) pos_small = min(wzero[wzero>0]) else pos_small = 0
if(length(which(wzero[wzero<0]>0))) neg_small = min(abs(wzero[wzero<0])) else neg_small = 0

max_dat = max(datavec)
min_dat = min(datavec)
total = abs(min_dat)+abs(max_dat)

possteps = round(maxsteps*(abs(max_dat)/total))
negsteps = round(maxsteps*(abs(min_dat)/total))

pos_data = datavec[datavec>0]
neg_data = datavec[datavec<0]

if(max_dat>0 & min_dat<0) {
pq = quantile(pos_data,probs=seq(0,1,1/possteps)[-1])
nq = quantile(neg_data,probs=seq(1,0,-1/negsteps)[-1])
}

if(max_dat>0 & min_dat>=0) {
possteps = maxsteps
pq = quantile(pos_data,probs=seq(0,1,1/possteps)[-1])
nq = numeric(0)
}

if(max_dat<=0 & min_dat<0) {
negsteps = maxsteps
nq = quantile(neg_data,probs=seq(1,0,-1/maxsteps)[-1])
pq = numeric(0)
}

if(max_dat==0 & min_dat==0) {
nq = numeric(0)
pq = numeric(0)
}

newdata=rep(NA,length(datavec))

if(length(pq)>0) newdata[datavec>0 & datavec<pq[1]]=1
if(length(nq)>0) newdata[datavec<0 & datavec>nq[1]]=-1

if(length(pq)>0) for(i in 1:possteps) newdata[datavec>=pq[i]]=i+1
if(length(nq)>0) for(i in 1:negsteps) newdata[datavec<=nq[i]]=-i-1

newdata[datavec==0]=0

return(list(newdata=newdata,minmax=c(min_dat,max_dat),small=c(pos_small,neg_small)))

}

makeColors <-
function(datavec,gray=FALSE)
## make colors for overlay images, input is a discretized image
{
datasort = sort(unique(datavec))

neg_dat = datasort[datasort<0]
pos_dat = datasort[datasort>0]

if(gray) {
pos_col = gray(seq(0,1,1/length(pos_dat))[-1])
neg_col = gray(seq(1,0,-1/length(neg_dat))[-length(seq(1,0,-1/length(neg_dat)))])
zero_col = gray(0)
} else {
pos_col <- rgb(1,seq(0,1,1/length(pos_dat))[-1],0)
neg_col <- rgb(seq(.5,0,-.5/length(neg_dat))[-1],seq(.5,0,-.5/length(neg_dat))[-1],1)
zero_col <- rgb(0,0,0)
}

colvec <-c(neg_col,zero_col,pos_col)

neg = matrix(NA,2,length(neg_col))
pos = matrix(NA,2,length(pos_col))

neg[1,]=neg_dat
neg[2,]=neg_col
pos[1,]=pos_dat
pos[2,]=pos_col

return(list(pos=pos,neg=neg,colvec=colvec,data=c(neg_dat,0,pos_dat)))

}

sliceColor <-
function(slicedata,colors)
## calculate the colorvector for the discretized slice based on an makeColor object.
{

slice_max = max(slicedata)
slice_min = min(slicedata)

mp = which(as.numeric(colors\$pos[1,])<slice_max)
mn = which(as.numeric(colors\$neg[1,])<=slice_min)

colvec_pos = colors\$pos[2,mp]
colvec_neg = colors\$neg[2,-mn]

colvec=c(colvec_neg,rgb(0,0,0),colvec_pos)

return(colvec)

}

newProgressElement <-
function(arfmodel,options,lower,upper)
#make a new Progress Window, return an object of class progress (S3)
{
if(.options.output.mode(options)=='none') {
disabled = T
} else {
disabled = F
##library(tcltk)
}

if(!disabled) {
tt <- tktoplevel()
mt = .model.modeltype(arfmodel)
nr = .model.regions(arfmodel)
tktitle(tt) <- paste('ARF Progress [ ',mt,' @ ',nr,' ]',sep='')
scr <- tkscrollbar(tt, repeatinterval=5,command=function(...)tkyview(txt,...))
txt <- tktext(tt,bg="white",font="courier",yscrollcommand=function(...)tkset(scr,...),height=50,width=45)
tkgrid(txt,scr)
tkgrid.configure(scr,sticky="ns")

tkinsert(txt,"end",paste('ARF [',.model.name(arfmodel),'] ',as.character(Sys.time()),sep=''))
tkconfigure(txt, state="disabled")
tkfocus(txt)
}

#make progress object (S3)
if(!disabled) {
progress = list(disabled=disabled,tt=tt,txt=txt,lower=lower,upper=upper,iterlim=.options.min.iterlim(options),perslim=.options.min.boundlim(options))
} else {
progress = list(disabled=disabled,tt=NULL,txt=NULL,lower=lower,upper=upper,iterlim=.options.min.iterlim(options),perslim=.options.min.boundlim(options))
}

attr(progress,'class') <- 'progress'

#assign global counters
assign('.oldobj',0,envir=.arfInternal)
assign('.objit',1,envir=.arfInternal)
assign('.bounded',rep(0,.model.regions(arfmodel)),envir=.arfInternal)

return(progress)

}

writeProgress <-
#write down the progress of the iterations
{
txt = progress\$txt
tkconfigure(txt, state="normal")
tkdelete(txt,"1.0","end")

tkinsert(txt,"end",paste(as.character(Sys.time()),'\n',sep=''))
tkinsert(txt,"end",paste("\n"))
tkinsert(txt,"end",sprintf("Iteration obj.  : %10.0f\n",objit))
tkinsert(txt,"end",sprintf("Iteration limit : %10.0f\n",progress\$iterlim))
tkinsert(txt,"end",sprintf("Boundary limit  : %10.0f\n",progress\$perslim))
tkinsert(txt,"end",sprintf("Objective value : %10.0f\n",round(ssqdat)))
tkinsert(txt,"end",paste("\n"))
tkinsert(txt,"end",paste("Region Information\n"))
tkinsert(txt,"end",paste("Bounded regions (",paste(which(bounded>0),collapse=','),")\n",sep=''))
tkinsert(txt,"end",paste("\n"))

estvec = matrix(theta,10)

svec = sprintf('  [%3.0f] (%5.2f %5.2f %5.2f) |%8.0f|',1,estvec[7,1],estvec[8,1],estvec[9,1],sqrt(sum(gradmat[,1]^2)))
if(bounded[1]>0) svec=paste(svec,'*',sep='')
tkinsert(txt,"end",paste(svec,"\n"))

svec = sprintf('  [%3.0f] (%5.2f %5.2f %5.2f) |%8.0f|',i,estvec[7,i],estvec[8,i],estvec[9,i],sqrt(sum(gradmat[,i]^2)))
if(bounded[i]>0) svec=paste(svec,'*',sep='')
tkinsert(txt,"end",paste(svec,"\n"))
}
}

tkconfigure(txt, state="disabled")
tkfocus(txt)
}
```

## Try the arf3DS4 package in your browser

Any scripts or data that you put into this service are public.

arf3DS4 documentation built on May 2, 2019, 5:16 p.m.