##
## Main bpca demo script
## Covers 2D/3D workflows, diagnostics, and plotting modes.
##

oask <- devAskNewPage(dev.interactive(orNone=TRUE))

inspect_bpca <- function(bp) {
  cat('==========================================\n')
  cat('       BPCA OBJECT INSPECTION\n')
  cat('==========================================\n\n')

  # Basic Info
  cat('Class:', class(bp), '\n')
  cat('Available components:',
      paste(names(bp),
            collapse=', '), '\n\n')

  # Summary
  cat('--- Summary ---\n')
  print(summary(bp))
  cat('\n')

  # Components and Importance
  cat('Number of components:',
      bp$number,
      '\n')
  cat('Importance of components (Rounded):\n')
  print(round(bp$importance,
              3))
  cat('\n')

  # Coordinates (Top 3)
  cat('--- Object Coordinates (First 3) ---\n')
  n_obj <- min(3,
               nrow(bp$coord$objects))
  print(bp$coord$objects[seq_len(n_obj),
        drop=FALSE])
  cat('\n')

  cat('--- Variable Coordinates (First 3) ---\n')
  n_var <- min(3,
               nrow(bp$coord$variables))
  print(bp$coord$variables[seq_len(n_var),
        drop=FALSE])
  cat('\n==========================================\n')
}



## ------------------------------------------------------------------
## 1) Basic 2D workflow
## ------------------------------------------------------------------
bp2 <- bpca(gabriel1971)
plot(bp2,
     main='gabriel1971 - 2D')
inspect_bpca(bp2)

## Customize aesthetics in 2D
plot(bpca(gabriel1971,
          method='sqrt'),
     main='gabriel1971 - sqrt',
     sub='Customized aesthetics',
     var.cex=.6,
     var.color=rainbow(ncol(gabriel1971)),
     var.pch='v',
     obj.pch='o',
     obj.cex=.5,
     obj.col=rainbow(nrow(gabriel1971)),
     obj.pos=1,
     obj.offset=.5)

## ------------------------------------------------------------------
## 2) Basic 3D workflow (static)
## ------------------------------------------------------------------
bp3 <- bpca(gabriel1971,
            d=1:3)
plot(bp3,
     main='gabriel1971 - 3D static')
inspect_bpca(bp3)

## Customize aesthetics in 3D static
plot(bpca(gabriel1971,
          d=1:3,
          method='jk'),
     main='gabriel1971 - jk',
     sub='Customized aesthetics',
     var.pch='+',
     var.cex=.6,
     var.color=rainbow(ncol(gabriel1971)),
     obj.pch='*',
     obj.cex=.8,
     obj.col=rainbow(nrow(gabriel1971)),
     ref.lty='solid',
     ref.col='red',
     angle=70)

## Alternative 3D projection range
bp3_alt <- bpca(gabriel1971,
                d=2:4)
plot(bp3_alt,
     main='gabriel1971 - 3D (PC2 to PC4)')
inspect_bpca(bp3_alt)

## ------------------------------------------------------------------
## 3) Interactive identification
## ------------------------------------------------------------------
if (dev.interactive()) {
  plot(bp2,
       obj.names=FALSE,
       obj.identify=TRUE,
       main='2D object identification')

  plot(bp2,
       obj.names=FALSE,
       obj.labels=c('toi', 'kit', 'bat', 'ele', 'wat', 'rad', 'tv', 'ref'),
       obj.identify=TRUE,
       main='2D object identification (custom labels)')

  plot(bp3,
       obj.names=FALSE,
       obj.identify=TRUE,
       main='3D object identification')

  plot(bp3,
       obj.names=FALSE,
       obj.labels=c('toi', 'kit', 'bat', 'ele', 'wat', 'rad', 'tv', 'ref'),
       obj.identify=TRUE,
       main='3D object identification (custom labels)')
}

## ------------------------------------------------------------------
## 4) Data tools helper
## ------------------------------------------------------------------
dt <- dt.tools(iris,
               center=2)
class(dt)
names(dt)
str(dt)
dt$length
dt$angle
dt$r

(iris.tools <- round(dt$r, 5))
(iris.obsv <- round(cor(iris[-5]), 5))
all(iris.tools == iris.obsv)

## ------------------------------------------------------------------
## 5) Grouping example (iris)
## ------------------------------------------------------------------
plot(bpca(iris[-5]),
     var.cex=.7,
     obj.names=FALSE,
     obj.cex=1.5,
     obj.col=c('red', 'green3', 'blue')[as.numeric(iris$Species)],
     obj.pch=c('+', '*', '-')[as.numeric(iris$Species)],
     main='iris - 2D grouping')

plot(bpca(iris[-5],
          d=1:3),
     var.color=c('blue', 'red'),
     var.cex=1,
     obj.names=FALSE,
     obj.cex=1,
     obj.col=c('red', 'green3', 'blue')[as.numeric(iris$Species)],
     obj.pch=c('+', '*', '-')[as.numeric(iris$Species)],
     main='iris - 3D grouping')

## ------------------------------------------------------------------
## 6) Quality diagnostics with var.rb and qbpca
## ------------------------------------------------------------------
# Enable pause between plots
par(ask=TRUE)

for (m in c('sqrt', 'jk', 'gh', 'hj')) {
  bp_m <- bpca(gabriel1971,
               method=m,
               var.rb=TRUE)
  q_m <- qbpca(gabriel1971, bp_m)

  plot(q_m,
       highlight.width=0.25,
       main=paste0('Method: ', m))
}


for (m in c('sqrt', 'jk', 'gh', 'hj')) {
  bp_m3 <- bpca(gabriel1971,
                method=m,
                d=1:3,
                var.rb=TRUE)
  q_m3 <- qbpca(gabriel1971,
                bp_m3)
  plot(q_m3,
       highlight.width=0.25,
       main=paste0(m, ' - 3D'))
}

# Disable pause
par(ask=FALSE)

## var.rd highlights poor projected correlations
bp_rd <- bpca(gabriel1971,
              method='hj',
              var.rb=TRUE,
              var.rd=TRUE,
              limit=3)
bp_rd$var.rd
plot(bpca(gabriel1971,
          method='hj',
          d=3:4),
          main='HJ (PC3-PC4)')

## ------------------------------------------------------------------
## 7) Plot modes with ontario data
## ------------------------------------------------------------------
data(ontario)
obj.lab <- paste('g',
                 1:18,
                 sep='')

plot(bpca(ontario),
     main='Ontario - basic')

plot(bpca(ontario),
     obj.labels=obj.lab,
     main='Ontario - custom labels')

plot(bpca(ontario),
     type='eo',
     obj.cex=1,
     main="type='eo' (default object)")

plot(bpca(ontario),
     type='eo',
     obj.id=7,
     obj.cex=1,
     main="type='eo' (object 7)")

plot(bpca(ontario),
     type='eo',
     obj.labels=obj.lab,
     obj.id='g7',
     obj.cex=1,
     main="type='eo' (object g7)")

plot(bpca(ontario),
     type='ev',
     var.cex=1,
     main="type='ev' (default variable)")

plot(bpca(ontario),
     type='ev',
     var.id='E7',
     obj.labels=obj.lab,
     var.cex=1,
     main="type='ev' (variable E7)")

cl <- 1:3
plot(bpca(iris[-5]),
     type='ev',
     var.id=1,
     obj.names=FALSE,
     obj.col=cl[as.numeric(iris$Species)],
     main="type='ev' with groups")

legend('topleft',
       legend=levels(iris$Species),
       text.col=cl,
       pch=19,
       col=cl,
       cex=.9,
       box.lty=0)

plot(bpca(ontario),
     type='co',
     main="type='co' (default objects)")

plot(bpca(ontario),
     type='co',
     obj.labels=obj.lab,
     main="type='co' with labels")

plot(bpca(ontario),
     type='co',
     obj.labels=obj.lab,
     obj.id=13:14,
     main="type='co' (objects 13 and 14)")

plot(bpca(ontario),
     type='co',
     obj.labels=obj.lab,
     obj.id=c('g7', 'g13'),
     main="type='co' (objects g7 and g13)")

plot(bpca(ontario),
     type='cv',
     main="type='cv'")

plot(bpca(ontario),
     type='ww',
     main="type='ww'")

plot(bpca(ontario),
     type='dv',
     main="type='dv'")

plot(bpca(ontario),
     type='ms',
     main="type='ms'")

plot(bpca(ontario),
     type='ro',
     main="type='ro'")

plot(bpca(ontario),
     type='rv',
     main="type='rv'")

## Out-of-range examples for defensive behavior
plot(bpca(iris[-5]),
     type='eo',
     obj.id=42,
     obj.cex=1)

plot(bpca(iris[-5]),
     type='ev',
     var.id='Sepal.Width')

plot(bpca(iris[-5]),
     type='ev',
     var.id='Sepal.Width',
     var.factor=.3)

devAskNewPage(oask)
