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;
}
int randomEMinit(double **x, int n, int p, int nclass, double *pi,
double **Mu, double **LTSigma)
{
int *ordr,i,j,*clas,*nc;
/* This is a bug. Modified by Wei-Chen Chen on 2009/03/13.
MAKE_VECTOR(ordr,n);
*/
MAKE_VECTOR(ordr, nclass);
MAKE_VECTOR(clas, n);
MAKE_VECTOR(nc, nclass);
do {
/* This is a bug. Modified by Wei-Chen Chen on 2009/03/13.
i=srswor(n, n, ordr);
*/
i=srswor(n, nclass, ordr);
for(i=0;i<nclass;i++){
for(j=0;j<p;j++) Mu[i][j]=x[ordr[i]][j];
}
for(i=0;i<n;i++) clas[i]=assign_closest(x[i],p,nclass,Mu);
j=initials(x,n,p,nclass,nc,Mu,LTSigma,clas);
} while (j==0);
for(i=0;i<nclass;i++) pi[i]=1.*nc[i]/n;
FREE_VECTOR(nc);
FREE_VECTOR(clas);
FREE_VECTOR(ordr);
return 0;
}
int svdd(double **a, int m, int n, double *d, double **u, double **v)
{
double *A, *U, *VT;
int lwork = -1;
int liwork = 8*MIN(m,n);
char jobz = 'S';
double dw,*work=&dw; /*points to a temporary cell*/
int *iwork;
int i, j, k, info,minmn=MIN(m,n);
MAKE_VECTOR(A, m*n);
for (j=0, k=0; j<n; j++) {
for (i=0; i<m; i++) A[k++] = a[i][j];
}
MAKE_VECTOR(U, m*minmn);
MAKE_VECTOR(VT,minmn*n);
MAKE_VECTOR(iwork, liwork);
lwork=-1;
dgesdd_(&jobz, &m, &n, A, &m, d, U, &m, VT, &n,
work, &lwork, iwork, &info); /*call to get optimal lwork*/
if (info!=0) {
//WCC printf("error: allocating LWORK in svdd\n");
//WCC exit(1);
error("error: allocating LWORK in svdd\n");
}
lwork=(int)*work;
MAKE_VECTOR(work, lwork);
dgesdd_(&jobz, &m, &n, A, &m, d, U, &m, VT, &minmn,
work, &lwork, iwork, &info);
FREE_VECTOR(A);
FREE_VECTOR(work);
FREE_VECTOR(iwork);
for (j=0, k=0; j<minmn; j++) {
for (i=0; i<m; i++) u[i][j]=U[k++];
}
/* VT, as calculated by dgesdd_(), is the transpose of the right
* multiplier. Here we undo the transpose so that the matrix
* v[][] returned by this function is not transposed anymore.
*/
for (i=0,k=0; i<n; i++) {
for (j=0; j<minmn; j++) v[i][j]=VT[k++];
}
FREE_VECTOR(U);
FREE_VECTOR(VT);
return info;
}
int eigend(double *A, double *EV, double *E, int n)
{
int lwork=-1,liwork=-1;
double dx,*z,*a,*w,*work = &dx;/* work points to a temporary cell */
int info,ix,i,j,*iwork = &ix; /* iwork points to a temporary cell */
char jobz='V', uplo='U';
MAKE_VECTOR(a,n*(n+1)/2);
MAKE_VECTOR(w,n);
MAKE_VECTOR(z,n*n);
for(i=0;i<n*(n+1)/2;i++) a[i]=A[i];
/* Call dspevd_() with lwork=-1 and liwork=-1 to query the optimal sizes of
* the work and iwork arrays.
* */
dspevd_(&jobz,&uplo,&n,a,w,z,&n,work,&lwork,iwork,&liwork,&info);
if (info==0) {
lwork = (int)*work;
liwork = *iwork;
/* allocate optimal sizes for work and iwork */
MAKE_VECTOR(work,lwork);
MAKE_VECTOR(iwork,liwork);
if (work!=NULL && iwork!=NULL) {
dspevd_(&jobz,&uplo,&n,a,w,z,&n,work,&lwork,iwork,&liwork,&info);
if (info==0) {
for(i=0;i<n;i++) {
E[i]=w[n-1-i];
for (j=0;j<n;j++) {
EV[j*n+i]=z[(n-1-j)*n+i];
}
}
}
else {
REprintf("error in dspvd at calculation stage: Error code %d\n",info);
}
}
FREE_VECTOR(work);
FREE_VECTOR(iwork);
}
FREE_VECTOR(a);
FREE_VECTOR(w);
FREE_VECTOR(z);
return info;
}
/* 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 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 unique(int n,double *x,int *m,double *y) /* Returns the unique values in
x in ascending order: the
number of unique values is
output in m and the unique
values are output in sorted
order in y */
{
int i,j;
double *dum;
MAKE_VECTOR(dum,n);
for(i=0;i<n;i++) dum[i]=x[i];
sort(n,dum);
i=0;
j=0;
while (j<n) {
y[i]=dum[j];
while ((j<n) && (dum[j]==y[i])) {
j++;
}
i++;
}
(*m)=i;
FREE_VECTOR(dum);
return;
}
int posymatinv(int size,double **A,double (*determinant))
{
int i, j,INFO,N,LDA ;
char uplo='L';
double *AT; /* AT=transpose vectorized matrix (to accomodate Fortran) */
MAKE_VECTOR(AT,size*size);
for (i=0; i<size; i++) /* to call a Fortran routine from C */
{ /* have to transform the matrix */
for(j=0; j<size; j++) AT[j+size*i]=A[j][i];
}
N=size;
LDA=size;
dpotrf_ (&uplo, &N, AT, &LDA, &INFO);
/* LAPACK routine DPOTRF computes an Cholesky decomposition of
a symmetric positive definite matrix A.
Parameters in the order as they appear in the function call:
uplo="U" indicates that the strictly lower triangular part of
A will be ignored, N is the order of the matrix A, the
matrix A, the leading dimension of A, and the flag for the
result. On exit, the upper triangle of A contains U.*/
if (INFO==0) {
int i;
(*determinant)=1.0;
for (i=0; i<N; i++) {
(*determinant)*=AT[i+i*N]*AT[i+i*N];
}
dpotri_ (&uplo, &N, AT, &LDA, &INFO);
/* LAPACK routine DPOTRI computes the inverse of a matrix A
using the output of DPOTRF. This method inverts U using the
Cholesky factorization of A.
Parameters in the order as they appear in the function call:
uplo="U" indicates that the strictly lower triangular part of
A will be ignored, c1 is the order of the matrix A, the
matrix A, the leading dimension of A, and the flag for the
result. On exit, the upper triangle of A contains U.*/
if (INFO!=0) {
/* Marked by Wei-Chen Chen on 2009/06/07.
* printf("Problem in posymatinv: dpotri error %d\n",INFO);
*/
}
}
else {
/* Marked by Wei-Chen Chen on 2009/06/07.
* printf("Problem in posymatinv: dpotrf error %d\n",INFO);
*/
}
for (i=0; i<size; i++) { /*transform the matrix back*/
for(j=i; j<size; j++) {
A[j][i]=AT[j+size*i];
A[i][j]=AT[j+size*i];
}
}
FREE_VECTOR(AT);
return 0;
}
double dlmvnorm_singular(double *x, int p, double *mu, double *LTsigma)
{
/* Calculates the p-variate Gaussian log-density at the p-variate point x
with mean mu and the lower triangle (px(p+1)/2) LTsigma of the
pxp-dimensional dispersion matrix Sigma.
Note that this function actually incorporates the case for singular
determinants
*/
double *eivec,*eival,value=0;
int i,ind=0;
MAKE_VECTOR(eivec,p*p);
MAKE_VECTOR(eival,p);
i=eigens(LTsigma,eivec,eival,p);
if (eival[0]==0) { /* only possible if LTsigma is all zero, which means
that the distribution is degenerate at mu */
for(i=0;((i<p) && (!ind));i++) if (x[i]!=mu[i]) ind =1;
if (ind) value=-Inf;
else value=0;
}
else {
int j,dmin;
double *y,*z,sum=0,sump=0;
for(i=0;i<p;i++) sum+=eival[i];
for(i=0;((i<p) && (sump<0.99));i++) {
sump+=eival[i]/sum;
value-=0.5*log(eival[i]);
}
dmin=i;
MAKE_VECTOR(y,p);
for(i=0;i<p;i++) y[i]=x[i]-mu[i];
MAKE_VECTOR(z,dmin);
for(i=0;i<dmin;i++) z[i]=0;
for(i=0;i<dmin;i++) {
for(j=0;j<p;j++) z[i]+=eivec[j*p+i]*y[j];
}
FREE_VECTOR(y);
for(i=0;i<dmin;i++) value-=0.5*z[i]*z[i]/eival[i];
FREE_VECTOR(z);
value-=0.5*dmin*log(2*PI);
}
FREE_VECTOR(eival);
FREE_VECTOR(eivec);
return value;
}
/* Front end to LP_sym_eigvecs
*
* Calculates the eigenvalues and eigenvectors of the nxn symmetric matrix A.
* The eigenvalues are returned in the vector w.
* The (orthonormal) eigenvectors are returned in the matrix z.
* The ith column of z holds the eigenvector associated with w[i].
* Written by xxxxx
* Note that one major task done here is to reverse the order of the
* eigenvalues (to something that makes more sense) and to put them in
* decreasing order and the corresponding eigenvectors
* */
int symeigens(double *a, int n, double *w, double *z)
{
double *eval,*evec;
int i,j,info;
MAKE_VECTOR(eval,n);
MAKE_VECTOR(evec,n*n);
info=LP_sym_eigvecs(a,n,eval,evec);
if (info==0) {
for(i=0;i<n;i++) {
w[i]=eval[n-1-i];
for (j=0;j<n;j++) {
z[j*n+i]=evec[(n-1-j)*n+i];
}
}
}
FREE_VECTOR(eval);
FREE_VECTOR(evec);
return info;
}
int polaroid(int p, double *x, double *R, double *theta)
/* This function calculates the polar coordinates of a p-variate vector x and
returns its norm, R and the (p-1)-dimensional angular coordinates theta. The
function returns the index of the elements in x, after which all the
coordinates are zero. This means that the theta's from that index are
undefined.
Written by xxxxxxxxxxxxx. */
{
int i;
double sum = 0.;
for (i = 0; i < p; i++) sum += x[i]*x[i];
(*R) = sqrt(sum);
for (i = 0; i < (p - 1); i++) theta[i] = 0.;
if (sum == 0) return 0;
else {
int k;
double *y;
MAKE_VECTOR(y, p - 1);
y[0] = sum;
for (i = 1; i < (p - 1); i++) y[i] = y[i-1] - x[i-1]*x[i-1];
for (k = 1; (k <= (p - 1)) && (y[k - 1] > 0); k++);
for (i = 0; i < (k - 1); i++) {
theta[i] = acos( x[i] / sqrt(y[i]));
}
if (k == p) {
/* if (SIGN(sin(theta[p - 2])) != SIGN(x[p - 1])) {*/
if (NEG(x[p - 1])) {
/* printf("\n\nhere we are %d %d %d\n\n", NEG(sin(theta[p - 2] / x[p - 1])), k, p);
printf("x[%d] = %f, y[%d] = %f\n", p-1, x[p-1], p-2, sqrt(y[p-2]));
printf("\n cos = %e sin = %e x/r = %e\n",
cos(theta[p-2]), sin(theta[p - 2]), x[p - 1] / sqrt(y[p - 2]));
*/
theta[p - 2] = 2*PI - theta[p - 2];
/* printf("\n cos = %e sin = %e x/r = %e\n",
cos(theta[p-2]), sin(theta[p - 2]), x[p - 1] / sqrt(y[p - 2]));
*/ }
}
FREE_VECTOR(y);
return k;
}
}
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(). */
/* This function is called by ss_shortems().
Mu[0, ..., labK-1] should be assigned before calling this function.
*/
void ss_randomEMinit(double **x, int n, int p, int nclass, double *pi,
double **Mu, double **LTSigma,
int *lab, int labK, int nonlab_total, int *lab_index){
int *ordr, i, j, *clas, *nc;
int new_nclass = nclass - labK;
double labMu[labK][p];
for(i = 0; i < labK; i++){
for(j = 0; j < p; j++) labMu[i][j] = Mu[i][j];
}
/* Initial centers for all other unknown clusters. */
MAKE_VECTOR(ordr, new_nclass);
MAKE_VECTOR(clas, n);
MAKE_VECTOR(nc, nclass);
do{
for(i = 0; i < labK; i++){
for(j = 0; j < p; j++) Mu[i][j] = labMu[i][j];
}
i = srswor(nonlab_total, new_nclass, ordr);
for(i = labK; i < nclass; i++){
for(j = 0; j < p; j++) Mu[i][j] = x[lab_index[ordr[i - labK]]][j];
}
for(i = 0; i < n; i++){
if(lab[i] == -1){
clas[i] = assign_closest(x[i], p, nclass, Mu);
} else{
clas[i] = lab[i];
}
}
j = initials(x, n, p, nclass, nc, Mu, LTSigma, clas);
} while(j == 0);
for(i = 0; i < nclass; i++) pi[i] = 1. * nc[i] / n;
FREE_VECTOR(nc);
FREE_VECTOR(clas);
FREE_VECTOR(ordr);
} /* End of ss_randomEMinit(). */
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 eigens(double *A, double *EVec, double *EVal, int n)
{
double *a;
int i,j;
MAKE_VECTOR(a,n*n);
for(i=0;i<n;i++) {
for(j=0;j<i;j++) {
a[i*n+j]=A[i*(i+1)/2+j];
a[j*n+i]=A[i*(i+1)/2+j];
}
a[i*n+i]=A[i*(i+1)/2+i];
}
i=symeigens(a,n,EVal,EVec);
FREE_VECTOR(a);
return i;
}
double determinant(double *LTSigma,int n)
{
double dum;
/* Bugs: pposymatinv() and posymatinv() in "inverse.c" will modify LTSigma.
Make a copy before call pposymatinv().
Modified: Wei-Chen Chen on 2008/12/03.
pposymatinv(n,LTSigma,'U',&dum);
*/
double *a;
int i;
MAKE_VECTOR(a,n*(n+1)/2);
for (i=0;i<n*(n+1)/2;i++) a[i]=LTSigma[i];
pposymatinv(n,a,'U',&dum);
FREE_VECTOR(a);
return dum;
}
int matinv(int sizeA,double **A,double (*determinant))
{
int i, j , *pivot,N=sizeA*sizeA,size=sizeA;
double *AT,*work; /* AT=transpose vectorized matrix (to accomodate
Fortran)
work=workspace vector */
int INFO,ipiv=1;
MAKE_VECTOR(AT,size*size);
MAKE_VECTOR(work,size*size);
MAKE_VECTOR(pivot,size);
for (i=0; i<size; i++) /* to call a Fortran routine from C */
{ /* have to transform the matrix */
for(j=0; j<size; j++) AT[j+size*i]=A[j][i];
}
dgetrf_(&size,&size,AT,&size,pivot,&INFO);
/* LAPACK routine DGETRF computes an LU factorization of a general
m x n matrix A using partial pivoting with row interchanges. The
factorization has the form A = P * L * U where P is a permutation
matrix, L is lower triangular with unit diagonal elements (lower
trapezoidal if m > n), and U is upper triangular (upper trapezoidal
if m < n). Note that because of the permutation, the determinant
needs to be multiplied by -1 for every interchange that has occurred.
Parameters in the order as they appear in the function call:
number of rows of the matrix A, number of columns of the
matrix A, the matrix A, the leading dimension of A, the
array that records pivoting, and the flag for the
result. On exit, A contains the factors of L and U (with the
diagonals of L not stored).*/
if (INFO==0) {
for(i=0; i<size; i++) {
if (i!=(pivot[i]-1)) ipiv*=-1; /* PIVOT assumes indices are from 1
through N*/
}
(*determinant)=(double)ipiv;
for (i=0; i<size; i++) {
(*determinant)*=AT[i+i*size];
}
dgetri_(&size,AT,&size,pivot,work,&N,&INFO);
/* LAPACK routine DGETRI computes the inverse of a matrix A
using the output of DGETRF. This method inverts U and then
computes A^(-1) by solving A^(-1)L = U^(-1) for A^(-1).
parameters in the order as they appear in the function call:
order of the matrix A, the matrix A, the leading dimension of
A, the array that records pivoting, workspace, the
dimension of the workspace array, and the flag for the
result. On exit, A contains the inverted matrix. */
if (INFO!=0) {
/* Marked by Wei-Chen Chen on 2009/06/07.
* printf("Problem in matinv: dgetri error %d\n",INFO);
*/
}
}
else {
/* Marked by Wei-Chen Chen on 2009/06/07.
* printf("Problem in matinv: dgetrf error %d\n",INFO);
*/
}
for (i=0; i<size; i++) /* to call a Fortran routine from C */
{ /* have to transform the matrix */
for(j=0; j<size; j++) {
A[j][i]=AT[j+size*i];
}
}
FREE_VECTOR(AT);
FREE_VECTOR(pivot);
FREE_VECTOR(work);
return 0;
}
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);
}
