X-Git-Url: https://git.auder.net/doc/screen_pairings_restore.png?a=blobdiff_plain;f=old_C_code%2Fstage2_UNFINISHED%2Fsrc%2Funused%2F01_StBr.r;fp=old_C_code%2Fstage2_UNFINISHED%2Fsrc%2Funused%2F01_StBr.r;h=0000000000000000000000000000000000000000;hb=62deb4244895a20a35397dfb062f0b9fe94c5012;hp=980a855f07b228cb30e60ddf2f92c0992c501453;hpb=3eef8d3df59ded9a281cff51f79fe824198a7427;p=epclust.git

diff --git a/old_C_code/stage2_UNFINISHED/src/unused/01_StBr.r b/old_C_code/stage2_UNFINISHED/src/unused/01_StBr.r
deleted file mode 100644
index 980a855..0000000
--- a/old_C_code/stage2_UNFINISHED/src/unused/01_StBr.r
+++ /dev/null
@@ -1,57 +0,0 @@
-## File: StBr.r
-## Description: screens meaningful variables and performns
-##              data transformation on clustering 
-
-# rm(list = ls())
-
-
-## Description: Steinley & Brusco (2006) data transform to cluster 
-StBrtransform <- function(X){
-  apply(X, 2, function(x) 12 * var(x) / (max(x) - min(x))^2 )  
-}
-
-
-## Description: Clustering index (Steinley & Brusco (2006))
-CI <- function(X, B = 1000) { # B : number of boostrap replications
-
-  n <- nrow(X)
-  p <- ncol(X)
-  
-  #ci <- apply(X, 2, function(x) 12 * var(x) / (max(x) - min(x))^2 )
-  ci <- StBrtransform(X)
-  
-  rc    <- ci / min(ci)
-  minV  <- which.min(rc)
-  
-  Xstar    <- scale(X)
-  newRange <- apply(Xstar, 2, function(x) max(x) - min(x))
-  
-  rmin <- newRange[minV]
-
-  datat <- array(0.0, dim = dim(X))
-  
-  # Reweighting X into datat
-  for(i in 1:p){
-    v          <- Xstar[, i]
-    temp       <- rc[i] * (rmin / newRange[i])^2    
-    datat[, i] <- sqrt(temp) * v
-  }
-  
-  xboot  <- matrix(rnorm(n * B), nrow = n)
-  #cinorm <- apply(xboot, 2, function(x) 12 * var(x) / (max(x) - min(x))^2 )
-  cinorm <- StBrtransform(xboot)
-  ci95   <- median(cinorm)
-  
-  #ciStar <- apply(datat, 2, function(x) 12 * var(x) / (max(x) - min(x))^2 )
-  ciStar  <- StBrtransform(datat)
-  selectv <- which(ciStar > ci95)
-  
-  return(list(selectv = selectv, 
-              tdata  = datat) )  
-}
-
-
-
-
-#test <- matrix(rnorm(200), 40, 5)
-#CI(test)$selectv