3d0b0bef8daf84cdf544fa2439f3bd55dd1420d0
[alexxy/gromacs.git] / src / gromacs / gmxana / gmx_cluster.c
1 /*
2  * This file is part of the GROMACS molecular simulation package.
3  *
4  * Copyright (c) 1991-2000, University of Groningen, The Netherlands.
5  * Copyright (c) 2001-2004, The GROMACS development team.
6  * Copyright (c) 2013,2014,2015, by the GROMACS development team, led by
7  * Mark Abraham, David van der Spoel, Berk Hess, and Erik Lindahl,
8  * and including many others, as listed in the AUTHORS file in the
9  * top-level source directory and at http://www.gromacs.org.
10  *
11  * GROMACS is free software; you can redistribute it and/or
12  * modify it under the terms of the GNU Lesser General Public License
13  * as published by the Free Software Foundation; either version 2.1
14  * of the License, or (at your option) any later version.
15  *
16  * GROMACS is distributed in the hope that it will be useful,
17  * but WITHOUT ANY WARRANTY; without even the implied warranty of
18  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19  * Lesser General Public License for more details.
20  *
21  * You should have received a copy of the GNU Lesser General Public
22  * License along with GROMACS; if not, see
23  * http://www.gnu.org/licenses, or write to the Free Software Foundation,
24  * Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA.
25  *
26  * If you want to redistribute modifications to GROMACS, please
27  * consider that scientific software is very special. Version
28  * control is crucial - bugs must be traceable. We will be happy to
29  * consider code for inclusion in the official distribution, but
30  * derived work must not be called official GROMACS. Details are found
31  * in the README & COPYING files - if they are missing, get the
32  * official version at http://www.gromacs.org.
33  *
34  * To help us fund GROMACS development, we humbly ask that you cite
35  * the research papers on the package. Check out http://www.gromacs.org.
36  */
37 #include "gmxpre.h"
38
39 #include <math.h>
40 #include <stdlib.h>
41 #include <string.h>
42
43 #include "gromacs/commandline/pargs.h"
44 #include "gromacs/fileio/matio.h"
45 #include "gromacs/fileio/tpxio.h"
46 #include "gromacs/fileio/trnio.h"
47 #include "gromacs/fileio/trxio.h"
48 #include "gromacs/fileio/xvgr.h"
49 #include "gromacs/gmxana/cmat.h"
50 #include "gromacs/gmxana/gmx_ana.h"
51 #include "gromacs/legacyheaders/macros.h"
52 #include "gromacs/legacyheaders/typedefs.h"
53 #include "gromacs/legacyheaders/viewit.h"
54 #include "gromacs/linearalgebra/eigensolver.h"
55 #include "gromacs/math/do_fit.h"
56 #include "gromacs/math/vec.h"
57 #include "gromacs/pbcutil/pbc.h"
58 #include "gromacs/pbcutil/rmpbc.h"
59 #include "gromacs/random/random.h"
60 #include "gromacs/topology/index.h"
61 #include "gromacs/utility/cstringutil.h"
62 #include "gromacs/utility/fatalerror.h"
63 #include "gromacs/utility/futil.h"
64 #include "gromacs/utility/smalloc.h"
65
66 /* print to two file pointers at once (i.e. stderr and log) */
67 static gmx_inline
68 void lo_ffprintf(FILE *fp1, FILE *fp2, const char *buf)
69 {
70     fprintf(fp1, "%s", buf);
71     fprintf(fp2, "%s", buf);
72 }
73
74 /* just print a prepared buffer to fp1 and fp2 */
75 static gmx_inline
76 void ffprintf(FILE *fp1, FILE *fp2, const char *buf)
77 {
78     lo_ffprintf(fp1, fp2, buf);
79 }
80
81 /* prepare buffer with one argument, then print to fp1 and fp2 */
82 static gmx_inline
83 void ffprintf_d(FILE *fp1, FILE *fp2, char *buf, const char *fmt, int arg)
84 {
85     sprintf(buf, fmt, arg);
86     lo_ffprintf(fp1, fp2, buf);
87 }
88
89 /* prepare buffer with one argument, then print to fp1 and fp2 */
90 static gmx_inline
91 void ffprintf_g(FILE *fp1, FILE *fp2, char *buf, const char *fmt, real arg)
92 {
93     sprintf(buf, fmt, arg);
94     lo_ffprintf(fp1, fp2, buf);
95 }
96
97 /* prepare buffer with one argument, then print to fp1 and fp2 */
98 static gmx_inline
99 void ffprintf_s(FILE *fp1, FILE *fp2, char *buf, const char *fmt, const char *arg)
100 {
101     sprintf(buf, fmt, arg);
102     lo_ffprintf(fp1, fp2, buf);
103 }
104
105 /* prepare buffer with two arguments, then print to fp1 and fp2 */
106 static gmx_inline
107 void ffprintf_dd(FILE *fp1, FILE *fp2, char *buf, const char *fmt, int arg1, int arg2)
108 {
109     sprintf(buf, fmt, arg1, arg2);
110     lo_ffprintf(fp1, fp2, buf);
111 }
112
113 /* prepare buffer with two arguments, then print to fp1 and fp2 */
114 static gmx_inline
115 void ffprintf_gg(FILE *fp1, FILE *fp2, char *buf, const char *fmt, real arg1, real arg2)
116 {
117     sprintf(buf, fmt, arg1, arg2);
118     lo_ffprintf(fp1, fp2, buf);
119 }
120
121 /* prepare buffer with two arguments, then print to fp1 and fp2 */
122 static gmx_inline
123 void ffprintf_ss(FILE *fp1, FILE *fp2, char *buf, const char *fmt, const char *arg1, const char *arg2)
124 {
125     sprintf(buf, fmt, arg1, arg2);
126     lo_ffprintf(fp1, fp2, buf);
127 }
128
129 typedef struct {
130     int  ncl;
131     int *cl;
132 } t_clusters;
133
134 typedef struct {
135     int  nr;
136     int *nb;
137 } t_nnb;
138
139 void pr_energy(FILE *fp, real e)
140 {
141     fprintf(fp, "Energy: %8.4f\n", e);
142 }
143
144 void cp_index(int nn, int from[], int to[])
145 {
146     int i;
147
148     for (i = 0; (i < nn); i++)
149     {
150         to[i] = from[i];
151     }
152 }
153
154 void mc_optimize(FILE *log, t_mat *m, real *time,
155                  int maxiter, int nrandom,
156                  int seed, real kT,
157                  const char *conv, output_env_t oenv)
158 {
159     FILE      *fp = NULL;
160     real       ecur, enext, emin, prob, enorm;
161     int        i, j, iswap, jswap, nn, nuphill = 0;
162     gmx_rng_t  rng;
163     t_mat     *minimum;
164
165     if (m->n1 != m->nn)
166     {
167         fprintf(stderr, "Can not do Monte Carlo optimization with a non-square matrix.\n");
168         return;
169     }
170     printf("\nDoing Monte Carlo optimization to find the smoothest trajectory\n");
171     printf("by reordering the frames to minimize the path between the two structures\n");
172     printf("that have the largest pairwise RMSD.\n");
173
174     iswap = jswap = -1;
175     enorm = m->mat[0][0];
176     for (i = 0; (i < m->n1); i++)
177     {
178         for (j = 0; (j < m->nn); j++)
179         {
180             if (m->mat[i][j] > enorm)
181             {
182                 enorm   = m->mat[i][j];
183                 iswap   = i;
184                 jswap   = j;
185             }
186         }
187     }
188     if ((iswap == -1) || (jswap == -1))
189     {
190         fprintf(stderr, "Matrix contains identical values in all fields\n");
191         return;
192     }
193     swap_rows(m, 0, iswap);
194     swap_rows(m, m->n1-1, jswap);
195     emin = ecur = mat_energy(m);
196     printf("Largest distance %g between %d and %d. Energy: %g.\n",
197            enorm, iswap, jswap, emin);
198
199     rng = gmx_rng_init(seed);
200     nn  = m->nn;
201
202     /* Initiate and store global minimum */
203     minimum     = init_mat(nn, m->b1D);
204     minimum->nn = nn;
205     copy_t_mat(minimum, m);
206
207     if (NULL != conv)
208     {
209         fp = xvgropen(conv, "Convergence of the MC optimization",
210                       "Energy", "Step", oenv);
211     }
212     for (i = 0; (i < maxiter); i++)
213     {
214         /* Generate new swapping candidates */
215         do
216         {
217             iswap = 1+(nn-2)*gmx_rng_uniform_real(rng);
218             jswap = 1+(nn-2)*gmx_rng_uniform_real(rng);
219         }
220         while ((iswap == jswap) || (iswap >= nn-1) || (jswap >= nn-1));
221
222         /* Apply swap and compute energy */
223         swap_rows(m, iswap, jswap);
224         enext = mat_energy(m);
225
226         /* Compute probability */
227         prob = 0;
228         if ((enext < ecur) || (i < nrandom))
229         {
230             prob = 1;
231             if (enext < emin)
232             {
233                 /* Store global minimum */
234                 copy_t_mat(minimum, m);
235                 emin = enext;
236             }
237         }
238         else if (kT > 0)
239         {
240             /* Try Monte Carlo step */
241             prob = exp(-(enext-ecur)/(enorm*kT));
242         }
243
244         if ((prob == 1) || (gmx_rng_uniform_real(rng) < prob))
245         {
246             if (enext > ecur)
247             {
248                 nuphill++;
249             }
250
251             fprintf(log, "Iter: %d Swapped %4d and %4d (energy: %g prob: %g)\n",
252                     i, iswap, jswap, enext, prob);
253             if (NULL != fp)
254             {
255                 fprintf(fp, "%6d  %10g\n", i, enext);
256             }
257             ecur = enext;
258         }
259         else
260         {
261             swap_rows(m, jswap, iswap);
262         }
263     }
264     fprintf(log, "%d uphill steps were taken during optimization\n",
265             nuphill);
266
267     /* Now swap the matrix to get it into global minimum mode */
268     copy_t_mat(m, minimum);
269
270     fprintf(log, "Global minimum energy %g\n", mat_energy(minimum));
271     fprintf(log, "Global minimum energy %g\n", mat_energy(m));
272     fprintf(log, "Swapped time and frame indices and RMSD to next neighbor:\n");
273     for (i = 0; (i < m->nn); i++)
274     {
275         fprintf(log, "%10g  %5d  %10g\n",
276                 time[m->m_ind[i]],
277                 m->m_ind[i],
278                 (i < m->nn-1) ? m->mat[m->m_ind[i]][m->m_ind[i+1]] : 0);
279     }
280
281     if (NULL != fp)
282     {
283         xvgrclose(fp);
284     }
285 }
286
287 static void calc_dist(int nind, rvec x[], real **d)
288 {
289     int      i, j;
290     real    *xi;
291     rvec     dx;
292
293     for (i = 0; (i < nind-1); i++)
294     {
295         xi = x[i];
296         for (j = i+1; (j < nind); j++)
297         {
298             /* Should use pbc_dx when analysing multiple molecueles,
299              * but the box is not stored for every frame.
300              */
301             rvec_sub(xi, x[j], dx);
302             d[i][j] = norm(dx);
303         }
304     }
305 }
306
307 static real rms_dist(int isize, real **d, real **d_r)
308 {
309     int  i, j;
310     real r, r2;
311
312     r2 = 0.0;
313     for (i = 0; (i < isize-1); i++)
314     {
315         for (j = i+1; (j < isize); j++)
316         {
317             r   = d[i][j]-d_r[i][j];
318             r2 += r*r;
319         }
320     }
321     r2 /= (isize*(isize-1))/2;
322
323     return sqrt(r2);
324 }
325
326 static int rms_dist_comp(const void *a, const void *b)
327 {
328     t_dist *da, *db;
329
330     da = (t_dist *)a;
331     db = (t_dist *)b;
332
333     if (da->dist - db->dist < 0)
334     {
335         return -1;
336     }
337     else if (da->dist - db->dist > 0)
338     {
339         return 1;
340     }
341     return 0;
342 }
343
344 static int clust_id_comp(const void *a, const void *b)
345 {
346     t_clustid *da, *db;
347
348     da = (t_clustid *)a;
349     db = (t_clustid *)b;
350
351     return da->clust - db->clust;
352 }
353
354 static int nrnb_comp(const void *a, const void *b)
355 {
356     t_nnb *da, *db;
357
358     da = (t_nnb *)a;
359     db = (t_nnb *)b;
360
361     /* return the b-a, we want highest first */
362     return db->nr - da->nr;
363 }
364
365 void gather(t_mat *m, real cutoff, t_clusters *clust)
366 {
367     t_clustid *c;
368     t_dist    *d;
369     int        i, j, k, nn, cid, n1, diff;
370     gmx_bool   bChange;
371
372     /* First we sort the entries in the RMSD matrix */
373     n1 = m->nn;
374     nn = ((n1-1)*n1)/2;
375     snew(d, nn);
376     for (i = k = 0; (i < n1); i++)
377     {
378         for (j = i+1; (j < n1); j++, k++)
379         {
380             d[k].i    = i;
381             d[k].j    = j;
382             d[k].dist = m->mat[i][j];
383         }
384     }
385     if (k != nn)
386     {
387         gmx_incons("gather algortihm");
388     }
389     qsort(d, nn, sizeof(d[0]), rms_dist_comp);
390
391     /* Now we make a cluster index for all of the conformations */
392     c = new_clustid(n1);
393
394     /* Now we check the closest structures, and equalize their cluster numbers */
395     fprintf(stderr, "Linking structures ");
396     do
397     {
398         fprintf(stderr, "*");
399         bChange = FALSE;
400         for (k = 0; (k < nn) && (d[k].dist < cutoff); k++)
401         {
402             diff = c[d[k].j].clust - c[d[k].i].clust;
403             if (diff)
404             {
405                 bChange = TRUE;
406                 if (diff > 0)
407                 {
408                     c[d[k].j].clust = c[d[k].i].clust;
409                 }
410                 else
411                 {
412                     c[d[k].i].clust = c[d[k].j].clust;
413                 }
414             }
415         }
416     }
417     while (bChange);
418     fprintf(stderr, "\nSorting and renumbering clusters\n");
419     /* Sort on cluster number */
420     qsort(c, n1, sizeof(c[0]), clust_id_comp);
421
422     /* Renumber clusters */
423     cid = 1;
424     for (k = 1; k < n1; k++)
425     {
426         if (c[k].clust != c[k-1].clust)
427         {
428             c[k-1].clust = cid;
429             cid++;
430         }
431         else
432         {
433             c[k-1].clust = cid;
434         }
435     }
436     c[k-1].clust = cid;
437     if (debug)
438     {
439         for (k = 0; (k < n1); k++)
440         {
441             fprintf(debug, "Cluster index for conformation %d: %d\n",
442                     c[k].conf, c[k].clust);
443         }
444     }
445     clust->ncl = cid;
446     for (k = 0; k < n1; k++)
447     {
448         clust->cl[c[k].conf] = c[k].clust;
449     }
450
451     sfree(c);
452     sfree(d);
453 }
454
455 gmx_bool jp_same(int **nnb, int i, int j, int P)
456 {
457     gmx_bool bIn;
458     int      k, ii, jj, pp;
459
460     bIn = FALSE;
461     for (k = 0; nnb[i][k] >= 0; k++)
462     {
463         bIn = bIn || (nnb[i][k] == j);
464     }
465     if (!bIn)
466     {
467         return FALSE;
468     }
469
470     bIn = FALSE;
471     for (k = 0; nnb[j][k] >= 0; k++)
472     {
473         bIn = bIn || (nnb[j][k] == i);
474     }
475     if (!bIn)
476     {
477         return FALSE;
478     }
479
480     pp = 0;
481     for (ii = 0; nnb[i][ii] >= 0; ii++)
482     {
483         for (jj = 0; nnb[j][jj] >= 0; jj++)
484         {
485             if ((nnb[i][ii] == nnb[j][jj]) && (nnb[i][ii] != -1))
486             {
487                 pp++;
488             }
489         }
490     }
491
492     return (pp >= P);
493 }
494
495 static void jarvis_patrick(int n1, real **mat, int M, int P,
496                            real rmsdcut, t_clusters *clust)
497 {
498     t_dist     *row;
499     t_clustid  *c;
500     int       **nnb;
501     int         i, j, k, cid, diff, max;
502     gmx_bool    bChange;
503     real      **mcpy = NULL;
504
505     if (rmsdcut < 0)
506     {
507         rmsdcut = 10000;
508     }
509
510     /* First we sort the entries in the RMSD matrix row by row.
511      * This gives us the nearest neighbor list.
512      */
513     snew(nnb, n1);
514     snew(row, n1);
515     for (i = 0; (i < n1); i++)
516     {
517         for (j = 0; (j < n1); j++)
518         {
519             row[j].j    = j;
520             row[j].dist = mat[i][j];
521         }
522         qsort(row, n1, sizeof(row[0]), rms_dist_comp);
523         if (M > 0)
524         {
525             /* Put the M nearest neighbors in the list */
526             snew(nnb[i], M+1);
527             for (j = k = 0; (k < M) && (j < n1) && (mat[i][row[j].j] < rmsdcut); j++)
528             {
529                 if (row[j].j  != i)
530                 {
531                     nnb[i][k]  = row[j].j;
532                     k++;
533                 }
534             }
535             nnb[i][k] = -1;
536         }
537         else
538         {
539             /* Put all neighbors nearer than rmsdcut in the list */
540             max = 0;
541             k   = 0;
542             for (j = 0; (j < n1) && (mat[i][row[j].j] < rmsdcut); j++)
543             {
544                 if (row[j].j != i)
545                 {
546                     if (k >= max)
547                     {
548                         max += 10;
549                         srenew(nnb[i], max);
550                     }
551                     nnb[i][k] = row[j].j;
552                     k++;
553                 }
554             }
555             if (k == max)
556             {
557                 srenew(nnb[i], max+1);
558             }
559             nnb[i][k] = -1;
560         }
561     }
562     sfree(row);
563     if (debug)
564     {
565         fprintf(debug, "Nearest neighborlist. M = %d, P = %d\n", M, P);
566         for (i = 0; (i < n1); i++)
567         {
568             fprintf(debug, "i:%5d nbs:", i);
569             for (j = 0; nnb[i][j] >= 0; j++)
570             {
571                 fprintf(debug, "%5d[%5.3f]", nnb[i][j], mat[i][nnb[i][j]]);
572             }
573             fprintf(debug, "\n");
574         }
575     }
576
577     c = new_clustid(n1);
578     fprintf(stderr, "Linking structures ");
579     /* Use mcpy for temporary storage of booleans */
580     mcpy = mk_matrix(n1, n1, FALSE);
581     for (i = 0; i < n1; i++)
582     {
583         for (j = i+1; j < n1; j++)
584         {
585             mcpy[i][j] = jp_same(nnb, i, j, P);
586         }
587     }
588     do
589     {
590         fprintf(stderr, "*");
591         bChange = FALSE;
592         for (i = 0; i < n1; i++)
593         {
594             for (j = i+1; j < n1; j++)
595             {
596                 if (mcpy[i][j])
597                 {
598                     diff = c[j].clust - c[i].clust;
599                     if (diff)
600                     {
601                         bChange = TRUE;
602                         if (diff > 0)
603                         {
604                             c[j].clust = c[i].clust;
605                         }
606                         else
607                         {
608                             c[i].clust = c[j].clust;
609                         }
610                     }
611                 }
612             }
613         }
614     }
615     while (bChange);
616
617     fprintf(stderr, "\nSorting and renumbering clusters\n");
618     /* Sort on cluster number */
619     qsort(c, n1, sizeof(c[0]), clust_id_comp);
620
621     /* Renumber clusters */
622     cid = 1;
623     for (k = 1; k < n1; k++)
624     {
625         if (c[k].clust != c[k-1].clust)
626         {
627             c[k-1].clust = cid;
628             cid++;
629         }
630         else
631         {
632             c[k-1].clust = cid;
633         }
634     }
635     c[k-1].clust = cid;
636     clust->ncl   = cid;
637     for (k = 0; k < n1; k++)
638     {
639         clust->cl[c[k].conf] = c[k].clust;
640     }
641     if (debug)
642     {
643         for (k = 0; (k < n1); k++)
644         {
645             fprintf(debug, "Cluster index for conformation %d: %d\n",
646                     c[k].conf, c[k].clust);
647         }
648     }
649
650 /* Again, I don't see the point in this... (AF) */
651 /*   for(i=0; (i<n1); i++) { */
652 /*     for(j=0; (j<n1); j++) */
653 /*       mcpy[c[i].conf][c[j].conf] = mat[i][j]; */
654 /*   } */
655 /*   for(i=0; (i<n1); i++) { */
656 /*     for(j=0; (j<n1); j++) */
657 /*       mat[i][j] = mcpy[i][j]; */
658 /*   } */
659     done_matrix(n1, &mcpy);
660
661     sfree(c);
662     for (i = 0; (i < n1); i++)
663     {
664         sfree(nnb[i]);
665     }
666     sfree(nnb);
667 }
668
669 static void dump_nnb (FILE *fp, const char *title, int n1, t_nnb *nnb)
670 {
671     int i, j;
672
673     /* dump neighbor list */
674     fprintf(fp, "%s", title);
675     for (i = 0; (i < n1); i++)
676     {
677         fprintf(fp, "i:%5d #:%5d nbs:", i, nnb[i].nr);
678         for (j = 0; j < nnb[i].nr; j++)
679         {
680             fprintf(fp, "%5d", nnb[i].nb[j]);
681         }
682         fprintf(fp, "\n");
683     }
684 }
685
686 static void gromos(int n1, real **mat, real rmsdcut, t_clusters *clust)
687 {
688     t_dist *row;
689     t_nnb  *nnb;
690     int     i, j, k, j1, max;
691
692     /* Put all neighbors nearer than rmsdcut in the list */
693     fprintf(stderr, "Making list of neighbors within cutoff ");
694     snew(nnb, n1);
695     snew(row, n1);
696     for (i = 0; (i < n1); i++)
697     {
698         max = 0;
699         k   = 0;
700         /* put all neighbors within cut-off in list */
701         for (j = 0; j < n1; j++)
702         {
703             if (mat[i][j] < rmsdcut)
704             {
705                 if (k >= max)
706                 {
707                     max += 10;
708                     srenew(nnb[i].nb, max);
709                 }
710                 nnb[i].nb[k] = j;
711                 k++;
712             }
713         }
714         /* store nr of neighbors, we'll need that */
715         nnb[i].nr = k;
716         if (i%(1+n1/100) == 0)
717         {
718             fprintf(stderr, "%3d%%\b\b\b\b", (i*100+1)/n1);
719         }
720     }
721     fprintf(stderr, "%3d%%\n", 100);
722     sfree(row);
723
724     /* sort neighbor list on number of neighbors, largest first */
725     qsort(nnb, n1, sizeof(nnb[0]), nrnb_comp);
726
727     if (debug)
728     {
729         dump_nnb(debug, "Nearest neighborlist after sort.\n", n1, nnb);
730     }
731
732     /* turn first structure with all its neighbors (largest) into cluster
733        remove them from pool of structures and repeat for all remaining */
734     fprintf(stderr, "Finding clusters %4d", 0);
735     /* cluster id's start at 1: */
736     k = 1;
737     while (nnb[0].nr)
738     {
739         /* set cluster id (k) for first item in neighborlist */
740         for (j = 0; j < nnb[0].nr; j++)
741         {
742             clust->cl[nnb[0].nb[j]] = k;
743         }
744         /* mark as done */
745         nnb[0].nr = 0;
746         sfree(nnb[0].nb);
747
748         /* adjust number of neighbors for others, taking removals into account: */
749         for (i = 1; i < n1 && nnb[i].nr; i++)
750         {
751             j1 = 0;
752             for (j = 0; j < nnb[i].nr; j++)
753             {
754                 /* if this neighbor wasn't removed */
755                 if (clust->cl[nnb[i].nb[j]] == 0)
756                 {
757                     /* shift the rest (j1<=j) */
758                     nnb[i].nb[j1] = nnb[i].nb[j];
759                     /* next */
760                     j1++;
761                 }
762             }
763             /* now j1 is the new number of neighbors */
764             nnb[i].nr = j1;
765         }
766         /* sort again on nnb[].nr, because we have new # neighbors: */
767         /* but we only need to sort upto i, i.e. when nnb[].nr>0 */
768         qsort(nnb, i, sizeof(nnb[0]), nrnb_comp);
769
770         fprintf(stderr, "\b\b\b\b%4d", k);
771         /* new cluster id */
772         k++;
773     }
774     fprintf(stderr, "\n");
775     sfree(nnb);
776     if (debug)
777     {
778         fprintf(debug, "Clusters (%d):\n", k);
779         for (i = 0; i < n1; i++)
780         {
781             fprintf(debug, " %3d", clust->cl[i]);
782         }
783         fprintf(debug, "\n");
784     }
785
786     clust->ncl = k-1;
787 }
788
789 rvec **read_whole_trj(const char *fn, int isize, atom_id index[], int skip,
790                       int *nframe, real **time, const output_env_t oenv, gmx_bool bPBC, gmx_rmpbc_t gpbc)
791 {
792     rvec       **xx, *x;
793     matrix       box;
794     real         t;
795     int          i, i0, j, max_nf;
796     int          natom;
797     t_trxstatus *status;
798
799
800     max_nf = 0;
801     xx     = NULL;
802     *time  = NULL;
803     natom  = read_first_x(oenv, &status, fn, &t, &x, box);
804     i      = 0;
805     i0     = 0;
806     do
807     {
808         if (bPBC)
809         {
810             gmx_rmpbc(gpbc, natom, box, x);
811         }
812         if (i0 >= max_nf)
813         {
814             max_nf += 10;
815             srenew(xx, max_nf);
816             srenew(*time, max_nf);
817         }
818         if ((i % skip) == 0)
819         {
820             snew(xx[i0], isize);
821             /* Store only the interesting atoms */
822             for (j = 0; (j < isize); j++)
823             {
824                 copy_rvec(x[index[j]], xx[i0][j]);
825             }
826             (*time)[i0] = t;
827             i0++;
828         }
829         i++;
830     }
831     while (read_next_x(oenv, status, &t, x, box));
832     fprintf(stderr, "Allocated %lu bytes for frames\n",
833             (unsigned long) (max_nf*isize*sizeof(**xx)));
834     fprintf(stderr, "Read %d frames from trajectory %s\n", i0, fn);
835     *nframe = i0;
836     sfree(x);
837
838     return xx;
839 }
840
841 static int plot_clusters(int nf, real **mat, t_clusters *clust,
842                          int minstruct)
843 {
844     int  i, j, ncluster, ci;
845     int *cl_id, *nstruct, *strind;
846
847     snew(cl_id, nf);
848     snew(nstruct, nf);
849     snew(strind, nf);
850     for (i = 0; i < nf; i++)
851     {
852         strind[i] = 0;
853         cl_id[i]  = clust->cl[i];
854         nstruct[cl_id[i]]++;
855     }
856     ncluster = 0;
857     for (i = 0; i < nf; i++)
858     {
859         if (nstruct[i] >= minstruct)
860         {
861             ncluster++;
862             for (j = 0; (j < nf); j++)
863             {
864                 if (cl_id[j] == i)
865                 {
866                     strind[j] = ncluster;
867                 }
868             }
869         }
870     }
871     ncluster++;
872     fprintf(stderr, "There are %d clusters with at least %d conformations\n",
873             ncluster, minstruct);
874
875     for (i = 0; (i < nf); i++)
876     {
877         ci = cl_id[i];
878         for (j = 0; j < i; j++)
879         {
880             if ((ci == cl_id[j]) && (nstruct[ci] >= minstruct))
881             {
882                 /* color different clusters with different colors, as long as
883                    we don't run out of colors */
884                 mat[i][j] = strind[i];
885             }
886             else
887             {
888                 mat[i][j] = 0;
889             }
890         }
891     }
892     sfree(strind);
893     sfree(nstruct);
894     sfree(cl_id);
895
896     return ncluster;
897 }
898
899 static void mark_clusters(int nf, real **mat, real val, t_clusters *clust)
900 {
901     int i, j, v;
902
903     for (i = 0; i < nf; i++)
904     {
905         for (j = 0; j < i; j++)
906         {
907             if (clust->cl[i] == clust->cl[j])
908             {
909                 mat[i][j] = val;
910             }
911             else
912             {
913                 mat[i][j] = 0;
914             }
915         }
916     }
917 }
918
919 static char *parse_filename(const char *fn, int maxnr)
920 {
921     int         i;
922     char       *fnout;
923     const char *ext;
924     char        buf[STRLEN];
925
926     if (strchr(fn, '%'))
927     {
928         gmx_fatal(FARGS, "will not number filename %s containing '%c'", fn, '%');
929     }
930     /* number of digits needed in numbering */
931     i = (int)(log(maxnr)/log(10)) + 1;
932     /* split fn and ext */
933     ext = strrchr(fn, '.');
934     if (!ext)
935     {
936         gmx_fatal(FARGS, "cannot separate extension in filename %s", fn);
937     }
938     ext++;
939     /* insert e.g. '%03d' between fn and ext */
940     sprintf(buf, "%s%%0%dd.%s", fn, i, ext);
941     snew(fnout, strlen(buf)+1);
942     strcpy(fnout, buf);
943
944     return fnout;
945 }
946
947 static void ana_trans(t_clusters *clust, int nf,
948                       const char *transfn, const char *ntransfn, FILE *log,
949                       t_rgb rlo, t_rgb rhi, const output_env_t oenv)
950 {
951     FILE  *fp;
952     real **trans, *axis;
953     int   *ntrans;
954     int    i, ntranst, maxtrans;
955     char   buf[STRLEN];
956
957     snew(ntrans, clust->ncl);
958     snew(trans, clust->ncl);
959     snew(axis, clust->ncl);
960     for (i = 0; i < clust->ncl; i++)
961     {
962         axis[i] = i+1;
963         snew(trans[i], clust->ncl);
964     }
965     ntranst  = 0;
966     maxtrans = 0;
967     for (i = 1; i < nf; i++)
968     {
969         if (clust->cl[i] != clust->cl[i-1])
970         {
971             ntranst++;
972             ntrans[clust->cl[i-1]-1]++;
973             ntrans[clust->cl[i]-1]++;
974             trans[clust->cl[i-1]-1][clust->cl[i]-1]++;
975             maxtrans = max(maxtrans, trans[clust->cl[i]-1][clust->cl[i-1]-1]);
976         }
977     }
978     ffprintf_dd(stderr, log, buf, "Counted %d transitions in total, "
979                 "max %d between two specific clusters\n", ntranst, maxtrans);
980     if (transfn)
981     {
982         fp = gmx_ffopen(transfn, "w");
983         i  = min(maxtrans+1, 80);
984         write_xpm(fp, 0, "Cluster Transitions", "# transitions",
985                   "from cluster", "to cluster",
986                   clust->ncl, clust->ncl, axis, axis, trans,
987                   0, maxtrans, rlo, rhi, &i);
988         gmx_ffclose(fp);
989     }
990     if (ntransfn)
991     {
992         fp = xvgropen(ntransfn, "Cluster Transitions", "Cluster #", "# transitions",
993                       oenv);
994         for (i = 0; i < clust->ncl; i++)
995         {
996             fprintf(fp, "%5d %5d\n", i+1, ntrans[i]);
997         }
998         xvgrclose(fp);
999     }
1000     sfree(ntrans);
1001     for (i = 0; i < clust->ncl; i++)
1002     {
1003         sfree(trans[i]);
1004     }
1005     sfree(trans);
1006     sfree(axis);
1007 }
1008
1009 static void analyze_clusters(int nf, t_clusters *clust, real **rmsd,
1010                              int natom, t_atoms *atoms, rvec *xtps,
1011                              real *mass, rvec **xx, real *time,
1012                              int ifsize, atom_id *fitidx,
1013                              int iosize, atom_id *outidx,
1014                              const char *trxfn, const char *sizefn,
1015                              const char *transfn, const char *ntransfn,
1016                              const char *clustidfn, gmx_bool bAverage,
1017                              int write_ncl, int write_nst, real rmsmin,
1018                              gmx_bool bFit, FILE *log, t_rgb rlo, t_rgb rhi,
1019                              const output_env_t oenv)
1020 {
1021     FILE        *fp = NULL;
1022     char         buf[STRLEN], buf1[40], buf2[40], buf3[40], *trxsfn;
1023     t_trxstatus *trxout  = NULL;
1024     t_trxstatus *trxsout = NULL;
1025     int          i, i1, cl, nstr, *structure, first = 0, midstr;
1026     gmx_bool    *bWrite = NULL;
1027     real         r, clrmsd, midrmsd;
1028     rvec        *xav = NULL;
1029     matrix       zerobox;
1030
1031     clear_mat(zerobox);
1032
1033     ffprintf_d(stderr, log, buf, "\nFound %d clusters\n\n", clust->ncl);
1034     trxsfn = NULL;
1035     if (trxfn)
1036     {
1037         /* do we write all structures? */
1038         if (write_ncl)
1039         {
1040             trxsfn = parse_filename(trxfn, max(write_ncl, clust->ncl));
1041             snew(bWrite, nf);
1042         }
1043         ffprintf_ss(stderr, log, buf, "Writing %s structure for each cluster to %s\n",
1044                     bAverage ? "average" : "middle", trxfn);
1045         if (write_ncl)
1046         {
1047             /* find out what we want to tell the user:
1048                Writing [all structures|structures with rmsd > %g] for
1049                {all|first %d} clusters {with more than %d structures} to %s     */
1050             if (rmsmin > 0.0)
1051             {
1052                 sprintf(buf1, "structures with rmsd > %g", rmsmin);
1053             }
1054             else
1055             {
1056                 sprintf(buf1, "all structures");
1057             }
1058             buf2[0] = buf3[0] = '\0';
1059             if (write_ncl >= clust->ncl)
1060             {
1061                 if (write_nst == 0)
1062                 {
1063                     sprintf(buf2, "all ");
1064                 }
1065             }
1066             else
1067             {
1068                 sprintf(buf2, "the first %d ", write_ncl);
1069             }
1070             if (write_nst)
1071             {
1072                 sprintf(buf3, " with more than %d structures", write_nst);
1073             }
1074             sprintf(buf, "Writing %s for %sclusters%s to %s\n", buf1, buf2, buf3, trxsfn);
1075             ffprintf(stderr, log, buf);
1076         }
1077
1078         /* Prepare a reference structure for the orientation of the clusters  */
1079         if (bFit)
1080         {
1081             reset_x(ifsize, fitidx, natom, NULL, xtps, mass);
1082         }
1083         trxout = open_trx(trxfn, "w");
1084         /* Calculate the average structure in each cluster,               *
1085          * all structures are fitted to the first struture of the cluster */
1086         snew(xav, natom);
1087     }
1088
1089     if (transfn || ntransfn)
1090     {
1091         ana_trans(clust, nf, transfn, ntransfn, log, rlo, rhi, oenv);
1092     }
1093
1094     if (clustidfn)
1095     {
1096         fp = xvgropen(clustidfn, "Clusters", output_env_get_xvgr_tlabel(oenv), "Cluster #", oenv);
1097         if (output_env_get_print_xvgr_codes(oenv))
1098         {
1099             fprintf(fp, "@    s0 symbol 2\n");
1100             fprintf(fp, "@    s0 symbol size 0.2\n");
1101             fprintf(fp, "@    s0 linestyle 0\n");
1102         }
1103         for (i = 0; i < nf; i++)
1104         {
1105             fprintf(fp, "%8g %8d\n", time[i], clust->cl[i]);
1106         }
1107         xvgrclose(fp);
1108     }
1109     if (sizefn)
1110     {
1111         /* FIXME: This file is never closed. */
1112         fp = xvgropen(sizefn, "Cluster Sizes", "Cluster #", "# Structures", oenv);
1113         if (output_env_get_print_xvgr_codes(oenv))
1114         {
1115             fprintf(fp, "@g%d type %s\n", 0, "bar");
1116         }
1117     }
1118     snew(structure, nf);
1119     fprintf(log, "\n%3s | %3s  %4s | %6s %4s | cluster members\n",
1120             "cl.", "#st", "rmsd", "middle", "rmsd");
1121     for (cl = 1; cl <= clust->ncl; cl++)
1122     {
1123         /* prepare structures (fit, middle, average) */
1124         if (xav)
1125         {
1126             for (i = 0; i < natom; i++)
1127             {
1128                 clear_rvec(xav[i]);
1129             }
1130         }
1131         nstr = 0;
1132         for (i1 = 0; i1 < nf; i1++)
1133         {
1134             if (clust->cl[i1] == cl)
1135             {
1136                 structure[nstr] = i1;
1137                 nstr++;
1138                 if (trxfn && (bAverage || write_ncl) )
1139                 {
1140                     if (bFit)
1141                     {
1142                         reset_x(ifsize, fitidx, natom, NULL, xx[i1], mass);
1143                     }
1144                     if (nstr == 1)
1145                     {
1146                         first = i1;
1147                     }
1148                     else if (bFit)
1149                     {
1150                         do_fit(natom, mass, xx[first], xx[i1]);
1151                     }
1152                     if (xav)
1153                     {
1154                         for (i = 0; i < natom; i++)
1155                         {
1156                             rvec_inc(xav[i], xx[i1][i]);
1157                         }
1158                     }
1159                 }
1160             }
1161         }
1162         if (sizefn)
1163         {
1164             fprintf(fp, "%8d %8d\n", cl, nstr);
1165         }
1166         clrmsd  = 0;
1167         midstr  = 0;
1168         midrmsd = 10000;
1169         for (i1 = 0; i1 < nstr; i1++)
1170         {
1171             r = 0;
1172             if (nstr > 1)
1173             {
1174                 for (i = 0; i < nstr; i++)
1175                 {
1176                     if (i < i1)
1177                     {
1178                         r += rmsd[structure[i]][structure[i1]];
1179                     }
1180                     else
1181                     {
1182                         r += rmsd[structure[i1]][structure[i]];
1183                     }
1184                 }
1185                 r /= (nstr - 1);
1186             }
1187             if (r < midrmsd)
1188             {
1189                 midstr  = structure[i1];
1190                 midrmsd = r;
1191             }
1192             clrmsd += r;
1193         }
1194         clrmsd /= nstr;
1195
1196         /* dump cluster info to logfile */
1197         if (nstr > 1)
1198         {
1199             sprintf(buf1, "%6.3f", clrmsd);
1200             if (buf1[0] == '0')
1201             {
1202                 buf1[0] = ' ';
1203             }
1204             sprintf(buf2, "%5.3f", midrmsd);
1205             if (buf2[0] == '0')
1206             {
1207                 buf2[0] = ' ';
1208             }
1209         }
1210         else
1211         {
1212             sprintf(buf1, "%5s", "");
1213             sprintf(buf2, "%5s", "");
1214         }
1215         fprintf(log, "%3d | %3d %s | %6g%s |", cl, nstr, buf1, time[midstr], buf2);
1216         for (i = 0; i < nstr; i++)
1217         {
1218             if ((i % 7 == 0) && i)
1219             {
1220                 sprintf(buf, "\n%3s | %3s  %4s | %6s %4s |", "", "", "", "", "");
1221             }
1222             else
1223             {
1224                 buf[0] = '\0';
1225             }
1226             i1 = structure[i];
1227             fprintf(log, "%s %6g", buf, time[i1]);
1228         }
1229         fprintf(log, "\n");
1230
1231         /* write structures to trajectory file(s) */
1232         if (trxfn)
1233         {
1234             if (write_ncl)
1235             {
1236                 for (i = 0; i < nstr; i++)
1237                 {
1238                     bWrite[i] = FALSE;
1239                 }
1240             }
1241             if (cl < write_ncl+1 && nstr > write_nst)
1242             {
1243                 /* Dump all structures for this cluster */
1244                 /* generate numbered filename (there is a %d in trxfn!) */
1245                 sprintf(buf, trxsfn, cl);
1246                 trxsout = open_trx(buf, "w");
1247                 for (i = 0; i < nstr; i++)
1248                 {
1249                     bWrite[i] = TRUE;
1250                     if (rmsmin > 0.0)
1251                     {
1252                         for (i1 = 0; i1 < i && bWrite[i]; i1++)
1253                         {
1254                             if (bWrite[i1])
1255                             {
1256                                 bWrite[i] = rmsd[structure[i1]][structure[i]] > rmsmin;
1257                             }
1258                         }
1259                     }
1260                     if (bWrite[i])
1261                     {
1262                         write_trx(trxsout, iosize, outidx, atoms, i, time[structure[i]], zerobox,
1263                                   xx[structure[i]], NULL, NULL);
1264                     }
1265                 }
1266                 close_trx(trxsout);
1267             }
1268             /* Dump the average structure for this cluster */
1269             if (bAverage)
1270             {
1271                 for (i = 0; i < natom; i++)
1272                 {
1273                     svmul(1.0/nstr, xav[i], xav[i]);
1274                 }
1275             }
1276             else
1277             {
1278                 for (i = 0; i < natom; i++)
1279                 {
1280                     copy_rvec(xx[midstr][i], xav[i]);
1281                 }
1282                 if (bFit)
1283                 {
1284                     reset_x(ifsize, fitidx, natom, NULL, xav, mass);
1285                 }
1286             }
1287             if (bFit)
1288             {
1289                 do_fit(natom, mass, xtps, xav);
1290             }
1291             r = cl;
1292             write_trx(trxout, iosize, outidx, atoms, cl, time[midstr], zerobox, xav, NULL, NULL);
1293         }
1294     }
1295     /* clean up */
1296     if (trxfn)
1297     {
1298         close_trx(trxout);
1299         sfree(xav);
1300         if (write_ncl)
1301         {
1302             sfree(bWrite);
1303         }
1304     }
1305     sfree(structure);
1306     if (trxsfn)
1307     {
1308         sfree(trxsfn);
1309     }
1310 }
1311
1312 static void convert_mat(t_matrix *mat, t_mat *rms)
1313 {
1314     int i, j;
1315
1316     rms->n1 = mat->nx;
1317     matrix2real(mat, rms->mat);
1318     /* free input xpm matrix data */
1319     for (i = 0; i < mat->nx; i++)
1320     {
1321         sfree(mat->matrix[i]);
1322     }
1323     sfree(mat->matrix);
1324
1325     for (i = 0; i < mat->nx; i++)
1326     {
1327         for (j = i; j < mat->nx; j++)
1328         {
1329             rms->sumrms += rms->mat[i][j];
1330             rms->maxrms  = max(rms->maxrms, rms->mat[i][j]);
1331             if (j != i)
1332             {
1333                 rms->minrms = min(rms->minrms, rms->mat[i][j]);
1334             }
1335         }
1336     }
1337     rms->nn = mat->nx;
1338 }
1339
1340 int gmx_cluster(int argc, char *argv[])
1341 {
1342     const char        *desc[] = {
1343         "[THISMODULE] can cluster structures using several different methods.",
1344         "Distances between structures can be determined from a trajectory",
1345         "or read from an [TT].xpm[tt] matrix file with the [TT]-dm[tt] option.",
1346         "RMS deviation after fitting or RMS deviation of atom-pair distances",
1347         "can be used to define the distance between structures.[PAR]",
1348
1349         "single linkage: add a structure to a cluster when its distance to any",
1350         "element of the cluster is less than [TT]cutoff[tt].[PAR]",
1351
1352         "Jarvis Patrick: add a structure to a cluster when this structure",
1353         "and a structure in the cluster have each other as neighbors and",
1354         "they have a least [TT]P[tt] neighbors in common. The neighbors",
1355         "of a structure are the M closest structures or all structures within",
1356         "[TT]cutoff[tt].[PAR]",
1357
1358         "Monte Carlo: reorder the RMSD matrix using Monte Carlo such that",
1359         "the order of the frames is using the smallest possible increments.",
1360         "With this it is possible to make a smooth animation going from one",
1361         "structure to another with the largest possible (e.g.) RMSD between",
1362         "them, however the intermediate steps should be as small as possible.",
1363         "Applications could be to visualize a potential of mean force",
1364         "ensemble of simulations or a pulling simulation. Obviously the user",
1365         "has to prepare the trajectory well (e.g. by not superimposing frames).",
1366         "The final result can be inspect visually by looking at the matrix",
1367         "[TT].xpm[tt] file, which should vary smoothly from bottom to top.[PAR]",
1368
1369         "diagonalization: diagonalize the RMSD matrix.[PAR]",
1370
1371         "gromos: use algorithm as described in Daura [IT]et al.[it]",
1372         "([IT]Angew. Chem. Int. Ed.[it] [BB]1999[bb], [IT]38[it], pp 236-240).",
1373         "Count number of neighbors using cut-off, take structure with",
1374         "largest number of neighbors with all its neighbors as cluster",
1375         "and eliminate it from the pool of clusters. Repeat for remaining",
1376         "structures in pool.[PAR]",
1377
1378         "When the clustering algorithm assigns each structure to exactly one",
1379         "cluster (single linkage, Jarvis Patrick and gromos) and a trajectory",
1380         "file is supplied, the structure with",
1381         "the smallest average distance to the others or the average structure",
1382         "or all structures for each cluster will be written to a trajectory",
1383         "file. When writing all structures, separate numbered files are made",
1384         "for each cluster.[PAR]",
1385
1386         "Two output files are always written:[BR]",
1387         "[TT]-o[tt] writes the RMSD values in the upper left half of the matrix",
1388         "and a graphical depiction of the clusters in the lower right half",
1389         "When [TT]-minstruct[tt] = 1 the graphical depiction is black",
1390         "when two structures are in the same cluster.",
1391         "When [TT]-minstruct[tt] > 1 different colors will be used for each",
1392         "cluster.[BR]",
1393         "[TT]-g[tt] writes information on the options used and a detailed list",
1394         "of all clusters and their members.[PAR]",
1395
1396         "Additionally, a number of optional output files can be written:[BR]",
1397         "[TT]-dist[tt] writes the RMSD distribution.[BR]",
1398         "[TT]-ev[tt] writes the eigenvectors of the RMSD matrix",
1399         "diagonalization.[BR]",
1400         "[TT]-sz[tt] writes the cluster sizes.[BR]",
1401         "[TT]-tr[tt] writes a matrix of the number transitions between",
1402         "cluster pairs.[BR]",
1403         "[TT]-ntr[tt] writes the total number of transitions to or from",
1404         "each cluster.[BR]",
1405         "[TT]-clid[tt] writes the cluster number as a function of time.[BR]",
1406         "[TT]-cl[tt] writes average (with option [TT]-av[tt]) or central",
1407         "structure of each cluster or writes numbered files with cluster members",
1408         "for a selected set of clusters (with option [TT]-wcl[tt], depends on",
1409         "[TT]-nst[tt] and [TT]-rmsmin[tt]). The center of a cluster is the",
1410         "structure with the smallest average RMSD from all other structures",
1411         "of the cluster.[BR]",
1412     };
1413
1414     FILE              *fp, *log;
1415     int                nf, i, i1, i2, j;
1416     gmx_int64_t        nrms = 0;
1417
1418     matrix             box;
1419     rvec              *xtps, *usextps, *x1, **xx = NULL;
1420     const char        *fn, *trx_out_fn;
1421     t_clusters         clust;
1422     t_mat             *rms, *orig = NULL;
1423     real              *eigenvalues;
1424     t_topology         top;
1425     int                ePBC;
1426     t_atoms            useatoms;
1427     t_matrix          *readmat = NULL;
1428     real              *eigenvectors;
1429
1430     int                isize = 0, ifsize = 0, iosize = 0;
1431     atom_id           *index = NULL, *fitidx, *outidx;
1432     char              *grpname;
1433     real               rmsd, **d1, **d2, *time = NULL, time_invfac, *mass = NULL;
1434     char               buf[STRLEN], buf1[80], title[STRLEN];
1435     gmx_bool           bAnalyze, bUseRmsdCut, bJP_RMSD = FALSE, bReadMat, bReadTraj, bPBC = TRUE;
1436
1437     int                method, ncluster = 0;
1438     static const char *methodname[] = {
1439         NULL, "linkage", "jarvis-patrick", "monte-carlo",
1440         "diagonalization", "gromos", NULL
1441     };
1442     enum {
1443         m_null, m_linkage, m_jarvis_patrick,
1444         m_monte_carlo, m_diagonalize, m_gromos, m_nr
1445     };
1446     /* Set colors for plotting: white = zero RMS, black = maximum */
1447     static t_rgb rlo_top  = { 1.0, 1.0, 1.0 };
1448     static t_rgb rhi_top  = { 0.0, 0.0, 0.0 };
1449     static t_rgb rlo_bot  = { 1.0, 1.0, 1.0 };
1450     static t_rgb rhi_bot  = { 0.0, 0.0, 1.0 };
1451     static int   nlevels  = 40, skip = 1;
1452     static real  scalemax = -1.0, rmsdcut = 0.1, rmsmin = 0.0;
1453     gmx_bool     bRMSdist = FALSE, bBinary = FALSE, bAverage = FALSE, bFit = TRUE;
1454     static int   niter    = 10000, nrandom = 0, seed = 1993, write_ncl = 0, write_nst = 1, minstruct = 1;
1455     static real  kT       = 1e-3;
1456     static int   M        = 10, P = 3;
1457     output_env_t oenv;
1458     gmx_rmpbc_t  gpbc = NULL;
1459
1460     t_pargs      pa[] = {
1461         { "-dista", FALSE, etBOOL, {&bRMSdist},
1462           "Use RMSD of distances instead of RMS deviation" },
1463         { "-nlevels", FALSE, etINT,  {&nlevels},
1464           "Discretize RMSD matrix in this number of levels" },
1465         { "-cutoff", FALSE, etREAL, {&rmsdcut},
1466           "RMSD cut-off (nm) for two structures to be neighbor" },
1467         { "-fit",   FALSE, etBOOL, {&bFit},
1468           "Use least squares fitting before RMSD calculation" },
1469         { "-max",   FALSE, etREAL, {&scalemax},
1470           "Maximum level in RMSD matrix" },
1471         { "-skip",  FALSE, etINT,  {&skip},
1472           "Only analyze every nr-th frame" },
1473         { "-av",    FALSE, etBOOL, {&bAverage},
1474           "Write average iso middle structure for each cluster" },
1475         { "-wcl",   FALSE, etINT,  {&write_ncl},
1476           "Write the structures for this number of clusters to numbered files" },
1477         { "-nst",   FALSE, etINT,  {&write_nst},
1478           "Only write all structures if more than this number of structures per cluster" },
1479         { "-rmsmin", FALSE, etREAL, {&rmsmin},
1480           "minimum rms difference with rest of cluster for writing structures" },
1481         { "-method", FALSE, etENUM, {methodname},
1482           "Method for cluster determination" },
1483         { "-minstruct", FALSE, etINT, {&minstruct},
1484           "Minimum number of structures in cluster for coloring in the [TT].xpm[tt] file" },
1485         { "-binary", FALSE, etBOOL, {&bBinary},
1486           "Treat the RMSD matrix as consisting of 0 and 1, where the cut-off "
1487           "is given by [TT]-cutoff[tt]" },
1488         { "-M",     FALSE, etINT,  {&M},
1489           "Number of nearest neighbors considered for Jarvis-Patrick algorithm, "
1490           "0 is use cutoff" },
1491         { "-P",     FALSE, etINT,  {&P},
1492           "Number of identical nearest neighbors required to form a cluster" },
1493         { "-seed",  FALSE, etINT,  {&seed},
1494           "Random number seed for Monte Carlo clustering algorithm: <= 0 means generate" },
1495         { "-niter", FALSE, etINT,  {&niter},
1496           "Number of iterations for MC" },
1497         { "-nrandom", FALSE, etINT,  {&nrandom},
1498           "The first iterations for MC may be done complete random, to shuffle the frames" },
1499         { "-kT",    FALSE, etREAL, {&kT},
1500           "Boltzmann weighting factor for Monte Carlo optimization "
1501           "(zero turns off uphill steps)" },
1502         { "-pbc", FALSE, etBOOL,
1503           { &bPBC }, "PBC check" }
1504     };
1505     t_filenm     fnm[] = {
1506         { efTRX, "-f",     NULL,        ffOPTRD },
1507         { efTPS, "-s",     NULL,        ffOPTRD },
1508         { efNDX, NULL,     NULL,        ffOPTRD },
1509         { efXPM, "-dm",   "rmsd",       ffOPTRD },
1510         { efXPM, "-om",   "rmsd-raw",   ffWRITE },
1511         { efXPM, "-o",    "rmsd-clust", ffWRITE },
1512         { efLOG, "-g",    "cluster",    ffWRITE },
1513         { efXVG, "-dist", "rmsd-dist",  ffOPTWR },
1514         { efXVG, "-ev",   "rmsd-eig",   ffOPTWR },
1515         { efXVG, "-conv", "mc-conv",    ffOPTWR },
1516         { efXVG, "-sz",   "clust-size", ffOPTWR},
1517         { efXPM, "-tr",   "clust-trans", ffOPTWR},
1518         { efXVG, "-ntr",  "clust-trans", ffOPTWR},
1519         { efXVG, "-clid", "clust-id",   ffOPTWR},
1520         { efTRX, "-cl",   "clusters.pdb", ffOPTWR }
1521     };
1522 #define NFILE asize(fnm)
1523
1524     if (!parse_common_args(&argc, argv,
1525                            PCA_CAN_VIEW | PCA_CAN_TIME | PCA_TIME_UNIT,
1526                            NFILE, fnm, asize(pa), pa, asize(desc), desc, 0, NULL,
1527                            &oenv))
1528     {
1529         return 0;
1530     }
1531
1532     /* parse options */
1533     bReadMat   = opt2bSet("-dm", NFILE, fnm);
1534     bReadTraj  = opt2bSet("-f", NFILE, fnm) || !bReadMat;
1535     if (opt2parg_bSet("-av", asize(pa), pa) ||
1536         opt2parg_bSet("-wcl", asize(pa), pa) ||
1537         opt2parg_bSet("-nst", asize(pa), pa) ||
1538         opt2parg_bSet("-rmsmin", asize(pa), pa) ||
1539         opt2bSet("-cl", NFILE, fnm) )
1540     {
1541         trx_out_fn = opt2fn("-cl", NFILE, fnm);
1542     }
1543     else
1544     {
1545         trx_out_fn = NULL;
1546     }
1547     if (bReadMat && output_env_get_time_factor(oenv) != 1)
1548     {
1549         fprintf(stderr,
1550                 "\nWarning: assuming the time unit in %s is %s\n",
1551                 opt2fn("-dm", NFILE, fnm), output_env_get_time_unit(oenv));
1552     }
1553     if (trx_out_fn && !bReadTraj)
1554     {
1555         fprintf(stderr, "\nWarning: "
1556                 "cannot write cluster structures without reading trajectory\n"
1557                 "         ignoring option -cl %s\n", trx_out_fn);
1558     }
1559
1560     method = 1;
1561     while (method < m_nr && gmx_strcasecmp(methodname[0], methodname[method]) != 0)
1562     {
1563         method++;
1564     }
1565     if (method == m_nr)
1566     {
1567         gmx_fatal(FARGS, "Invalid method");
1568     }
1569
1570     bAnalyze = (method == m_linkage || method == m_jarvis_patrick ||
1571                 method == m_gromos );
1572
1573     /* Open log file */
1574     log = ftp2FILE(efLOG, NFILE, fnm, "w");
1575
1576     fprintf(stderr, "Using %s method for clustering\n", methodname[0]);
1577     fprintf(log, "Using %s method for clustering\n", methodname[0]);
1578
1579     /* check input and write parameters to log file */
1580     bUseRmsdCut = FALSE;
1581     if (method == m_jarvis_patrick)
1582     {
1583         bJP_RMSD = (M == 0) || opt2parg_bSet("-cutoff", asize(pa), pa);
1584         if ((M < 0) || (M == 1))
1585         {
1586             gmx_fatal(FARGS, "M (%d) must be 0 or larger than 1", M);
1587         }
1588         if (M < 2)
1589         {
1590             sprintf(buf1, "Will use P=%d and RMSD cutoff (%g)", P, rmsdcut);
1591             bUseRmsdCut = TRUE;
1592         }
1593         else
1594         {
1595             if (P >= M)
1596             {
1597                 gmx_fatal(FARGS, "Number of neighbors required (P) must be less than M");
1598             }
1599             if (bJP_RMSD)
1600             {
1601                 sprintf(buf1, "Will use P=%d, M=%d and RMSD cutoff (%g)", P, M, rmsdcut);
1602                 bUseRmsdCut = TRUE;
1603             }
1604             else
1605             {
1606                 sprintf(buf1, "Will use P=%d, M=%d", P, M);
1607             }
1608         }
1609         ffprintf_s(stderr, log, buf, "%s for determining the neighbors\n\n", buf1);
1610     }
1611     else /* method != m_jarvis */
1612     {
1613         bUseRmsdCut = ( bBinary || method == m_linkage || method == m_gromos );
1614     }
1615     if (bUseRmsdCut && method != m_jarvis_patrick)
1616     {
1617         fprintf(log, "Using RMSD cutoff %g nm\n", rmsdcut);
1618     }
1619     if (method == m_monte_carlo)
1620     {
1621         fprintf(log, "Using %d iterations\n", niter);
1622     }
1623
1624     if (skip < 1)
1625     {
1626         gmx_fatal(FARGS, "skip (%d) should be >= 1", skip);
1627     }
1628
1629     /* get input */
1630     if (bReadTraj)
1631     {
1632         /* don't read mass-database as masses (and top) are not used */
1633         read_tps_conf(ftp2fn(efTPS, NFILE, fnm), buf, &top, &ePBC, &xtps, NULL, box,
1634                       TRUE);
1635         if (bPBC)
1636         {
1637             gpbc = gmx_rmpbc_init(&top.idef, ePBC, top.atoms.nr);
1638         }
1639
1640         fprintf(stderr, "\nSelect group for least squares fit%s:\n",
1641                 bReadMat ? "" : " and RMSD calculation");
1642         get_index(&(top.atoms), ftp2fn_null(efNDX, NFILE, fnm),
1643                   1, &ifsize, &fitidx, &grpname);
1644         if (trx_out_fn)
1645         {
1646             fprintf(stderr, "\nSelect group for output:\n");
1647             get_index(&(top.atoms), ftp2fn_null(efNDX, NFILE, fnm),
1648                       1, &iosize, &outidx, &grpname);
1649             /* merge and convert both index groups: */
1650             /* first copy outidx to index. let outidx refer to elements in index */
1651             snew(index, iosize);
1652             isize = iosize;
1653             for (i = 0; i < iosize; i++)
1654             {
1655                 index[i]  = outidx[i];
1656                 outidx[i] = i;
1657             }
1658             /* now lookup elements from fitidx in index, add them if necessary
1659                and also let fitidx refer to elements in index */
1660             for (i = 0; i < ifsize; i++)
1661             {
1662                 j = 0;
1663                 while (j < isize && index[j] != fitidx[i])
1664                 {
1665                     j++;
1666                 }
1667                 if (j >= isize)
1668                 {
1669                     /* slow this way, but doesn't matter much */
1670                     isize++;
1671                     srenew(index, isize);
1672                 }
1673                 index[j]  = fitidx[i];
1674                 fitidx[i] = j;
1675             }
1676         }
1677         else /* !trx_out_fn */
1678         {
1679             isize = ifsize;
1680             snew(index, isize);
1681             for (i = 0; i < ifsize; i++)
1682             {
1683                 index[i]  = fitidx[i];
1684                 fitidx[i] = i;
1685             }
1686         }
1687     }
1688
1689     if (bReadTraj)
1690     {
1691         /* Loop over first coordinate file */
1692         fn = opt2fn("-f", NFILE, fnm);
1693
1694         xx = read_whole_trj(fn, isize, index, skip, &nf, &time, oenv, bPBC, gpbc);
1695         output_env_conv_times(oenv, nf, time);
1696         if (!bRMSdist || bAnalyze)
1697         {
1698             /* Center all frames on zero */
1699             snew(mass, isize);
1700             for (i = 0; i < ifsize; i++)
1701             {
1702                 mass[fitidx[i]] = top.atoms.atom[index[fitidx[i]]].m;
1703             }
1704             if (bFit)
1705             {
1706                 for (i = 0; i < nf; i++)
1707                 {
1708                     reset_x(ifsize, fitidx, isize, NULL, xx[i], mass);
1709                 }
1710             }
1711         }
1712         if (bPBC)
1713         {
1714             gmx_rmpbc_done(gpbc);
1715         }
1716     }
1717
1718     if (bReadMat)
1719     {
1720         fprintf(stderr, "Reading rms distance matrix ");
1721         read_xpm_matrix(opt2fn("-dm", NFILE, fnm), &readmat);
1722         fprintf(stderr, "\n");
1723         if (readmat[0].nx != readmat[0].ny)
1724         {
1725             gmx_fatal(FARGS, "Matrix (%dx%d) is not square",
1726                       readmat[0].nx, readmat[0].ny);
1727         }
1728         if (bReadTraj && bAnalyze && (readmat[0].nx != nf))
1729         {
1730             gmx_fatal(FARGS, "Matrix size (%dx%d) does not match the number of "
1731                       "frames (%d)", readmat[0].nx, readmat[0].ny, nf);
1732         }
1733
1734         nf = readmat[0].nx;
1735         sfree(time);
1736         time        = readmat[0].axis_x;
1737         time_invfac = output_env_get_time_invfactor(oenv);
1738         for (i = 0; i < nf; i++)
1739         {
1740             time[i] *= time_invfac;
1741         }
1742
1743         rms = init_mat(readmat[0].nx, method == m_diagonalize);
1744         convert_mat(&(readmat[0]), rms);
1745
1746         nlevels = readmat[0].nmap;
1747     }
1748     else   /* !bReadMat */
1749     {
1750         rms  = init_mat(nf, method == m_diagonalize);
1751         nrms = ((gmx_int64_t)nf*((gmx_int64_t)nf-1))/2;
1752         if (!bRMSdist)
1753         {
1754             fprintf(stderr, "Computing %dx%d RMS deviation matrix\n", nf, nf);
1755             /* Initialize work array */
1756             snew(x1, isize);
1757             for (i1 = 0; i1 < nf; i1++)
1758             {
1759                 for (i2 = i1+1; i2 < nf; i2++)
1760                 {
1761                     for (i = 0; i < isize; i++)
1762                     {
1763                         copy_rvec(xx[i1][i], x1[i]);
1764                     }
1765                     if (bFit)
1766                     {
1767                         do_fit(isize, mass, xx[i2], x1);
1768                     }
1769                     rmsd = rmsdev(isize, mass, xx[i2], x1);
1770                     set_mat_entry(rms, i1, i2, rmsd);
1771                 }
1772                 nrms -= (gmx_int64_t) (nf-i1-1);
1773                 fprintf(stderr, "\r# RMSD calculations left: " "%"GMX_PRId64 "   ", nrms);
1774             }
1775             sfree(x1);
1776         }
1777         else /* bRMSdist */
1778         {
1779             fprintf(stderr, "Computing %dx%d RMS distance deviation matrix\n", nf, nf);
1780
1781             /* Initiate work arrays */
1782             snew(d1, isize);
1783             snew(d2, isize);
1784             for (i = 0; (i < isize); i++)
1785             {
1786                 snew(d1[i], isize);
1787                 snew(d2[i], isize);
1788             }
1789             for (i1 = 0; i1 < nf; i1++)
1790             {
1791                 calc_dist(isize, xx[i1], d1);
1792                 for (i2 = i1+1; (i2 < nf); i2++)
1793                 {
1794                     calc_dist(isize, xx[i2], d2);
1795                     set_mat_entry(rms, i1, i2, rms_dist(isize, d1, d2));
1796                 }
1797                 nrms -= (nf-i1-1);
1798                 fprintf(stderr, "\r# RMSD calculations left: " "%"GMX_PRId64 "   ", nrms);
1799             }
1800             /* Clean up work arrays */
1801             for (i = 0; (i < isize); i++)
1802             {
1803                 sfree(d1[i]);
1804                 sfree(d2[i]);
1805             }
1806             sfree(d1);
1807             sfree(d2);
1808         }
1809         fprintf(stderr, "\n\n");
1810     }
1811     ffprintf_gg(stderr, log, buf, "The RMSD ranges from %g to %g nm\n",
1812                 rms->minrms, rms->maxrms);
1813     ffprintf_g(stderr, log, buf, "Average RMSD is %g\n", 2*rms->sumrms/(nf*(nf-1)));
1814     ffprintf_d(stderr, log, buf, "Number of structures for matrix %d\n", nf);
1815     ffprintf_g(stderr, log, buf, "Energy of the matrix is %g.\n", mat_energy(rms));
1816     if (bUseRmsdCut && (rmsdcut < rms->minrms || rmsdcut > rms->maxrms) )
1817     {
1818         fprintf(stderr, "WARNING: rmsd cutoff %g is outside range of rmsd values "
1819                 "%g to %g\n", rmsdcut, rms->minrms, rms->maxrms);
1820     }
1821     if (bAnalyze && (rmsmin < rms->minrms) )
1822     {
1823         fprintf(stderr, "WARNING: rmsd minimum %g is below lowest rmsd value %g\n",
1824                 rmsmin, rms->minrms);
1825     }
1826     if (bAnalyze && (rmsmin > rmsdcut) )
1827     {
1828         fprintf(stderr, "WARNING: rmsd minimum %g is above rmsd cutoff %g\n",
1829                 rmsmin, rmsdcut);
1830     }
1831
1832     /* Plot the rmsd distribution */
1833     rmsd_distribution(opt2fn("-dist", NFILE, fnm), rms, oenv);
1834
1835     if (bBinary)
1836     {
1837         for (i1 = 0; (i1 < nf); i1++)
1838         {
1839             for (i2 = 0; (i2 < nf); i2++)
1840             {
1841                 if (rms->mat[i1][i2] < rmsdcut)
1842                 {
1843                     rms->mat[i1][i2] = 0;
1844                 }
1845                 else
1846                 {
1847                     rms->mat[i1][i2] = 1;
1848                 }
1849             }
1850         }
1851     }
1852
1853     snew(clust.cl, nf);
1854     switch (method)
1855     {
1856         case m_linkage:
1857             /* Now sort the matrix and write it out again */
1858             gather(rms, rmsdcut, &clust);
1859             break;
1860         case m_diagonalize:
1861             /* Do a diagonalization */
1862             snew(eigenvalues, nf);
1863             snew(eigenvectors, nf*nf);
1864             memcpy(eigenvectors, rms->mat[0], nf*nf*sizeof(real));
1865             eigensolver(eigenvectors, nf, 0, nf, eigenvalues, rms->mat[0]);
1866             sfree(eigenvectors);
1867
1868             fp = xvgropen(opt2fn("-ev", NFILE, fnm), "RMSD matrix Eigenvalues",
1869                           "Eigenvector index", "Eigenvalues (nm\\S2\\N)", oenv);
1870             for (i = 0; (i < nf); i++)
1871             {
1872                 fprintf(fp, "%10d  %10g\n", i, eigenvalues[i]);
1873             }
1874             xvgrclose(fp);
1875             break;
1876         case m_monte_carlo:
1877             orig     = init_mat(rms->nn, FALSE);
1878             orig->nn = rms->nn;
1879             copy_t_mat(orig, rms);
1880             mc_optimize(log, rms, time, niter, nrandom, seed, kT,
1881                         opt2fn_null("-conv", NFILE, fnm), oenv);
1882             break;
1883         case m_jarvis_patrick:
1884             jarvis_patrick(rms->nn, rms->mat, M, P, bJP_RMSD ? rmsdcut : -1, &clust);
1885             break;
1886         case m_gromos:
1887             gromos(rms->nn, rms->mat, rmsdcut, &clust);
1888             break;
1889         default:
1890             gmx_fatal(FARGS, "DEATH HORROR unknown method \"%s\"", methodname[0]);
1891     }
1892
1893     if (method == m_monte_carlo || method == m_diagonalize)
1894     {
1895         fprintf(stderr, "Energy of the matrix after clustering is %g.\n",
1896                 mat_energy(rms));
1897     }
1898
1899     if (bAnalyze)
1900     {
1901         if (minstruct > 1)
1902         {
1903             ncluster = plot_clusters(nf, rms->mat, &clust, minstruct);
1904         }
1905         else
1906         {
1907             mark_clusters(nf, rms->mat, rms->maxrms, &clust);
1908         }
1909         init_t_atoms(&useatoms, isize, FALSE);
1910         snew(usextps, isize);
1911         useatoms.resinfo = top.atoms.resinfo;
1912         for (i = 0; i < isize; i++)
1913         {
1914             useatoms.atomname[i]    = top.atoms.atomname[index[i]];
1915             useatoms.atom[i].resind = top.atoms.atom[index[i]].resind;
1916             useatoms.nres           = max(useatoms.nres, useatoms.atom[i].resind+1);
1917             copy_rvec(xtps[index[i]], usextps[i]);
1918         }
1919         useatoms.nr = isize;
1920         analyze_clusters(nf, &clust, rms->mat, isize, &useatoms, usextps, mass, xx, time,
1921                          ifsize, fitidx, iosize, outidx,
1922                          bReadTraj ? trx_out_fn : NULL,
1923                          opt2fn_null("-sz", NFILE, fnm),
1924                          opt2fn_null("-tr", NFILE, fnm),
1925                          opt2fn_null("-ntr", NFILE, fnm),
1926                          opt2fn_null("-clid", NFILE, fnm),
1927                          bAverage, write_ncl, write_nst, rmsmin, bFit, log,
1928                          rlo_bot, rhi_bot, oenv);
1929     }
1930     gmx_ffclose(log);
1931
1932     if (bBinary && !bAnalyze)
1933     {
1934         /* Make the clustering visible */
1935         for (i2 = 0; (i2 < nf); i2++)
1936         {
1937             for (i1 = i2+1; (i1 < nf); i1++)
1938             {
1939                 if (rms->mat[i1][i2])
1940                 {
1941                     rms->mat[i1][i2] = rms->maxrms;
1942                 }
1943             }
1944         }
1945     }
1946
1947     fp = opt2FILE("-o", NFILE, fnm, "w");
1948     fprintf(stderr, "Writing rms distance/clustering matrix ");
1949     if (bReadMat)
1950     {
1951         write_xpm(fp, 0, readmat[0].title, readmat[0].legend, readmat[0].label_x,
1952                   readmat[0].label_y, nf, nf, readmat[0].axis_x, readmat[0].axis_y,
1953                   rms->mat, 0.0, rms->maxrms, rlo_top, rhi_top, &nlevels);
1954     }
1955     else
1956     {
1957         sprintf(buf, "Time (%s)", output_env_get_time_unit(oenv));
1958         sprintf(title, "RMS%sDeviation / Cluster Index",
1959                 bRMSdist ? " Distance " : " ");
1960         if (minstruct > 1)
1961         {
1962             write_xpm_split(fp, 0, title, "RMSD (nm)", buf, buf,
1963                             nf, nf, time, time, rms->mat, 0.0, rms->maxrms, &nlevels,
1964                             rlo_top, rhi_top, 0.0, (real) ncluster,
1965                             &ncluster, TRUE, rlo_bot, rhi_bot);
1966         }
1967         else
1968         {
1969             write_xpm(fp, 0, title, "RMSD (nm)", buf, buf,
1970                       nf, nf, time, time, rms->mat, 0.0, rms->maxrms,
1971                       rlo_top, rhi_top, &nlevels);
1972         }
1973     }
1974     fprintf(stderr, "\n");
1975     gmx_ffclose(fp);
1976     if (NULL != orig)
1977     {
1978         fp = opt2FILE("-om", NFILE, fnm, "w");
1979         sprintf(buf, "Time (%s)", output_env_get_time_unit(oenv));
1980         sprintf(title, "RMS%sDeviation", bRMSdist ? " Distance " : " ");
1981         write_xpm(fp, 0, title, "RMSD (nm)", buf, buf,
1982                   nf, nf, time, time, orig->mat, 0.0, orig->maxrms,
1983                   rlo_top, rhi_top, &nlevels);
1984         gmx_ffclose(fp);
1985         done_mat(&orig);
1986         sfree(orig);
1987     }
1988     /* now show what we've done */
1989     do_view(oenv, opt2fn("-o", NFILE, fnm), "-nxy");
1990     do_view(oenv, opt2fn_null("-sz", NFILE, fnm), "-nxy");
1991     if (method == m_diagonalize)
1992     {
1993         do_view(oenv, opt2fn_null("-ev", NFILE, fnm), "-nxy");
1994     }
1995     do_view(oenv, opt2fn("-dist", NFILE, fnm), "-nxy");
1996     if (bAnalyze)
1997     {
1998         do_view(oenv, opt2fn_null("-tr", NFILE, fnm), "-nxy");
1999         do_view(oenv, opt2fn_null("-ntr", NFILE, fnm), "-nxy");
2000         do_view(oenv, opt2fn_null("-clid", NFILE, fnm), "-nxy");
2001     }
2002     do_view(oenv, opt2fn_null("-conv", NFILE, fnm), NULL);
2003
2004     return 0;
2005 }