int landscape(double *LS, double BETA, int X){ int i, j; int LG = log(X*X)/log(2); size_t x = X; size_t L = X*X; double *phi, **u, **v, **S_f, **p, *w, *y; double z, s; Complex **q; MAKE_1ARRAY(phi,L); MAKE_1ARRAY(w,L); MAKE_1ARRAY(y,L); MAKE_2ARRAY(u,x,x); MAKE_2ARRAY(v,x,x); MAKE_2ARRAY(S_f,x,x); MAKE_2ARRAY(p,x,x); MAKE_2ARRAY(q,x,x); /* Below makes u and its trandpose, v */ for(i=0; i<X; i++){ z = 0; for(j=0; j<(X/2); j++){ u[i][j] = z/X; v[j][i] = z/X; z++; } for(j=(X/2); j<X; j++){ u[i][j] = z/X; v[j][i] = z/X; z--; } } /* Now have matrices u and v */ /* Get the matrix S_f */ for(i=0; i<X; i++){ for(j=0; j<X; j++){ s = (u[i][j]*u[i][j] + v[i][j]*v[i][j]); if(s > 0){ S_f[i][j] = pow(s,(BETA/2)); }else{ S_f[i][j] = 0; } } } /*Matrix S_f made from u and v */ /*Below makes random unifs, phi */ for(i=0; i<L; i++){ phi[i] = randunif(); } /* Puts the random unifs in a matrix */ for(i=0; i<X; i++){ for(j=0; j<X; j++){ p[i][j] = phi[(X*i)+j]; q[i][j] = PrepFFT(S_f[i][j],p[i][j]); w[(X*i)+j] = q[i][j].real; y[(X*i)+j] = q[i][j].img; } } /* Matrix made */ /*Below runs the fast Fourier transformation */ FFT(1,LG,w,y); /*Below puts this in the vector LS */ for(i=0; i<X; i++){ for(j=0; j<X; j++){ LS[(X*i)+j] = w[(X*i)+j]; } } FREE_1ARRAY(w); FREE_1ARRAY(y); FREE_1ARRAY(phi); FREE_2ARRAY(u); FREE_2ARRAY(v); FREE_2ARRAY(S_f); FREE_2ARRAY(p); FREE_2ARRAY(q); return EXIT_SUCCESS; }
void DoSlide(int *ProcDin, int *pin, int *kin, int *nin, double *matin, double *refin, double *res, int *ncurvein, int *curvein, int *nsurfin, int *surfin) { int i,j,p,ii, k,kk,m,jj,n,ProcD,iter; p=*pin; k=*kin; n=*nin; ProcD=*ProcDin; // 1 = ProcD sliding, 0 = BE sliding iter=3; double **U; 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]; } } } double ref[p][k]; for (i=0;i<p;i++){ for (j=0;j<k;j++){ ref[i][j]=refin[(j*p)+i]; } } int ncurve; ncurve = *ncurvein; int **curves=0; if (ncurve >0){ MAKE_2ARRAY(curves,ncurve,3); for (i=0;i<3;i++){ for (j=0;j<ncurve;j++){ curves[j][i]=curvein[(i*ncurve)+j]; } } } int nsurf; nsurf= *nsurfin; int *surf=0; if (nsurf >0){ MAKE_1ARRAY(surf,nsurf); for (i=0;i<nsurf;i++){ surf[i]=surfin[i]; } } int ncolU; // Initialize U ncolU=p; if(nsurf>0){ ncolU= 2*p; } MAKE_2ARRAY(U,(p*k),ncolU); for (ii=0;ii<iter;ii++){ for (i=0;i<n;i++){ for (j=0;j<p*k;j++){ for (kk=0;kk<ncolU;kk++){ U[j][kk]=0; } } if(ncurve > 0){ //Curve portion of U for (j=0;j<ncurve;j++){ U[(curves[j][1]-1)][(curves[j][1]-1)] = coords[(curves[j][2]-1)][0][i]- coords[(curves[j][0]-1)][0][i]; U[(p+curves[j][1]-1)][(curves[j][1]-1)] = coords[(curves[j][2]-1)][1][i]- coords[(curves[j][0]-1)][1][i]; if(k==3){ U[(2*p+curves[j][1]-1)][(curves[j][1]-1)] = coords[(curves[j][2]-1)][2][i]- coords[(curves[j][0]-1)][2][i]; } } } double NNcoords[5][k], NNmn[k]; double *distvec, **distmat; MAKE_2ARRAY(distmat,p,p); MAKE_1ARRAY(distvec,p); double * distvec_p[p]; if(nsurf >0){ //Surface portion of U: find nearest neigbors (from dist.mat), PCA for tangent directions for (j=0;j<p;j++){ for (kk=0;kk<p;kk++){ distmat[j][kk]=0; } } for (j=0;j<p;j++){ for (kk=0;kk<p;kk++){ for (m=0;m<k;m++){ distmat[j][kk]=distmat[j][kk]+((coords[j][m][i]-coords[kk][m][i])*(coords[j][m][i]-coords[kk][m][i])); } } } for (j=0;j<p;j++){ for (kk=0;kk<p;kk++){ distmat[j][kk]=sqrt(distmat[j][kk]); } } for (j=0;j<nsurf;j++){ for (kk=0;kk<p;kk++){ distvec[kk]=0; } for (kk=0;kk<p;kk++){ distvec[kk]=distmat[(surf[j]-1)][kk]; distvec_p[kk]=&distvec[kk]; } qsort(&distvec_p, p, sizeof(double*), compare_doubles); //sort distance to find NN. Put coords in matrix, and column-center double intvec[p]; for(kk=0;kk<p;kk++){ intvec[kk] = (double)(distvec_p[kk] - &distvec[0]); } for (kk=0;kk<5;kk++){ for (m=0;m<k;m++){ NNcoords[kk][m]=0; } } for (kk=0;kk<5;kk++){ for (m=0;m<k;m++){ NNcoords[kk][m]=coords[(int)intvec[kk]][m][i]; } } for (m=0;m<k;m++){ NNmn[m]=0; } for (kk=0;kk<5;kk++){ for (m=0;m<k;m++){ NNmn[m]=NNmn[m]+NNcoords[kk][m]; } } for (m=0;m<k;m++){ NNmn[m]=NNmn[m]/5; } for (kk=0;kk<5;kk++){ for (m=0;m<k;m++){ NNcoords[kk][m]=NNcoords[kk][m]-NNmn[m]; } } double vcv[k][k]; //SVD on VCV matrix from NN for (kk=0;kk<k;kk++){ for (m=0;m<k;m++){ vcv[kk][m]=0; } } for (jj=0;jj<k;jj++){ for (kk=0;kk<k;kk++){ for (m=0;m<5;m++){ vcv[jj][kk]=vcv[jj][kk]+ NNcoords[m][jj]*NNcoords[m][kk]; } } } for (kk=0;kk<k;kk++){ for (m=0;m<k;m++){ vcv[kk][m]=vcv[kk][m]/4; } } double *Umat1, *Vtrans1, *Dmat1; Umat1 = (double *)R_alloc(k*k, sizeof(double)); Vtrans1 = (double *)R_alloc(k*k, sizeof(double)); Dmat1 = (double *)R_alloc(k, sizeof(double)); int info1,lwork1; lwork1= (6*(k)*(k)+6*(k)); int *iwork1; iwork1=calloc(8*k,sizeof(int)); double Work1[lwork1]; char ch='A'; F77_CALL(dgesdd)(&ch,&k,&k,&vcv[0][0],&k,Dmat1,Umat1,&k,Vtrans1,&k,Work1,&lwork1,iwork1,&info1); double PCvec[k][k]; //Assemble PCvectors, dump into U for (jj=0;jj<k;jj++){ for (kk=0;kk<k;kk++){ PCvec[jj][kk]=0; } } for (jj=0;jj<k;jj++){ for (kk=0;kk<k;kk++){ PCvec[kk][jj]=Vtrans1[(kk*k)+jj]; } } U[surf[j]-1][surf[j]-1] = PCvec[0][0]; U[(p+surf[j]-1)][surf[j]-1] = PCvec[1][0]; if(k==3){ U[(2*p+surf[j]-1)][surf[j]-1] = PCvec[2][0]; } U[surf[j]-1][p+surf[j]-1] = PCvec[0][1]; U[(p+surf[j]-1)][p+surf[j]-1] = PCvec[1][1]; if(k==3){ U[(2*p+surf[j]-1)][p+surf[j]-1] = PCvec[2][1]; } } // end j loop } //end if surfin loop double **Usq, *sumUsq; //standardize U MAKE_2ARRAY(Usq,(p*k),ncolU); MAKE_1ARRAY(sumUsq,ncolU); for (j=0;j<(p*k);j++){ for (kk=0;kk<ncolU;kk++){ Usq[j][kk]=0; } } for (j=0;j<(p*k);j++){ for (kk=0;kk<ncolU;kk++){ Usq[j][kk]=U[j][kk]*U[j][kk]; } } for (j=0;j<ncolU;j++){ sumUsq[j]=0; } for (j=0;j<ncolU;j++){ for (kk=0;kk<(p*k);kk++){ sumUsq[j]= sumUsq[j]+Usq[kk][j]; } } for (j=0;j<ncolU;j++){ sumUsq[j]=sqrt(sumUsq[j]); } for (j=0;j<(p*k);j++){ for (kk=0;kk<ncolU;kk++){ if (sumUsq[kk] ==0){U[j][kk]=0;} else{U[j][kk]=U[j][kk]/sumUsq[kk]; } } } FREE_2ARRAY(Usq); FREE_1ARRAY(sumUsq); double *tmpvec, *tmpdiff; MAKE_1ARRAY(tmpvec,p*k); MAKE_1ARRAY(tmpdiff,p*k); for (j=0;j<(p*k);j++){ tmpvec[j]=0; tmpdiff[j]=0; } for (j=0;j<p;j++){ for (kk=0;kk<k;kk++){ tmpvec[kk*p+j] = coords[j][kk][i]; tmpdiff[kk*p+j] = coords[j][kk][i]- ref[j][kk]; } } double **Tpart, *slidvec; MAKE_2ARRAY(Tpart,(p*k),(p*k)); MAKE_1ARRAY(slidvec,p*k); if(ProcD==1){ //ProcD method: Tpart = U%*%t(U) for (j=0;j<(p*k);j++){ for (kk=0;kk<(p*k);kk++){ Tpart[j][kk]=0; } } for (jj=0;jj<(p*k);jj++){ for (kk=0;kk<(p*k);kk++){ for (m=0;m<ncolU;m++){ Tpart[jj][kk]=Tpart[jj][kk] + U[jj][m]*U[kk][m]; } } } } double L[p+k+1][p+k+1]; if(ProcD==0){ //Bending Energy Tpart = U%*% (ginv(t(U)%*%L.inv%*%U) %*%t(U) %*%L.inv) double **Pdist; MAKE_2ARRAY(Pdist,p,p); for (j=0;j<(p*k);j++){ for (kk=0;kk<(p*k);kk++){ Tpart[j][kk]=0; } } for (j=0;j<(p);j++){ for (kk=0;kk<(p);kk++){ Pdist[j][kk]=0; } } for (j=0;j<(p+k+1);j++){ for (kk=0;kk<(p+k+1);kk++){ L[j][kk]=0; } } for (j=0;j<p;j++){ for (kk=0;kk<p;kk++){ for (m=0;m<k;m++){ Pdist[j][kk]=Pdist[j][kk]+((ref[j][m]-ref[kk][m])*(ref[j][m]-ref[kk][m])); } } } for (j=0;j<p;j++){ for (kk=0;kk<p;kk++){ Pdist[j][kk]=sqrt(Pdist[j][kk]); } } for (j=0;j<p;j++){ for (kk=0;kk<p;kk++){ if(k==3){L[j][kk]=Pdist[j][kk]; } else{ L[j][kk]=(Pdist[j][kk]*Pdist[j][kk])*log(Pdist[j][kk]*Pdist[j][kk]);} } } FREE_2ARRAY(Pdist); for (j=0;j<p;j++){ L[j][j]=0; // force diag = 0.0 for 2D data } for (j=0;j<p;j++){ L[j][p]=1; L[p][j]=1; } for (j=0;j<p;j++){ for (kk=0;kk<k;kk++){ L[j][p+1+kk]=ref[j][kk]; L[p+1+kk][j]=ref[j][kk]; } } double *Umat2, *Vtrans2, *Dmat2; Umat2 = (double *)R_alloc((p+k+1)*(p+k+1), sizeof(double)); Vtrans2 = (double *)R_alloc((p+k+1)*(p+k+1), sizeof(double)); Dmat2 = (double *)R_alloc((p+k+1), sizeof(double)); int info2,lwork2; lwork2=(6*(p+k+1)*(p+k+1)+6*(p+k+1)); int *iwork2, Lsize; Lsize=(p+k+1); iwork2=calloc(8*(p+k+1),sizeof(int)); double Work2[lwork2]; char ch1='A'; F77_CALL(dgesdd)(&ch1,&Lsize,&Lsize,&L[0][0],&Lsize,Dmat2,Umat2,&Lsize,Vtrans2,&Lsize,Work2,&lwork2,iwork2,&info2); double **U2, **V2, **Lsolve, **Ltemp, **D2, **BigLinv; MAKE_2ARRAY(U2,(p+k+1),(p+k+1)); MAKE_2ARRAY(V2,(p+k+1),(p+k+1)); MAKE_2ARRAY(Lsolve,(p+k+1),(p+k+1)); MAKE_2ARRAY(Ltemp,(p+k+1),(p+k+1)); MAKE_2ARRAY(D2,(p+k+1),(p+k+1)); MAKE_2ARRAY(BigLinv,(p*k),(p*k)); for (j=0;j<(p+k+1);j++){ for (kk=0;kk<(p+k+1);kk++){ U2[j][kk]=0; V2[j][kk]=0; D2[j][kk]=0; Lsolve[j][kk]=0; Ltemp[j][kk]=0; } } for (j=0;j<(p+k+1);j++){ for (kk=0;kk<(p+k+1);kk++){ U2[kk][j]=Umat2[(kk*(p+k+1))+j]; V2[j][kk]=Vtrans2[(kk*(p+k+1))+j]; } } for (j=0;j<(p+k+1);j++){ D2[j][j]=1/Dmat2[j]; } for (j=0;j<(p+k+1);j++){ for (kk=0;kk<(p+k+1);kk++){ for (m=0;m<(p+k+1);m++){ Ltemp[kk][j]=Ltemp[kk][j]+U2[m][j]*D2[kk][m]; } } } for (j=0;j<(p+k+1);j++){ for (kk=0;kk<(p+k+1);kk++){ for (m=0;m<(p+k+1);m++){ Lsolve[kk][j]=Lsolve[kk][j]+Ltemp[m][j]*V2[m][kk]; //R & C reversed for V2 b/c transpose } } } for (j=0;j<(p*k);j++){ for (kk=0;kk<(p*k);kk++){ BigLinv[j][kk]=0; } } for (j=0;j<p;j++){ for (kk=0;kk<p;kk++){ BigLinv[j][kk]=Lsolve[j][kk]; BigLinv[j+p][kk+p]=Lsolve[j][kk]; if(k==3){ BigLinv[j+2*p][kk+2*p]=Lsolve[j][kk]; } } } FREE_2ARRAY(U2); FREE_2ARRAY(V2); FREE_2ARRAY(Lsolve); FREE_2ARRAY(Ltemp); FREE_2ARRAY(D2); double ULinvU[ncolU][ncolU]; double **ULinv; //**ULinvU; // Tpart for BE = U%*% (ginv(t(U)%*%L.inv%*%U) %*%t(U) %*%L.inv MAKE_2ARRAY(ULinv,ncolU,(p*k)); for (j=0;j<ncolU;j++){ for (kk=0;kk<(p*k);kk++){ ULinv[j][kk]=0; } } for (j=0;j<ncolU;j++){ for (kk=0;kk<ncolU;kk++){ ULinvU[j][kk]=0; } } for (j=0;j<ncolU;j++){ //assemble matrix for 'ginv' for (kk=0;kk<(p*k);kk++){ for (m=0;m<(p*k);m++){ ULinv[j][kk]=ULinv[j][kk]+U[m][j]*BigLinv[kk][m]; } } } for (j=0;j<ncolU;j++){ for (kk=0;kk<ncolU;kk++){ for (m=0;m<(p*k);m++){ ULinvU[j][kk]=ULinvU[j][kk]+ULinv[j][m]*U[m][kk]; } } } FREE_2ARRAY(ULinv); double *Umat3, *Vtrans3, *Dmat3; Umat3 = (double *)R_alloc((ncolU)*(ncolU), sizeof(double)); Vtrans3 = (double *)R_alloc((ncolU)*(ncolU), sizeof(double)); Dmat3 = (double *)R_alloc((ncolU), sizeof(double)); int info3,lwork3; lwork3=(6*(ncolU)*(ncolU)+6*(ncolU)); int *iwork3, Lsize3; Lsize3=(ncolU); iwork3=calloc(8*(ncolU),sizeof(int)); double Work3[lwork3]; char ch3='A'; F77_CALL(dgesdd)(&ch3,&Lsize3,&Lsize3,&ULinvU[0][0],&Lsize3,Dmat3,Umat3,&Lsize3,Vtrans3,&Lsize3,Work3,&lwork3,iwork3,&info3); double tol; double **U3,**V3,**ginv, **ginvtemp,**D3; MAKE_2ARRAY(U3,ncolU,ncolU); MAKE_2ARRAY(V3,ncolU,ncolU); MAKE_2ARRAY(D3,ncolU,ncolU); MAKE_2ARRAY(ginv,ncolU,ncolU); MAKE_2ARRAY(ginvtemp,ncolU,ncolU); tol= 0.000000001; for (j=0;j<(ncolU);j++){ for (kk=0;kk<(ncolU);kk++){ U3[j][kk]=0; V3[j][kk]=0; D3[j][kk]=0; ginv[j][kk]=0; ginvtemp[j][kk]=0; } } for (j=0;j<(ncolU);j++){ for (kk=0;kk<(ncolU);kk++){ U3[kk][j]=Umat3[(kk*(ncolU))+j]; V3[j][kk]=Vtrans3[(kk*(ncolU))+j]; } } for (j=0;j<(ncolU);j++){ if (Dmat3[j] > tol){D3[j][j]=1/Dmat3[j];} else{D3[j][j]=0;} } for (j=0;j<(ncolU);j++){ for (kk=0;kk<(ncolU);kk++){ for (m=0;m<(ncolU);m++){ ginvtemp[kk][j]=ginvtemp[kk][j]+U3[m][j]*D3[kk][m]; } } } for (j=0;j<(ncolU);j++){ for (kk=0;kk<(ncolU);kk++){ for (m=0;m<(ncolU);m++){ ginv[kk][j]=ginv[kk][j]+ginvtemp[m][j]*V3[m][kk]; //R & C reversed for V3 b/c transpose } } } FREE_2ARRAY(U3); FREE_2ARRAY(V3); FREE_2ARRAY(D3); FREE_2ARRAY(ginvtemp); double **ginvU,**ginvULinv; MAKE_2ARRAY(ginvU,ncolU,(p*k)); MAKE_2ARRAY(ginvULinv,ncolU,(p*k)); for (j=0;j<ncolU;j++){ for (kk=0;kk<(p*k);kk++){ ginvU[j][kk]=0; ginvULinv[j][kk]=0; } } for (j=0;j<ncolU;j++){ for (kk=0;kk<(p*k);kk++){ for (m=0;m<ncolU;m++){ ginvU[j][kk]=ginvU[j][kk]+ginv[j][m]*U[kk][m]; } } } for (j=0;j<ncolU;j++){ for (kk=0;kk<(p*k);kk++){ for (m=0;m<(p*k);m++){ ginvULinv[j][kk]=ginvULinv[j][kk]+ginvU[j][m]*BigLinv[m][kk]; } } } for (j=0;j<(p*k);j++){ for (kk=0;kk<(p*k);kk++){ for (m=0;m<ncolU;m++){ Tpart[j][kk]=Tpart[j][kk]+U[j][m]*ginvULinv[m][kk]; } } } for (j=0;j<(p*k);j++){ for (kk=0;kk<(p*k);kk++){ Tpart[j][kk]=Tpart[j][kk]/2; // re-scale } } FREE_2ARRAY(ginv); FREE_2ARRAY(BigLinv); FREE_2ARRAY(ginvU); FREE_2ARRAY(ginvULinv); } //ProcD=0 loop for (j=0;j<(p*k);j++){ //Do sliding slidvec[j]=0; } for (jj=0;jj<(p*k);jj++){ for (kk=0;kk<(p*k);kk++){ slidvec[jj]= slidvec[jj]+ Tpart[jj][kk]*tmpdiff[kk]; } } for (jj=0;jj<(p*k);jj++){ tmpvec[jj]= tmpvec[jj]-slidvec[jj]; } for (j=0;j<k;j++){ for (kk=0;kk<p;kk++){ coords[kk][j][i] = tmpvec[kk+p*j]; } } FREE_2ARRAY(distmat); FREE_1ARRAY(distvec); FREE_2ARRAY(Tpart); FREE_1ARRAY(slidvec); FREE_1ARRAY(tmpvec); FREE_1ARRAY(tmpdiff); }// end i [n] loop double tmpref[p][k]; //find new ref after sliding for (j=0;j<p;j++){ for (kk=0;kk<k;kk++){ tmpref[j][kk]=0; } } for (i=0;i<n;i++){ for (j=0;j<p;j++){ for (kk=0;kk<k;kk++){ tmpref[j][kk]=tmpref[j][kk]+ coords[j][kk][i]; } } } for (j=0;j<p;j++){ for (kk=0;kk<k;kk++){ tmpref[j][kk]=tmpref[j][kk]/n; } } } //end ii loop for (i=0;i<n;i++){ //Re-format results into *res for (j=0;j<p;j++){ for (kk=0;kk<k;kk++){ res[(i*p*k)+(j*k)+kk]=coords[j][kk][i]; } } } FREE_2ARRAY(U); FREE_3ARRAY(coords); FREE_2ARRAY(curves); FREE_1ARRAY(surf); } // end DoSlide