firx error in slave.c

[epclust.git] / old_C_code / stage2_UNFINISHED / src / unused / 01_StBr.r

diff --git a/old_C_code/stage2_UNFINISHED/src/unused/01_StBr.r b/old_C_code/stage2_UNFINISHED/src/unused/01_StBr.r
new file mode 100644 (file)
index 0000000..980a855
--- /dev/null
+++ b/old_C_code/stage2_UNFINISHED/src/unused/01_StBr.r
@@ -0,0 +1,57 @@
+## 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