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

#### Documented in shape2d

```shape2d<-function(shtseq, gnum=500, type="radius", type2="slice",
gnum2=1000, ngrid=30, norma=FALSE, xmax=10, modelim=2, exmalim=NULL,
maxnum=NULL)
{
# type "proba"    type2 "boundary"
lkm<-length(shtseq\$level)
d<-length(shtseq\$pcf\$N)

if (type2=="slice"){

td<-shtseq\$shtseq[[1]]
if (type=="proba") td\$volume<-td\$proba
td<-treedisc(td,shtseq\$pcf,ngrid=ngrid)
xy<-lst2xy(td,gnum=gnum)
ylen<-length(xy\$x)
ystep<-1/(ylen-1)
y<-seq(0,1,ystep)   #matrix(0,xlen,1)
z<-matrix(0,length(x),length(y))
delineator<-matrix(0,10*length(x),d)
delinrun<-1
delineatorlevel<-matrix(0,10*length(x),1)

delineator.redu<-matrix(0,4*length(x),d)
dr.redu<-1
delineatorlevel.redu<-matrix(0,4*length(x),1)

for (i in 1:lkm){
td<-shtseq\$shtseq[[i]]

if (type=="proba"){
tdvolume<-td\$volume
td\$volume<-td\$proba
indi<-lkm-i+1
voluu<-max(tdvolume)  #[1]  #root=1
if (norma) x[indi]<-(voluu/volball(1,d))^(1/d)
else x[indi]<-voluu
}
else indi<-i
td<-treedisc(td,shtseq\$pcf,ngrid=ngrid)
if (length(td\$parent)==1) ynew<-0
else{
xy<-lst2xy(td,gnum=gnum)   #ma<-matchxy(xy\$x,xy\$y,y)

## normalize
volu<-xy\$x[length(xy\$x)]-xy\$x[1]
int<-0
step<-xy\$x[2]-xy\$x[1]
for (j in 1:length(xy\$x)){
int<-int+step*xy\$y[j]
}
if (norma){
normavolu<-(volu/volball(1,d))^(1/d)
b<-volu*normavolu/int
}
else b<-volu^2/int
ynew<-b*xy\$y
## end normalize

# location
ml<-moodilkm(td\$parent)
mc<-t(td\$center[,ml\$modloc])  #modecent(td)
modenum<-dim(mc)[1]
delineator[delinrun:(delinrun+modenum-1),]<-mc
delineatorlevel[delinrun:(delinrun+modenum-1)]<-x[indi]
delinrun<-delinrun+modenum

if (modenum>modelim){
prunum<-modenum-modelim
pru<-prunemodes(td,prunum,exmalim,num=maxnum)
}
else pru<-td
ml<-moodilkm(pru\$parent)
mc<-t(pru\$center[,ml\$modloc])  #modecent(td)
modenum<-dim(mc)[1]
delineator.redu[dr.redu:(dr.redu+modenum-1),]<-mc
delineatorlevel.redu[dr.redu:(dr.redu+modenum-1)]<-x[indi]
dr.redu<-dr.redu+modenum
}
z[indi,]<-ynew
}
delineator<-delineator[1:(delinrun-1),]
delineatorlevel<-delineatorlevel[1:(delinrun-1)]

delineator.redu<-delineator.redu[1:(dr.redu-1),]
delineatorlevel.redu<-delineatorlevel.redu[1:(dr.redu-1)]
}

else{ #type2=="boundary"

if (is.null(xmax)){
td<-shtseq\$shtseq[[1]]
if (type=="proba") td\$volume<-td\$proba
xmax<-max(td\$volume)
}

ymax<-xmax
step<-2*xmax/(gnum-1)
x<-seq(-xmax,xmax,step)
y<-x
z<-matrix(0,length(x),length(y))

for (i in 1:lkm){
td<-shtseq\$shtseq[[i]]
if (type=="proba") td\$volume<-td\$proba
xy<-lst2xy(td,gnum=gnum2,type=type)

## normalize
volu<-xy\$x[length(xy\$x)]-xy\$x[1]
int<-0
step<-xy\$x[2]-xy\$x[1]
for (j in 1:length(xy\$x)){
int<-int+step*xy\$y[j]
}
b<-volu^2/int
ynew<-b*xy\$y
## end normalize

for (j in 1:length(x)){
for (k in 1:length(y)){
len<-sqrt(x[j]^2+y[k]^2)
xn<-x[j]/len
yn<-y[k]/len
th2<-atan(xn/yn)
if (yn<0) th2<-atan(xn/yn)+pi else if (xn<0) th2<-atan(xn/yn)+2*pi
propo<-th2/(2*pi)
dirind<-max(1,round( propo*length(xy\$x) ))
rho<-ynew[dirind]
if (len<=rho) z[j,k]<-shtseq\$level[i]
}
}
}

}

return(list(x=x,y=y,z=z,type=type,type2=type2,norma=norma,
delineator=delineator,delineatorlevel=delineatorlevel,
delineator.redu=delineator.redu,
delineatorlevel.redu=delineatorlevel.redu))
}
```

## 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.