inst/doc/archetypal.R

In archetypal: Finds the Archetypal Analysis of a Data Frame

## ----setup, include=FALSE-----------------------------------------------------
library(archetypal)
library(rmarkdown)
knitr::opts_chunk$set(echo = TRUE)
options(max.width = 1000)
options(max.print = 100000)

## ----2D, echo=TRUE------------------------------------------------------------
library(archetypal)
p1=c(1,2);p2=c(3,5);p3=c(7,3) 
dp=rbind(p1,p2,p3);dp
set.seed(9102)
pts=t(sapply(1:100, function(i,dp){
  cc=runif(3)
  cc=cc/sum(cc)
  colSums(dp*cc)
},dp))
df=data.frame(pts)
colnames(df)=c("x","y")
head(df)

## ----plot2D, echo=FALSE,out.width='75%', fig.align='center',fig.width=10, fig.height=6----

plot(dp,pch=3,cex=2,xlab='x',ylab='y',xlim=c(min(dp[,1])-0.25,max(dp[,1])+0.25),ylim=c(min(dp[,2])-0.25,max(dp[,2])+0.25))
points(df,col='blue',pch=19,cex=0.7)
polygon(rbind(dp,dp[1,]),lty=2)

## ----load2D, echo=TRUE--------------------------------------------------------
# data("wd2")
# df=wd2

## ----run2D, echo=TRUE---------------------------------------------------------
aa = archetypal(df = df, kappas = 3, verbose = TRUE, rseed = 9102, save_history = TRUE)

## ----out2D, echo=TRUE---------------------------------------------------------
names(aa)


## ----archplot, echo=FALSE,out.width='75%', fig.align='center',fig.width=10, fig.height=6----
plot(dp,pch=3,cex=2,xlab='x',ylab='y',xlim=c(min(dp[,1])-0.25,max(dp[,1])+0.25),ylim=c(min(dp[,2])-0.25,max(dp[,2])+0.25))
points(df,col='blue',pch=19,cex=0.7)
polygon(rbind(dp,dp[1,]),lty=2)
archs=data.frame(aa$BY)
points(archs,col='blue',pch=15,cex=2)
polygon(rbind(archs,archs[1,]),col=rgb(0, 0, 1,0.5)) 

## ----sse_conv, echo=FALSE,out.width='75%', fig.align='center',fig.width=10, fig.height=6----
vsse=aa$run_results$SSE
plot(vsse,xlab="Iteration",ylab="SSE",pch=19, col="blue",type="b")
grid()

## ----checkB, echo=TRUE--------------------------------------------------------
BB=aa$B
yy=check_Bmatrix(B = BB, chvertices = NULL, verbose = TRUE)
# yy$used_rows
# yy$used_weights

## ----ch2d, echo=TRUE----------------------------------------------------------
ch=chull(df)
ch
df[ch,]

## ----checkBCH, echo=TRUE------------------------------------------------------
yy$used_rows
unlist(yy$used_rows)%in%ch

## ----Barchplot, echo=FALSE,out.width='75%', fig.align='center',fig.width=10, fig.height=6----
plot(dp,pch=3,cex=2,xlab='x',ylab='y',xlim=c(min(dp[,1])-0.25,max(dp[,1])+0.25),ylim=c(min(dp[,2])-0.25,max(dp[,2])+0.25))
points(df,col='blue',pch=19,cex=0.7)
polygon(rbind(dp,dp[1,]),lty=2)
archs=data.frame(aa$BY)
points(archs,col='blue',pch=15,cex=2)
pp=lapply(yy$used_rows,function(x,df){points(df[x,],col='red',type='b',pch=19);lines(df[x,],col='red',lwd=2)},df)

## ----run2Dinitial, echo=TRUE--------------------------------------------------
aa2=archetypal(df=df,kappas = 3,initialrows =  c(34,62,86), verbose = TRUE,rseed=9102,save_history = TRUE)
yy2=check_Bmatrix(aa2$B,verbose = TRUE)

## ----plot3D, echo=TRUE,out.width='100%', fig.align='center',fig.width=17, fig.height=9----
library(plot3D)
#
p1=c(3,0,0);p2=c(0,5,0);p3=c(3,5,7);p4=c(0,0,0);
dp=data.frame(rbind(p1,p2,p3,p4));dp=dp[chull(dp),];colnames(dp)=c("x","y","z")
set.seed(9102)
df=data.frame(t(sapply(1:100, function(i,dp){
  cc=runif(4)
  cc=cc/sum(cc)
  colSums(dp*cc)
},dp)))
colnames(df)=c("x","y","z")
scatter3D(x=dp$x,y=dp$y,z=dp$z,colvar=NULL,lwd = 2, d = 3,xlab='x',ylab='y',zlab='z',theta=120,phi=15,
          main = "Generators and Data Points", bty ="g",ticktype = "detailed",col='black',pch=10,cex=2.5)
points3D(x=df$x,y=df$y,z=df$z,col='blue',add=T,pch=19)

## ----load3D, echo=TRUE--------------------------------------------------------
# data("wd3")
# df=wd3

## ----run3D, echo=TRUE---------------------------------------------------------
aa3 = archetypal(df = df, kappas = 4, verbose = TRUE, rseed = 9102, save_history = TRUE)
yy3 = check_Bmatrix(aa3$B)

## ----run3DuseBetas, echo=TRUE-------------------------------------------------
irows=yy3$leading_rows
aa4 = archetypal(df = df, kappas = 4, initialrows = irows, verbose = TRUE, rseed = 9102, save_history = TRUE)
yy4 = check_Bmatrix(aa4$B)

## ----plot3DBetas, echo=FALSE,out.width='100%', fig.align='center',fig.width=17, fig.height=9----
scatter3D(x=dp$x,y=dp$y,z=dp$z,colvar=NULL,lwd = 2, d = 3,xlab='x',ylab='y',zlab='z',theta=120,phi=15,
          main = "Archetypes and Used Points", bty ="g",ticktype = "detailed",col='black',pch=10,cex=2.5)
points3D(x=df$x,y=df$y,z=df$z,col='blue',add=TRUE,pch=19)
archs3=data.frame(aa4$BY)
points3D(archs3$x,archs3$y,archs3$z,col='blue',add=TRUE,pch=15,cex=2.5)
pp3=lapply(yy4$used_rows,function(x,df){
  dh=df[x,]
  points3D(x=dh$x,y=dh$y,z=dh$z,col='red',add=TRUE,pch=19,cex=1.5)
  if(length(x)!=1){segments3D(x0=dh$x[1],y0=dh$y[1],z0=dh$z[1],x1=dh$x[2],y1=dh$y[2],z1=dh$z[2],col='red',add=TRUE,lwd=3) }
  },df)

## ----ch3,echo=TRUE------------------------------------------------------------
ch=unique(do.call(c,as.list(geometry::convhulln(df,'Fx'))))
ch

## ----find1, echo=TRUE---------------------------------------------------------
yy1 = find_outmost_projected_convexhull_points(df, kappas = 4)
yy1$outmost
yy1$outmostall
yy1$outmostall%in%ch

## ----find2, echo=TRUE---------------------------------------------------------
yy2 = find_outmost_convexhull_points(df, kappas = 4)
yy2$outmost
yy2$outmostall
yy2$outmostall%in%ch

## ----find3, echo=TRUE---------------------------------------------------------
# yy3 = find_outmost_partitioned_convexhull_points(df, kappas = 4, nworkers = 10)
# yy3$outmost
# yy3$outmostall
# yy3$outmostall%in%ch
# 1 . 2 . 3 . 4 . 5 . 6 . 7 . 8 . 9 . 10 .   
# Time difference of 2.769091 secs
# [1] 84  3
# [1] 61 64 82 67
# [1] 61 64 82 67
# [1] TRUE TRUE TRUE TRUE

## ----find4, echo=TRUE---------------------------------------------------------
# yy4 = find_furthestsum_points(df, kappas = 4, nfurthest = 100, nworkers = 10, sortrows = TRUE)
# yy4$outmost
# yy4$outmostall
# yy4$outmostall%in%ch
# [1] 56 61 64 67
# [1] 56 61 64 67
# [1] TRUE TRUE TRUE TRUE

## ----find5, echo=TRUE---------------------------------------------------------
yy5 = find_outmost_points(df, kappas = 4)
yy5$outmost
yy5$outmostall
yy5$outmostall%in%ch