int main()
{
int m, i, n;
double x[MAX_m], w[MAX_m], c[MAX_n+1], eps;
m = 90;
for (i=0; i<m; i++) {
x[i] = 3.1415926535897932 * (double)(i+1) / 180.0;
w[i] = 1.0;
}
eps = 0.001;
n = OPA(f1, m, x, w, c, &eps);
print_results(n, c, eps);
m = 200;
for (i=0; i<m; i++) {
x[i] = 0.01*(double)i;
w[i] = 1.0;
}
eps = 0.001;
n = OPA(f2, m, x, w, c, &eps);
print_results(n, c, eps);
return 0;
}
/* GPA 1 Iteration Function */
void DoGPA1(int *pin, int *kin, int *nin, double *matin, double *res)
{
int i,j,p, k,kk,n;
p=*pin;
k=*kin;
n=*nin;
//Reformat input vector as 3D array
double ***coords;
MAKE_3ARRAY(coords,p,k,n);
for (i=0;i<p;i++){
for (j=0;j<k;j++){
for (kk=0;kk<n;kk++){
coords[i][j][kk]=matin[(kk*p*k)+(j*p)+i];
}
}
}
//Translate specimens to origin
double mncoord[k];
for (i=0;i<n;i++){
for (kk=0;kk<k;kk++){
mncoord[kk]=0;
}
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
mncoord[kk]=mncoord[kk]+ coords[j][kk][i];
}
}
for (kk=0;kk<k;kk++){
mncoord[kk]=mncoord[kk]/p;
}
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
coords[j][kk][i]=coords[j][kk][i]-mncoord[kk];
}
}
}
//Scale specimens to unit centroid-size
double csize;
for (i=0;i<n;i++){
csize=0;
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
csize=csize+ (coords[j][kk][i]*coords[j][kk][i]);
}
}
csize=sqrt(csize);
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
coords[j][kk][i]=coords[j][kk][i]/csize;
}
}
}
// GPA setup
double ref[p][k],S2[p][k];
double *OPAout;
OPAout = (double *)R_alloc(p*k, sizeof(double));
// Initial Rotation to Spec 1=Ref
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
ref[j][kk]=0;
}
}
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
ref[j][kk]=coords[j][kk][0];
}
}
for (i=0;i<n;i++){
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
S2[j][kk]=0;
}
}
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
S2[j][kk]=coords[j][kk][i];
}
}
for (j=0;j<p*k;j++){
OPAout[j]=0;
}
OPA(p, k, ref, S2, OPAout);
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
coords[j][kk][i]=OPAout[(j*k)+kk];
}
}
}
//Re-format results into *res
for (i=0;i<n;i++){
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
res[(i*p*k)+(j*k)+kk]=coords[j][kk][i];
}
}
}
FREE_3ARRAY(coords);
} //end GPA1
/* Main Loop */
void DoGPA(int *pin, int *kin, int *nin, double *matin, double *res)
{
int i,j,jj,mm, p, k,kk,n;
p=*pin;
k=*kin;
n=*nin;
//Reformat input vector as 3D array
double ***coords;
MAKE_3ARRAY(coords,p,k,n);
double ***coords2;
MAKE_3ARRAY(coords2,p,k,n);
for (i=0;i<p;i++){
for (j=0;j<k;j++){
for (kk=0;kk<n;kk++){
coords[i][j][kk]=matin[(kk*p*k)+(j*p)+i];
}
}
}
//Translate specimens to origin
double mncoord[k];
for (i=0;i<n;i++){
for (kk=0;kk<k;kk++){
mncoord[kk]=0;
}
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
mncoord[kk]=mncoord[kk]+ coords[j][kk][i];
}
}
for (kk=0;kk<k;kk++){
mncoord[kk]=mncoord[kk]/p;
}
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
coords[j][kk][i]=coords[j][kk][i]-mncoord[kk];
}
}
}
//Scale specimens to unit centroid-size
double csize;
for (i=0;i<n;i++){
csize=0;
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
csize=csize+ (coords[j][kk][i]*coords[j][kk][i]);
}
}
csize=sqrt(csize);
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
coords[j][kk][i]=coords[j][kk][i]/csize;
coords2[j][kk][i]=coords[j][kk][i];
}
}
}
// GPA setup
int iter, maxiter;
double Q,Q1,Q2,minChange;
double ref[p][k],S2[p][k];
double **DistQ;
MAKE_2ARRAY(DistQ,n,n);
minChange = 0.0001;
Q=0; Q1=0; Q2=0;
iter=0; maxiter=5;
double *OPAout;
OPAout = (double *)R_alloc(p*k, sizeof(double));
//Initial Q
for (j=0;j<n;j++){
for (kk=0;kk<n;kk++){
DistQ[j][kk]=0;
}
}
for (j=0;j<n;j++){
for (kk=0;kk<n;kk++){
for (jj=0;jj<p;jj++){
for (mm=0;mm<k;mm++){
DistQ[j][kk]=DistQ[j][kk]+ (coords[jj][mm][j]-coords[jj][mm][kk])*(coords[jj][mm][j]-coords[jj][mm][kk]);
}
}
}
}
for (j=0;j<n;j++){
for (kk=0;kk<n;kk++){
Q1=Q1+sqrt(DistQ[j][kk]);
}
}
Q1=Q1/2;
Q=Q1;
// Initial Rotation to Spec 1=Ref
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
ref[j][kk]=0;
}
}
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
ref[j][kk]=coords[j][kk][0];
}
}
for (i=0;i<n;i++){
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
S2[j][kk]=0;
}
}
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
S2[j][kk]=coords[j][kk][i];
}
}
for (j=0;j<p*k;j++){
OPAout[j]=0;
}
OPA(p, k, ref, S2, OPAout);
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
coords[j][kk][i]=OPAout[(j*k)+kk];
}
}
}
for (j=0;j<n;j++){
for (kk=0;kk<n;kk++){
DistQ[j][kk]=0;
}
}
for (j=0;j<n;j++){
for (kk=0;kk<n;kk++){
for (jj=0;jj<p;jj++){
for (mm=0;mm<k;mm++){
DistQ[j][kk]=DistQ[j][kk]+ (coords[jj][mm][j]-coords[jj][mm][kk])*(coords[jj][mm][j]-coords[jj][mm][kk]);
}
}
}
}
for (j=0;j<n;j++){
for (kk=0;kk<n;kk++){
Q2=Q2+sqrt(DistQ[j][kk]);
}
}
Q2=Q2/2;
//new check for 1st iteration. If worse, dump and keep old. 9/2015
if (Q2 > Q1){
for (i=0;i<p;i++){
for (j=0;j<k;j++){
for (kk=0;kk<n;kk++){
coords[i][j][kk]=coords2[i][j][kk];
}
}
}
Q=0;}
// if(Q1 < Q2){
else{
Q=Q1-Q2;
Q1=Q2;}
// Rotation iterations
while (Q>minChange){
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
ref[j][kk]=0;
}
}
for (i=0;i<n;i++){
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
ref[j][kk]=ref[j][kk]+coords[j][kk][i]/n;
}
}
}
for (i=0;i<n;i++){
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
S2[j][kk]=0;
}
}
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
S2[j][kk]=coords[j][kk][i];
}
}
for (j=0;j<p*k;j++){
OPAout[j]=0;
}
OPA(p, k, ref, S2, OPAout);
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
coords[j][kk][i]=OPAout[(j*k)+kk];
}
}
}
for (j=0;j<n;j++){
for (kk=0;kk<n;kk++){
DistQ[j][kk]=0;
}
}
for (j=0;j<n;j++){
for (kk=0;kk<n;kk++){
for (jj=0;jj<p;jj++){
for (mm=0;mm<k;mm++){
DistQ[j][kk]=DistQ[j][kk]+ (coords[jj][mm][j]-coords[jj][mm][kk])*(coords[jj][mm][j]-coords[jj][mm][kk]);
}
}
}
}
Q2=0;
for (j=0;j<n;j++){
for (kk=0;kk<n;kk++){
Q2=Q2+sqrt(DistQ[j][kk]);
}
}
Q2=Q2/2;
Q=Q1-Q2;
Q1=Q2;
iter=iter+1;
if(iter==maxiter){Q=0;}
} //End while loop
//Re-format results into *res
for (i=0;i<n;i++){
for (j=0;j<p;j++){
for (kk=0;kk<k;kk++){
res[(i*p*k)+(j*k)+kk]=coords[j][kk][i];
}
}
}
FREE_3ARRAY(coords);
FREE_3ARRAY(coords2);
FREE_2ARRAY(DistQ);
} //end GPA
