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