# R/modegraph.R In denpro: Visualization of Multivariate Functions, Sets, and Data

#### Documented in modegraph

```modegraph<-function(estiseq,hseq=NULL,paletti=NULL)  #,reverse=F)
{
# we want that the largest h is first (1 mode, oversmoothing)

if (is.null(hseq))
if (!is.null(estiseq\$type)){
if (estiseq\$type=="greedy") hseq<--estiseq\$hseq
if (estiseq\$type=="bagghisto") hseq<--estiseq\$hseq
if (estiseq\$type=="carthisto")  hseq<--estiseq\$leaf
if (estiseq\$type=="kernel")  hseq<-estiseq\$hseq
}
else hseq<-estiseq\$hseq

hnum<-length(hseq)

treelist<-estiseq\$lstseq
d<-dim(treelist[[1]]\$center)[1]

if (hseq[1]<hseq[2]){   #(reverse){
#if ((hnum>1) && (is.null(hseq)))
hseq<-hseq[seq(hnum,1)]
apuseq<-list(treelist[[hnum]])
i<-2
while (i <= hnum){
apuseq<-c(apuseq,list(treelist[[hnum-i+1]]))
i<-i+1
}
treelist<-apuseq
}

if (is.null(paletti))
paletti<-c("red","blue","green","turquoise","orange","navy",
"darkgreen","orchid",colors()[50:100])

low<-matrix(0,hnum,1)
upp<-matrix(0,hnum,1)
tot<-moodilkm(treelist[[1]]\$parent)\$lkm  #tot is the number of modes over all lst:s
low[1]<-1
upp[1]<-tot
i<-2
while (i <= hnum){
lkmm<-moodilkm(treelist[[i]]\$parent)\$lkm
tot<-tot+lkmm
low[i]<-upp[i-1]+1
upp[i]<-low[i]+lkmm-1
i<-i+1
}

xcoor<-matrix(0,tot,d)
ycoor<-matrix(0,tot,1)
parent<-matrix(0,tot,1)
mlabel<-matrix(0,tot,1)
flucpoints<-matrix(0,hnum,1)
nodepointer<-matrix(0,tot,1)
colot<-matrix("",tot,1)

# first we allocate colors for the largest h
colrun<-1  #low[1]
while (colrun<=upp[1]){
colot[colrun]<-paletti[colrun]
colrun<-colrun+1
}

srun<-1
mlkmpre<-1
flucnum<-0
while (srun<=hnum){
mlkm<-moodilkm(treelist[[srun]]\$parent)
if (mlkmpre < mlkm\$lkm){
flucnum<-flucnum+1
flucpoints[flucnum]<-srun
}

for (j in 1:mlkm\$lkm){
loca<-mlkm\$modloc[j]
if (d>1){
for (dim in 1:d){
}
}
else{
}

}

if (srun>1){

vec1<-matrix(0,mlkmpre,d)
vec2<-matrix(0,mlkm\$lkm,d)
vec1[1:mlkmpre,]<-xcoor[low[srun-1]:upp[srun-1],]
vec2[1:mlkm\$lkm,]<-xcoor[low[srun]:upp[srun],]
vm<-vectomatch(vec1,vec2)
for (jj in low[srun]:upp[srun]){
parent[jj]<-vm\$parent[jj-low[srun]+1]+low[srun-1]-1
if (vm\$newnode[jj-low[srun]+1]==1){
colot[jj]<-paletti[colrun]
colrun<-colrun+1
}
else colot[jj]<-colot[parent[jj]]
}
}

mlkmpre<-mlkm\$lkm
srun<-srun+1
}

flucpoints<-flucpoints[1:flucnum]

mt<-list(xcoor=xcoor,ycoor=t(ycoor),
parent=parent,colot=colot,hseq=hseq,type=estiseq\$type,
upp=upp,low=low,
mlabel=t(mlabel),
flucpoints=t(flucpoints),
nodepointer=t(nodepointer)
)

return(mt)
}
```

## Try the denpro package in your browser

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

denpro documentation built on May 2, 2019, 8:55 a.m.