int shortems(int n,int p,int nclass,double *pi,double **X,double **Mu,
double **LTSigma,int maxshortiter,double shorteps)
{
/*initializing as per Beiernacki, Celeaux, Govaert~(2003) */
int i,iter,totiter=0;
double *oldpi,**oldMu,**oldLTSigma,oldllh=-Inf,llhval;
MAKE_VECTOR(oldpi,nclass);
MAKE_MATRIX(oldMu,nclass,p);
MAKE_MATRIX(oldLTSigma,nclass,p*(p+1)/2);
do {
/* Modified by Wei-Chen Chen on 2009/03/08.
i=randomEMinit(X,n,p,nclass,oldpi,oldMu,oldLTSigma);
i = mb_randomEMinit(X, n, p, nclass, oldpi, oldMu, oldLTSigma);
*/
i = randomEMinit(X, n, p, nclass, oldpi, oldMu, oldLTSigma);
iter=maxshortiter-totiter;
iter=shortemcluster(n,p,nclass,oldpi,X,oldMu,oldLTSigma,iter,shorteps,
&llhval);
if (llhval >= oldllh) {
int i;
oldllh=llhval;
cpy(oldMu,nclass,p,Mu);
cpy(oldLTSigma,nclass,p*(p+1)/2,LTSigma);
for(i=0;i<nclass;i++) pi[i]=oldpi[i];
}
totiter+=iter;
} while (totiter < maxshortiter);
FREE_MATRIX(oldMu);
FREE_MATRIX(oldLTSigma);
FREE_VECTOR(oldpi);
return totiter;
}
void prcomp(int n, int m,double **x,double **UtX,double *D)
{
int i,j;
double *mu,*nu,*ltsigma,**xx,**V,**Vt;
MAKE_VECTOR(mu,m);
MAKE_VECTOR(ltsigma,m*(m+1)/2);
meandispersion(x,n,m,mu,ltsigma);
FREE_VECTOR(ltsigma);
MAKE_MATRIX(xx,n,m);
for(i=0;i<n;i++) {
for(j=0;j<m;j++) xx[i][j]=(x[i][j]-mu[j])/sqrt(n-1.);
}
MAKE_MATRIX(V,m,m);
i=svdd(xx,n,m,D,UtX,V);
MAKE_MATRIX(Vt,m,m);
matrpose(V,m,m,Vt);
MAKE_VECTOR(nu,m);
i=matxvec(Vt,m,m,mu,m,nu);
FREE_MATRIX(Vt);
FREE_VECTOR(mu);
FREE_MATRIX(V);
FREE_MATRIX(xx);
for(i=0;i<n;i++) {
for(j=0;j<m;j++) {
UtX[i][j]*=D[j];
UtX[i][j]+=nu[j];
}
}
FREE_VECTOR(nu);
return;
}
/* shortems() for model-based initializer. */
void shortems_mb(int n,int p,int nclass,double *pi,double **X,double **Mu,
double **LTSigma,int maxshortiter,double shorteps){
int i, iter, totiter = 0, n_par = p * (p + 1) / 2;
double *oldpi, **oldMu, **oldLTSigma, oldllh = -Inf, llhval;
MAKE_VECTOR(oldpi, nclass);
MAKE_MATRIX(oldMu, nclass, p);
MAKE_MATRIX(oldLTSigma, nclass, n_par);
do{
mb_init(X, n, p, nclass, oldpi, oldMu, oldLTSigma);
iter = maxshortiter - totiter;
iter = shortemcluster(n, p, nclass, oldpi, X, oldMu, oldLTSigma, iter,
shorteps, &llhval);
if(llhval >= oldllh){
oldllh = llhval;
cpy(oldMu, nclass, p, Mu);
cpy(oldLTSigma, nclass, n_par, LTSigma);
for(i = 0; i < nclass; i++) pi[i] = oldpi[i];
}
totiter += iter;
} while(totiter < maxshortiter);
FREE_MATRIX(oldMu);
FREE_MATRIX(oldLTSigma);
FREE_VECTOR(oldpi);
} /* End of shortems_mb(). */
int ss_shortems(int n, int p, int nclass, double *pi, double **X, double **Mu,
double **LTSigma, int maxshortiter, double shorteps, int *lab, int labK){
/*initializing as per Beiernacki, Celeaux, Govaert~(2003) */
int i, j, iter, totiter = 0, n_par = p * (p + 1) / 2;
int nonlab_total = 0, lab_index[n];
double *oldpi, **oldMu, **oldLTSigma, oldllh = -Inf, llhval;
double **labMu;
MAKE_VECTOR(oldpi, nclass);
MAKE_MATRIX(oldMu, nclass, p);
MAKE_MATRIX(oldLTSigma, nclass, n_par);
MAKE_MATRIX(labMu, labK, p);
for(i = 0; i < n; i++){
if(lab[i] == -1) lab_index[nonlab_total++] = i;
}
labInitMus(n, p, labK, X, lab, labMu);
do{
for(i = 0; i < labK; i++){
for(j = 0; j < p; j++) oldMu[i][j] = labMu[i][j];
}
iter = maxshortiter - totiter;
/* Modified by Wei-Chen Chen on 2009/03/08.
ss_randomEMinit(X, n, p, nclass, oldpi, oldMu, oldLTSigma,
lab, labK, nonlab_total, lab_index);
ss_mb_randomEMinit(X, n, p, nclass, oldpi, oldMu, oldLTSigma,
lab, labK, nonlab_total, lab_index);
*/
ss_randomEMinit(X, n, p, nclass, oldpi, oldMu, oldLTSigma,
lab, labK, nonlab_total, lab_index);
iter = ss_shortemcluster(n, p, nclass, oldpi, X, oldMu, oldLTSigma, iter,
shorteps, &llhval, lab);
if(llhval >= oldllh){
int i;
oldllh = llhval;
cpy(oldMu, nclass, p, Mu);
cpy(oldLTSigma, nclass, n_par, LTSigma);
for(i = 0; i < nclass; i++) pi[i] = oldpi[i];
}
totiter += iter;
} while(totiter < maxshortiter);
FREE_MATRIX(oldMu);
FREE_MATRIX(oldLTSigma);
FREE_VECTOR(oldpi);
FREE_MATRIX(labMu);
return totiter;
} /* End of ss_shortems(). */
int shortemcluster(int n, int p, int k, double *pi, double **X,
double **Mu, double **LTSigma, int maxiter, double eps, double *llhdval,
int *conv_iter, double *conv_eps){
int iter, i, n_par = p * (p + 1) / 2;
double *backup_pi, **backup_Mu, **backup_LTSigma;
double **gamm, llhd, oldllhd, llh0;
MAKE_VECTOR(backup_pi, k);
MAKE_MATRIX(backup_Mu, k, p);
MAKE_MATRIX(backup_LTSigma, k, n_par);
MAKE_MATRIX(gamm, n, k);
estep_gamma(n, p, k, X, gamm, Mu, LTSigma);
llhd = lnlikelihood_gamma(n, k, gamm, pi);
llh0 = llhd;
iter = 0;
do{
oldllhd = llhd;
norm_gamma(n, k, gamm, pi);
for(i = 0; i < k; i++) backup_pi[i] = pi[i];
cpy(Mu, k, p, backup_Mu);
cpy(LTSigma, k, n_par, backup_LTSigma);
mstep(X, n, p, k, pi, Mu, LTSigma, gamm);
estep_gamma(n, p, k, X, gamm, Mu, LTSigma);
llhd = lnlikelihood_gamma(n, k, gamm, pi);
if(oldllhd > llhd){
for(i = 0; i < k; i++) pi[i] = backup_pi[i];
cpy(backup_Mu, k, p, Mu);
cpy(backup_LTSigma, k, n_par, LTSigma);
llhd = oldllhd;
iter--;
break;
}
iter++;
*conv_eps = fabs((oldllhd - llhd) / (llh0 - llhd));
} while((*conv_eps > eps) && (iter < maxiter));
*llhdval = llhd;
*conv_iter = iter;
FREE_VECTOR(backup_pi);
FREE_MATRIX(backup_Mu);
FREE_MATRIX(backup_LTSigma);
FREE_MATRIX(gamm);
return iter;
}
int shortemcluster_org(int n,int p,int k,double *pi,double **X,double **Mu,
double **LTSigma,int maxiter,double eps,double *llhdval)
{
int iter;
double **gamm,llhd,oldllhd,llh0;
/*same as emcluster, only difference being in how convergence is handled,
done as per Biernacki et al*/
MAKE_MATRIX(gamm,n,k);
llhd=lnlikelihood(n,p,k,pi,X,Mu,LTSigma);
llh0=llhd;
iter=0;
do {
oldllhd=llhd;
estep(n,p,k,X,gamm,pi,Mu,LTSigma);
mstep(X,n,p,k,pi,Mu,LTSigma,gamm);
llhd=lnlikelihood(n,p,k,pi,X,Mu,LTSigma);
iter++;
} while (((oldllhd-llhd)/(llh0-llhd) > eps) && (iter<maxiter));
/* Marked by Wei-Chen Chen on 2009/01/21.
This value, (oldllhd-llhd)/(llhd-llh0), is always negative.
} while ((((oldllhd-llhd)/(llhd-llh0)) > eps) && (iter<maxiter));
*/
(*llhdval)=llhd;
FREE_MATRIX(gamm);
return iter;
}
void XAXt2(double **X, int p, double **A, double ***Res, int k){
double **Res1, **Res2;
MAKE_MATRIX(Res1, p, p);
MAKE_MATRIX(Res2, p, p);
tA(X, p, p, Res2);
multiply(X, p, p, A, p, p, Res1);
multiply2(Res1, p, p, Res2, p, p, Res, k);
FREE_MATRIX(Res1);
FREE_MATRIX(Res2);
}
int ZXY(double **Z, int az, int bz, double **X, int ax, int bx, double **Y, int ay, int by, double **Res){
double **Res1;
MAKE_MATRIX(Res1, az, bx);
multiply(Z, az, bz, X, ax, bx, Res1);
multiply(Res1, az, bx, Y, ay, by, Res);
FREE_MATRIX(Res1);
return 0;
}
/* Model-based initializer. */
void mb_init(double **X, int n, int p, int nclass, double *pi, double **Mu,
double **LTSigma){
int i, min_n = p + 1, n_nclass = (int) ceil((double) n / (double) nclass);
int G, nc[nclass], i2, i3, j = 1;
int tmp_G, tmp_class, class[n];
double lambda, max_prob, prob[n], **gamm;
double tmp_prob, tmp_n, tmp_pi, tmp_gamm;
double class_prob[n], tmp_class_prob;
PARAM param;
void *pt_param;
/* Find lambda, the expected size of neighbor. */
if(n_nclass < min_n){
//WCC printf("n is too small, or p or k is too large.\n");
//WCC exit(1);
error("n is too small, or p or k is too large.\n");
}
param.n_nclass = (double) (n_nclass - min_n);
param.lower_bound = 1e-6;
param.upper_bound = param.n_nclass;
param.tol = 1e-6;
param.maxit = 1000;
pt_param = ¶m;
lambda = find_lambda(pt_param);
tmp_n = (double) n;
MAKE_MATRIX(gamm, n, nclass);
tmp_prob = 1.0 / (double) n;
do{
/* Initial prob. */
for(i = 0; i < n; i++) prob[i] = tmp_prob;
/* Note: cut_sub() will overwrite prob. */
cut_sub(X, n, p, 1, min_n, lambda, prob, Mu, LTSigma);
pi[0] = 1.0;
for(i = 0; i < n; i++) class[i] = 0;
nc[0] = n;
for(G = 2; G <= nclass; G++){
max_prob = 0.0;
tmp_G = G - 1;
for(i = 0; i < n; i++){
prob[i] = mixllhd(p, tmp_G, X[i], pi, Mu, LTSigma);
if(prob[i] > max_prob) max_prob = prob[i];
}
for(i = 0; i < n; i++) prob[i] = max_prob - prob[i];
/* Drop the 75% points around cluster centers. */
for(i = 0; i < G; i++){
i3 = 0;
for(i2 = 0; i2 < n; i2++){
if(class[i2] == i) class_prob[i3++] = prob[i2];
}
tmp_class_prob = mb_quantile(i3, class_prob, 0.75);
for(i2 = 0; i2 < n; i2++){
if(class[i2] == i && prob[i2] < tmp_class_prob) prob[i2] = 0.0;
}
}
/* Note: cut_sub() will overwrite prob. */
cut_sub(X, n, p, G, min_n, lambda, prob, Mu, LTSigma);
/* Assume uniform for pi, do one estep, and reassign new pi. */
tmp_pi = 1.0 / (double) G;
for(i = 0; i < G; i++) pi[i] = tmp_pi;
/* Run one estep to update pi. */
estep(n, p, G, X, gamm, pi, Mu, LTSigma);
for(i = 0; i < G; i++) nc[i] = 0;
for(i = 0; i < n; i++){
tmp_gamm = 0.0;
tmp_class = 0;
for(i2 = 0; i2 < G; i2++){
if(tmp_gamm < gamm[i][i2]){
tmp_gamm = gamm[i][i2];
tmp_class = i2;
}
}
class[i] = tmp_class;
nc[tmp_class] = nc[tmp_class] + 1;
}
j = 1;
for(i = 0; i < G; i++){
if(nc[i] < min_n){
j = 0;
break;
}
}
if(j == 0) break;
for(i = 0; i < G; i++) pi[i] = (double) nc[i] / tmp_n;
}
} while(j == 0);
FREE_MATRIX(gamm);
} /* End of mb_init(). */
void AllPerms(int size,int **perms){
int sch, i, j, v, w, finish, flag, ind;
double **pat;
int *cn;
sch = 0;
i = 0;
j = -1;
flag = 0;
finish = 0;
ind = 0;
MAKE_MATRIX(pat, size, size);
for (v=0; v<size; v++){
for (w=0; w<size; w++){
pat[v][w] = 0;
}
}
MAKE_VECTOR(cn, size);
for (v=0; v<size; v++){
cn[v] = 0;
}
while (finish == 0){
if (j != (size-1)){
j = j+1;
} else {
if (flag == 1){
j = 0;
i = i+1;
flag = 0;
}
}
if (pat[i][j] == 0){
for (v=0; v<size; v++){
pat[i][v]=1;
pat[v][j]=1;
}
sch = sch + 1;
cn[sch-1] = j;
flag = 1;
}
if ((sch == size) & (flag == 1)){
for (v=0; v<size; v++){
perms[ind][v] = cn[v];
}
ind++;
flag = 0;
sch = sch - 1;
i = i - 1;
j = cn[sch-1];
sch = sch-1;
for (v=0; v<size; v++){
for (w=0; w<size; w++){
pat[v][w] = 0;
}
}
for (v=0; v<sch; v++){
for (w=0; w<size; w++){
pat[v][w] = 1;
pat[w][cn[v]] = 1;
}
}
}
if ((j == size - 1) & (flag == 0)){
i = i - 1;
sch = sch-1;
if (sch >= 0){
j = cn[sch];
for (v=0; v<size; v++){
for (w=0; w<size; w++){
pat[v][w] = 0;
}
}
if (sch > 0){
for (v=0; v<sch; v++){
for (w=0; w<size; w++){
pat[v][w] = 1;
pat[w][cn[v]] = 1;
}
}
}
}
if (i >= 0){
pat[i][j] = 1;
}
}
if (sch == -1){
finish = 1;
}
}
FREE_MATRIX(pat);
FREE_VECTOR(cn);
}