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