BOOL_ mygetline (BOOL_ required)
/* Lees een regel in
* Plaats in buffer
* Negeer lege regels en regels die beginnen met #
*/
{
int
i;
for (;;) {
if (fgets (buffer, BUFSIZE, fp) == NULL) {
if (required)
errit ("Unexpected end of file");
else
return FALSE;
}
inputline++;
i = strlen (buffer);
while (i && isspace ((unsigned char) buffer [i - 1]))
buffer [--i] = '\0';
i = 0;
while (buffer [i] && isspace ((unsigned char) buffer [i]))
i++;
if (buffer [i] == '#')
continue;
if (buffer [i]) {
memmove (buffer, buffer + i, strlen (buffer) + 1);
return TRUE;
}
}
}
void psstring ()
{
int
i,
j;
unsigned char
*p;
p = (unsigned char *)buffer;
j = 0;
for (i = 0; p [i]; i++) {
if (j + 4 > BUFSIZE)
errit ("String too long: \"%s\"", buffer);
if (p [i] == '(' ||
p [i] == ')' ||
p [i] == '\\'
) {
buf2 [j++] = '\\';
buf2 [j++] = p [i];
} else if (p [i] < 32 || p [i] > 126) {
buf2 [j++] = '\\';
sprintf (buf2 + j, "%03o", (unsigned) p [i]);
j += 3;
eXtended = TRUE;
} else
buf2 [j++] = p [i];
}
buf2 [j] = '\0';
strcpy (buffer, buf2);
}
int GetLine (FILE *fp, int required, char const *filename)
/* Lees een regel in
* Plaats in buffer
* Negeer lege regels en regels die beginnen met #
* Verwijder leading/trailing white space
*/
{
int
i;
for (;;) {
if (fgets (buffer, BUFSIZE, fp) == NULL) {
if (required)
errit ("Unexpected end of file in \"%s\"", filename);
else
return 0;
}
input_line++;
i = strlen (buffer);
while (i && isspace ((unsigned char) buffer [i - 1]))
buffer [--i] = '\0';
i = 0;
while (buffer [i] && isspace ((unsigned char) buffer [i]))
i++;
if (buffer [i] == '#')
continue;
if (buffer [i]) {
memmove (buffer, buffer + i, strlen (buffer + i) + 1);
return 1;
}
}
}
void fileopen (char const *s)
{
filename = s;
inputline = 0;
fp = fopen (s, "r");
if (! fp)
errit ("Opening file \"%s\": %s", s, strerror (errno));
}
void bytescheck (unsigned char *s, int n)
{
int
i;
for (i = 0; i < n; i++)
if (! s [i])
errit ("Invalid utf-8 code in %s, line %li", filename, lineno);
}
void openread (char const *s)
{
filename = s_strdup (s);
lineno = 0;
fp = fopen (filename, "r");
if (! fp)
errit ("Opening file \"%s\": %s", filename, strerror (errno));
}
char *s_strdup (const char *s)
{
char
*p = strdup (s);
if (! p) {
free (no_mem_buffer);
errit (Out_of_memory);
}
return p;
}
char *get_arg ()
{
if (arg_v [1][2])
return arg_v [1] + 2;
if (arg_c == 2)
errit ("Missing argument for '%s'", arg_v [1]);
arg_v++;
arg_c--;
return arg_v [1];
}
void *s_malloc (size_t size)
{
void
*p;
p = malloc (size);
if (! p) {
free (no_mem_buffer);
errit (out_of_memory);
}
return p;
}
void *s_realloc (void *block, size_t size)
{
void
*p;
p = realloc (block, size);
if (! p) {
free (no_mem_buffer);
errit (out_of_memory);
}
return p;
}
void *s_realloc (void *block, size_t size)
{
void
*p;
if (block == NULL)
p = malloc (size);
else
p = realloc (block, size);
if (! p) {
free (no_mem_buffer);
errit (Out_of_memory);
}
return p;
}
int charlen (char c) {
int
i;
if (! utf)
return 1;
i = (unsigned char) c;
if (i <= 0x7F) return 1;
if (i <= 0xDF) return 2;
if (i <= 0xEF) return 3;
if (i <= 0xF7) return 4;
if (i <= 0xFB) return 5;
if (i <= 0xFD) return 6;
errit ("Invalid UFF-8 character");
return 0;
}
int main (int argc, char *argv [])
{
int
argn,
argmax,
max,
used,
i,
j,
k,
n;
char
*p;
GROUP_
*gr;
no_mem_buffer = (char *) malloc (1024);
get_programname (argv [0]);
while (argc > 1 && argv [1][0] == '-') {
if (! strcmp (argv [1], "-o")) {
argc--;
argv++;
outfile = argv [1];
} else if (! strcmp (argv [1], "-l")) {
argc--;
argv++;
listfile = argv [1];
}
argc--;
argv++;
}
if (argc < 2 && ! listfile)
syntax ();
if (listfile) {
argc = 1;
argmax = 256;
p = argv [0];
argv = (char **) s_malloc (argmax * sizeof (char *));
argv [0] = p;
fileopen (listfile);
while (mygetline (FALSE)) {
if (argc == argmax) {
argmax += 256;
argv = (char **) s_realloc (argv, argmax * sizeof (char *));
}
argv [argc++] = s_strdup (buffer);
}
}
fileopen (argv [1]);
while (mygetline (FALSE)) {
if (buffer [0] == 'l' || buffer [0] == 'L') {
if (n_lbls == max_lbls) {
max_lbls += 256;
lbls = (char **) s_realloc (lbls, max_lbls * sizeof (char *));
}
i = 1;
while (buffer [i] && isspace ((unsigned char) buffer [i]))
i++;
lbls [n_lbls++] = s_strdup (buffer + i);
}
}
fclose (fp);
qsort (lbls, n_lbls, sizeof (char *), scmp);
if (outfile) {
fpout = fopen (outfile, "w");
if (! fpout)
errit ("Creating file \"%s\": %s", outfile, strerror (errno));
} else
fpout = stdout;
fprintf (fpout, "# Number of cluster files:\n%i\n# Number of labels:\n%i\n# Labels:\n", argc - 1, n_lbls);
for (i = 0; i < n_lbls; i++)
fprintf (fpout, "%s\n", lbls [i]);
fprintf (fpout, "# Cluster count, cluster members, average cophenetic distance:\n");
max = n_lbls - 1;
cl = (CLUSTER_ *) s_malloc (max * sizeof (CLUSTER_));
members = (char *) s_malloc ((n_lbls + 1) * sizeof (char));
members [n_lbls] = '\0';
for (argn = 1; argn < argc; argn++) {
fileopen (argv [argn]);
for (used = 0; used < max; used++) {
mygetline (TRUE);
if (sscanf (buffer, "%i %f%n", &(cl [used].index), &(cl [used].value), &i) < 2)
errit ("Syntax error in \"%s\", line %i: \"%s\"", filename, inputline, buffer);
for (n = 0; n < 2; n++) {
mygetline (TRUE);
switch (buffer [0]) {
case 'l':
case 'L':
cl [used].node [n] = LBL;
i = 1;
while (buffer [i] && isspace ((unsigned char) buffer [i]))
i++;
p = bsearch (buffer + i, lbls, n_lbls, sizeof (char *), lscmp);
if (! p)
errit ("Unknown label in \"%s\", line %i: \"%s\"", filename, inputline, buffer + i);
cl [used].n [n].label = ((char **)p) - lbls;
break;
case 'c':
case 'C':
cl [used].node [n] = CLS;
if (sscanf (buffer + 1, "%i", &(cl [used].n [n].cluster)) != 1)
errit ("Missing cluster number at line %i", inputline);
break;
default:
errit ("Syntax error at line %i: \"%s\"", inputline, buffer);
}
}
}
/* replace indexes */
for (i = 0; i < max; i++)
for (j = 0; j < 2; j++)
if (cl [i].node [j] == CLS)
for (k = 0; k < max; k++)
if (cl [i].n [j].cluster == cl [k].index) {
cl [i].n [j].cluster = k;
break;
}
for (i = 0; i < max; i++) {
for (j = 0; j < n_lbls; j++)
members [j] = '-';
walk (i);
gr = findgroup ();
gr->n++;
gr->value += cl [i].value;
}
fclose (fp);
}
walkgroups (root);
if (outfile)
fclose (fpout);
return 0;
}
void checkCancel ()
{
if (access ("_CANCEL_.L04", F_OK) == 0)
errit ("CANCELLED");
}
void process_args ()
{
while (arg_c > 1 && arg_v [1][0] == '-') {
switch (arg_v [1][1]) {
case '2':
PSlevel = 2;
break;
case 'a':
linktype = ARC;
break;
case 'b':
minvalue = atof (get_arg ());
mindefined = TRUE;
break;
case 'C':
colorlabel = TRUE;
break;
case 'c':
colorlink = TRUE;
break;
case 'E':
example = TRUE;
break;
case 'e':
exponent = atof (get_arg ());
break;
case 'f':
fontsize = atoi (get_arg ());
break;
case 'h':
use_rainbow = TRUE;
use_bright = FALSE;
break;
case 'H':
use_rainbow = use_bright = TRUE;
break;
case 'I':
numbers = TRUE;
patterns = symbols = FALSE;
break;
case 'L':
labels = FALSE;
break;
case 'n':
ngroup = atoi (get_arg ());
break;
case 'o':
outfile = get_arg ();
break;
case 'p':
evenodd = TRUE;
leftmargin = 200;
width = 250;
break;
case 'P':
patterns = TRUE;
numbers = symbols = FALSE;
break;
case 'Q':
symbols = TRUE;
numbers = patterns = FALSE;
break;
case 'R':
ruler = FALSE;
break;
case 'r':
RulerSkip = atof (get_arg ());
break;
case 'S':
LineSkip2 = atof (get_arg ());
break;
case 's':
LineSkip = atof (get_arg ());
break;
case 'T':
fontname = "Times-Roman";
fontwidths = times;
break;
case 't':
linktype = TRI;
break;
case 'u':
colorfile = get_arg ();
use_usercolours = TRUE;
break;
default:
errit ("Illegal option '%s'", arg_v [1]);
}
arg_c--;
arg_v++;
}
}
void process_args ()
{
char
*s;
int
i,
i1,
i2,
ii;
float
f;
while (arg_c > 1 && arg_v [1][0] == '-') {
if ((! strcmp (arg_v [1], "-sl")) || ! strcmp (arg_v [1], "-n")) {
update_function = update_sl;
name_update = a_sl;
} else if (! strcmp (arg_v [1], "-cl")) {
update_function = update_cl;
name_update = a_cl;
} else if (! strcmp (arg_v [1], "-ga")) {
update_function = update_ga;
name_update = a_ga;
} else if (! strcmp (arg_v [1], "-wa")) {
update_function = update_wa;
name_update = a_wa;
} else if (! strcmp (arg_v [1], "-uc")) {
update_function = update_uc;
name_update = a_uc;
} else if (! strcmp (arg_v [1], "-wc")) {
update_function = update_wc;
name_update = a_wc;
} else if ((! strcmp (arg_v [1], "-wm")) || ! strcmp (arg_v [1], "-w")) {
update_function = update_wm;
name_update = a_wm;
} else if (arg_v [1][1] == 'm') {
s = get_arg ();
ii = 1;
buffer [0] = buffr2 [0] = buffr3 [0] = '\0';
i = sscanf (s, "%[0-9]-%[0-9]+%[0-9]", buffer, buffr2, buffr3);
if (i > 1) {
i1 = atoi (buffer);
i2 = atoi (buffr2);
if (i1 < 2 || (i2 && i2 < i1))
errit ("Illegal range for -m: %s", s);
if (!i2)
i2 = i1;
if (i == 3)
ii = atoi (buffr3);
if (ii < 1)
ii = 1;
} else {
i1 = i2 = atoi (s);
if (i1 < 2)
errit ("Illegal value for -m: %i", i1);
}
for (i = i1; i <= i2; i += ii) {
if (n_maxcl == max_maxcl) {
max_maxcl += 64;
maxcl = (int *) s_realloc (maxcl, max_maxcl * sizeof (int));
}
maxcl [n_maxcl++] = i;
}
} else if (arg_v [1][1] == 'N') {
f = atof (get_arg ());
if (f < 0.0)
errit ("Illegal value for -N: %g", f);
if (n_noise == max_noise) {
max_noise += 64;
noise = (float *) s_realloc (noise, max_noise * sizeof (float));
}
noise [n_noise++] = f;
} else if (arg_v [1][1] == 'r') {
n_runs = atoi (get_arg ());
if (n_runs < 2)
errit ("Option -r : argument should be a number larger than 1");
} else if (arg_v [1][1] == 's') {
seed = atoi (get_arg ());
if (seed < 1)
errit ("Option -s : seed must be positive");
} else if (arg_v [1][1] == 'o') {
outfile = get_arg ();
} else if (! strcmp (arg_v [1], "-b")) {
cophenetic = 1;
binary = 1;
} else if (! strcmp (arg_v [1], "-c")) {
cophenetic = 1;
binary = 0;
} else if (! strcmp (arg_v [1], "-u")) {
sorted = 0;
} else
errit ("Illegal option '%s'", arg_v [1]);
arg_c--;
arg_v++;
}
}
int main (int argc, char *argv [])
{
int
i,
j,
k,
n,
x1,
y1,
x2,
y2;
float
f,
step,
r,
g,
b;
BOOL
found,
int2float;
time_t
tp;
no_mem_buffer = (char *) malloc (1024);
get_programname (argv [0]);
if (argc == 1 && isatty (fileno (stdin)))
syntax (0);
fontname = "Helvetica";
fontwidths = helvetica;
arg_c = argc;
arg_v = argv;
process_args ();
if (outfile) {
fp_out = fopen (outfile, "w");
if (! fp_out)
errit ("Creating file \"%s\": %s", outfile, strerror (errno));
} else
fp_out = stdout;
if (example) {
fputs (
"# Example cluster file\n"
"1 .12\n"
"L Norwegian\n"
"L Swedish\n"
"2 .15\n"
"C 1\n"
"L Danish\n"
"3 .3\n"
"L Dutch\n"
"L German\n"
"4 .35 Nordic group\n"
"L Icelandic\n"
"C 2\n"
"5 .7\n"
"C 4\n"
"C 3\n",
fp_out
);
if (outfile)
fclose (fp_out);
return 0;
}
if (patterns || symbols || numbers) {
if (colorlabel || colorlink)
errit ("No colours with %s", patterns ? "patterns" : (symbols ? "symbols" : "numbers"));
if ((ngroup < 2 || ngroup > n_colors) && ! numbers)
errit ("Illegal number of %s: %i", patterns ? "patterns" : "symbols", ngroup);
if (patterns)
PSlevel = 2;
labels = FALSE;
}
if ((colorlink || colorlabel) && (ngroup < 2 || ngroup > n_colors) && ! use_rainbow)
errit ("Invalid number of groups with coloured labels or links. Try rainbow colours.");
if (use_rainbow && ! (colorlink || colorlabel))
errit ("Missing option -c and/or -C with rainbow colours");
if (colorlabel && ! labels)
errit ("Colour for no labels\n");
if (fontsize < 4)
errit ("fontsize too small");
if (fontsize > 20)
errit ("fontsize too large");
if (evenodd && ! labels)
errit("Placement of labels in two colums without labels");
if (use_usercolours && (colorlabel || colorlink)) {
int2float = FALSE;
n_colors = 0;
fp = fopen (colorfile, "r");
if (! fp)
errit ("Opening file \"%s\": %s", colorfile, strerror (errno));
inputline = 0;
while (getline (FALSE)) {
if (n_colors == max_colors) {
max_colors += 16;
usercolors = (float **) s_realloc (usercolors, max_colors * sizeof (float**));
}
if (sscanf (buffer, "%f %f %f", &r, &g, &b) != 3)
errit ("Missing value(s) for in file \"%s\", line %i", colorfile, inputline);
if (r < 0 || r > 255)
errit ("Red component out of range in file \"%s\", line %i", colorfile, inputline);
if (g < 0 || g > 255)
errit ("Green component out of range in file \"%s\", line %i", colorfile, inputline);
if (b < 0 || b > 255)
errit ("Blue component out of range in file \"%s\", line %i", colorfile, inputline);
if (r > 1 || g > 1 || b > 1)
int2float = TRUE;
usercolors [n_colors] = s_malloc (3 * sizeof (float));
usercolors [n_colors][0] = r;
usercolors [n_colors][1] = g;
usercolors [n_colors][2] = b;
n_colors++;
}
fclose (fp);
if (int2float)
for (i = 0; i < n_colors; i++)
for (j = 0; j < 3; j++)
usercolors [i][j] /= 255;
inputline = 0;
}
switch (arg_c) {
case 1:
if (isatty (fileno (stdin)))
syntax (1);
fp = stdin;
break;
case 2:
fp = fopen (arg_v [1], "r");
if (! fp)
errit ("Opening file \"%s\": %s", arg_v [1], strerror (errno));
break;
default:
syntax (1);
}
while (getline (FALSE)) {
if (used == max) {
max += 256;
cl = (CLUSTER *) s_realloc (cl, max * sizeof (CLUSTER));
}
if (sscanf (buffer, "%i %g%n", &(cl [used].index), &(cl [used].value), &i) < 2)
errit ("Syntax error at line %i: \"%s\"", inputline, buffer);
if (cl [used].value > maxvalue)
maxvalue = cl [used].value;
memmove (buffer, buffer + i, strlen (buffer + i) + 1);
trim ();
if (buffer [0] && buffer [0] != '#') {
psstring ();
cl [used].text = s_strdup (buffer);
} else
cl [used].text = NULL;
for (n = 0; n < 2; n++) {
getline (TRUE);
switch (buffer [0]) {
case 'l':
case 'L':
cl [used].node [n] = LBL;
buffer [0] = ' ';
trim ();
psstring ();
if ((f = psstringwidth (buffer)) > maxlabelwidth)
maxlabelwidth = f;
cl [used].n [n].label = s_strdup (buffer);
break;
case 'c':
case 'C':
cl [used].node [n] = CLS;
if (sscanf (buffer + 1, "%i", &(cl [used].n [n].cluster)) != 1)
errit ("Missing cluster number at line %i", inputline);
break;
default:
errit ("Syntax error at line %i: \"%s\"", inputline, buffer);
}
}
used++;
}
if (argc == 2)
fclose (fp);
if (!used)
errit ("No data");
/* replace indexes */
for (i = 0; i < used; i++)
for (j = 0; j < 2; j++)
if (cl [i].node [j] == CLS)
for (k = 0; k < used; k++)
if (cl [i].n [j].cluster == cl [k].index) {
cl [i].n [j].cluster = k;
break;
}
/* locate top node */
top = 0;
do {
found = FALSE;
for (i = 1; i < used; i++)
if ((cl [i].node [0] == CLS && cl [i].n [0].cluster == top) ||
(cl [i].node [1] == CLS && cl [i].n [1].cluster == top)
) {
top = i;
found = TRUE;
break;
}
} while (found);
if (! mindefined) {
for (i = 0; i < used; i++)
if (cl [i].value < minvalue)
minvalue = cl [i].value;
if (minvalue > 0)
minvalue = 0;
}
for (i = 0; i < used; i++)
if (
cl [i].text
&& (f = psstringwidth (cl [i].text)
+ leftmargin + ((float) width) / pow (maxvalue - minvalue, exponent) * pow (cl [i].value - minvalue, exponent) + 5.0) > urx
)
urx = f;
if (ngroup > 1) {
/* divide into color groups */
j = 0;
for (i = 0; i < used; i++) {
cl [i].group [0] = cl [i].group [1] = 1;
for (k = 0; k < 2; k++)
if (cl [i].node [k] == LBL)
j++;
}
if (ngroup > j)
errit ("Too many groups");
groups = (int *) s_malloc (ngroup * sizeof (int));
groups [0] = top;
for (n = 1; n < ngroup; n++) {
f = - FLT_MAX;
for (i = 0; i < n; i++)
if (groups [i] < used && cl [groups [i]].value > f) {
j = i;
f = cl [groups [i]].value;
}
cl [groups [j]].group [0] = n + 1;
cl [groups [j]].group [1] = j + 1;
groups [n] = (cl [groups [j]].node [0] == CLS) ? cl [groups [j]].n [0].cluster : (INT_MAX);
groups [j] = (cl [groups [j]].node [1] == CLS) ? cl [groups [j]].n [1].cluster : (INT_MAX);
setclgroups (groups [n], n + 1);
/* setclgroups (groups [j], j + 1); */
}
}
if (labels) {
if (LineSkip < 0) {
LineSkip = 1.2 * fontsize;
if (evenodd)
LineSkip /= 2;
}
if (LineSkip2 < 0) {
LineSkip2 = 1.5 * LineSkip;
if (evenodd)
LineSkip2 *= 2;
}
if (RulerSkip < 0)
RulerSkip = 1.5 * LineSkip + 4;
} else {
if (LineSkip2 < 0)
LineSkip2 = 4;
if (LineSkip < 0) {
LineSkip = 2;
if ((used - 1) * LineSkip + (ngroup - 1) * LineSkip2 > 530) {
LineSkip = (530 - (ngroup - 1) * LineSkip2) / (used - 1);
}
}
if (RulerSkip < 0)
RulerSkip = LineSkip2 + 4;
}
fputs (
"%!PS-Adobe-3.0 EPSF-3.0\n"
"%%BoundingBox: ",
fp_out
);
x1 = labels ? (leftmargin - 6 - maxlabelwidth) : leftmargin - 10;
if (evenodd) {
process_width (top);
leftmargin2 = leftmargin - 4 - maxlabelwidth1;
x1 = leftmargin2 - 6 - maxlabelwidth2;
}
if (patterns)
x1 = 100;
if (symbols)
x1 = 120;
if (numbers)
x1 = 110;
x2 = urx;
y1 = 700 - (used - ngroup + 1) * LineSkip - (ngroup - 1) * LineSkip2;
if (ruler)
y1 -= RulerSkip + fontsize + 1;
else if (labels)
y1 -= fontsize / 2;
y2 = 701;
if (labels)
y2 += fontsize / 2;
fprintf (fp_out, "%i %i %i %i\n", x1, y1, x2, y2);
fputs (
"%%Creator: ",
fp_out
);
fprintf (fp_out, "%s", programname);
fputs (
", Version " denVERSION ", (c) P. Kleiweg 1997 - 2005\n"
"%%CreationDate: ",
fp_out
);
time (&tp);
fputs (asctime (localtime (&tp)), fp_out);
if (argc == 2) {
fputs ("%%Title: ", fp_out);
fprintf (fp_out, "%s %i\n", arg_v [1], ngroup);
}
fputs ("%%LanguageLevel: ", fp_out);
fprintf (fp_out, "%i\n", PSlevel);
fputs (
"%%EndComments\n"
"\n"
"64 dict begin\n"
"\n",
fp_out
);
fprintf (
fp_out,
"/EXP { %g exp } def\n"
"/FontName /%s def\n"
"/FontSize %i def\n"
"/LineSkip %g def\n"
"/LineSkip2 %g def\n"
"\n",
exponent,
fontname,
fontsize,
LineSkip,
LineSkip2
);
fprintf (
fp_out,
"/TopMargin 700 def\n"
"/LeftMargin %i def\n",
leftmargin
);
if (evenodd)
fprintf (
fp_out,
"/LeftMargin2 %i def\n",
leftmargin2
);
fprintf (
fp_out,
"\n"
"/Width %i def\n"
"\n",
width
);
if (ruler) {
fprintf (
fp_out,
"/RulerSkip %g def\n"
"/RulerStep ",
RulerSkip
);
step = pow (10, ceil (log10 (maxvalue - minvalue)) - 1);
if ((maxvalue - minvalue) / step > 6.0)
step *= 2.0;
else if ((maxvalue - minvalue) / step < 3.0)
step *= 0.5;
fprintf (fp_out, "%g def\n\n", step);
}
if (colorlink)
fputs (
"/clw { 1 setlinewidth } bind def\n"
"/blw { .5 setlinewidth } bind def\n"
"\n",
fp_out
);
else
fputs (
".5 setlinewidth\n"
"\n",
fp_out
);
if (evenodd)
fputs ("\n/oelinewidth .2 def\n\n", fp_out);
if (patterns) {
fputs (
"<<\n"
" /PatternType 1\n"
" /PaintType 1\n"
" /TilingType 1\n"
" /PaintProc {\n"
" begin\n"
" XStep\n"
" YStep\n"
" 1\n"
" [ 1 0 0 1 0 0 ]\n"
" data\n"
" image\n"
" end\n"
" }\n"
">>\n"
"/pdict exch def\n"
"\n"
"% stack in: /label width height patterndata\n"
"% stack out: -\n"
"/defpattern {\n"
" /pat exch def\n"
" /y exch def\n"
" /x exch def\n"
" pdict /BBox [ 0 0 x y ] put\n"
" pdict /XStep x put\n"
" pdict /YStep y put\n"
" pdict /data pat put\n"
" pdict [ 72 60 div 0 0\n"
" 72 60 div 0 0 ] makepattern\n"
" def\n"
"} bind def\n"
"\n",
fp_out
);
for (i = 0; i < ngroup; i++)
fprintf (fp_out, "/c%-2i %s defpattern\n", i + 1, pat [i]);
fputs ("\n", fp_out);
}
if (numbers)
fputs ("/NumFontSize 12 def\n\n", fp_out);
if (symbols) {
fputs (
"/Symsize 8 def\n"
"/Symlw .7 def\n"
"\n",
fp_out
);
for (i = 0; i < ngroup; i++)
fprintf (fp_out, "/c%-2i /sym%-2i def\n", i + 1, i);
fputs ("\n", fp_out);
}
fputs (
"%%% End of User Options %%%\n"
"\n",
fp_out
);
if (patterns)
fputs (
"/c0 {\n"
" COL {\n"
" Y YY ne {\n"
" /Pattern setcolorspace P setcolor\n"
" 100 Y moveto\n"
" 140 Y lineto\n"
" 140 YY LineSkip add lineto\n"
" 100 YY LineSkip add lineto\n"
" closepath\n"
" fill\n"
" 0 setgray\n"
" } if\n"
" /COL false def\n"
" } if\n"
"} bind def\n"
"\n",
fp_out
);
if (symbols) {
for (i = 0; i < ngroup; i++)
fprintf (fp_out, "/sym%-2i {\n%s} bind def\n\n", i, sym [i]);
fputs (
"/c0 {\n"
" COL {\n"
" 140 Y moveto\n"
" 135 Y lineto\n"
" 135 YY lineto\n"
" 140 YY lineto\n"
" stroke\n"
" currentlinewidth\n"
" 130 Symsize 2 div sub Y YY add 2 div moveto\n"
" gsave\n"
" 1 setgray\n"
" Symsize -2 div 3 sub dup rmoveto\n"
" Symsize 6 add 0 rlineto\n"
" 0 Symsize 6 add rlineto\n"
" Symsize 6 add neg 0 rlineto\n"
" closepath\n"
" fill\n"
" grestore\n"
" Symlw setlinewidth\n"
" P cvx exec\n"
" setlinewidth\n"
" /COL false def\n"
" } if\n"
"} bind def\n"
"\n",
fp_out
);
}
if (numbers) {
fputs (
"/c0 {\n"
" COL {\n"
" 140 Y moveto\n"
" 135 Y lineto\n"
" 135 YY lineto\n"
" 140 YY lineto\n"
" stroke\n"
" 130 Y YY add 2 div Shift sub moveto\n"
" P 10 string cvs\n"
" dup stringwidth pop neg 0 rmoveto show\n"
" /COL false def\n"
" } if\n"
"} bind def\n"
"\n",
fp_out
);
}
if (patterns || symbols || numbers)
fputs (
"/col {\n"
" c0\n"
" /Y y def\n"
" /YY y def\n"
" /P exch def\n"
" /COL true def\n"
"} bind def\n"
"\n"
"/COL false def\n"
"\n",
fp_out
);
if (colorlink || colorlabel) {
fprintf (fp_out, "/SETCOLOR { set%scolor } bind def\n", use_rainbow ? "hsb" : "rgb");
fprintf (fp_out, "/CURRENTCOLOR { current%scolor } bind def\n", use_rainbow ? "hsb" : "rgb");
fprintf (fp_out, "/c0 {\n 0 setgray%s\n /COL false def\n} bind def\n", colorlink ? "\n blw" : "");
if (use_rainbow)
for (i = 0; i < ngroup; i++)
fprintf (
fp_out,
"/c%i { %.4f 1 %s } def\n",
i + 1,
((float) i) / ngroup,
((i % 2) && ! use_bright) ? ".6" : "1"
);
else
for (i = 0; i < ngroup; i++)
fprintf (
fp_out,
"/c%i { %g %g %g } def\n",
i + 1,
use_usercolours ? usercolors [i][0] : colors [i][0],
use_usercolours ? usercolors [i][1] : colors [i][1],
use_usercolours ? usercolors [i][2] : colors [i][2]
);
fputs (
"/col {\n"
" SETCOLOR\n",
fp_out
);
if (colorlink)
fputs (" clw\n", fp_out);
fputs (
" /COL true def\n"
"} bind def\n"
"\n"
"c0\n"
"\n",
fp_out
);
}
if (eXtended && PSlevel == 1)
fputs (
"/ISOLatin1Encoding\n"
"[/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"
"/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"
"/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"
"/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"
"/space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n"
"/quoteright /parenleft /parenright /asterisk /plus /comma /minus /period\n"
"/slash /zero /one /two /three /four /five /six /seven /eight /nine\n"
"/colon /semicolon /less /equal /greater /question /at /A /B /C /D /E /F\n"
"/G /H /I /J /K /L /M /N /O /P /Q /R /S /T /U /V /W /X /Y /Z /bracketleft\n"
"/backslash /bracketright /asciicircum /underscore /quoteleft /a /b /c /d\n"
"/e /f /g /h /i /j /k /l /m /n /o /p /q /r /s /t /u /v /w /x /y /z\n"
"/braceleft /bar /braceright /asciitilde /.notdef /.notdef /.notdef\n"
"/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"
"/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /dotlessi /grave\n"
"/acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef\n"
"/ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space /exclamdown\n"
"/cent /sterling /currency /yen /brokenbar /section /dieresis /copyright\n"
"/ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron\n"
"/degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n"
"/periodcentered /cedilla /onesuperior /ordmasculine /guillemotright\n"
"/onequarter /onehalf /threequarters /questiondown /Agrave /Aacute\n"
"/Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute\n"
"/Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth\n"
"/Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n"
"/Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n"
"/germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring /ae\n"
"/ccedilla /egrave /eacute /ecircumflex /edieresis /igrave /iacute\n"
"/icircumflex /idieresis /eth /ntilde /ograve /oacute /ocircumflex\n"
"/otilde /odieresis /divide /oslash /ugrave /uacute /ucircumflex\n"
"/udieresis /yacute /thorn /ydieresis]\n"
"def\n"
"\n",
fp_out
);
if (eXtended)
fputs (
"/RE {\n"
" findfont\n"
" dup maxlength dict begin {\n"
" 1 index /FID ne { def } { pop pop } ifelse\n"
" } forall\n"
" /Encoding exch def\n"
" dup /FontName exch def\n"
" currentdict end definefont pop\n"
"} bind def\n"
"\n"
"/Font-ISOlat1 ISOLatin1Encoding FontName RE\n",
fp_out
);
if (numbers) {
fprintf (fp_out, "/Font1 %s findfont FontSize scalefont def\n", eXtended ? "/Font-ISOlat1" : "FontName");
fputs (
"/Font2 FontName findfont NumFontSize scalefont def\n"
"\n"
"Font1 setfont\n",
fp_out
);
} else
fprintf (fp_out, "%s findfont FontSize scalefont setfont\n\n", eXtended ? "/Font-ISOlat1" : "FontName");
fputs (
"gsave\n"
" newpath\n"
" 0 0 moveto\n"
" (Ag) false charpath\n"
" pathbbox\n"
"grestore\n"
"/Up exch def\n"
"pop\n"
"neg /Down exch def\n"
"pop\n",
fp_out
);
if (numbers)
fputs ("Font2 setfont\n", fp_out);
fputs (
"gsave\n"
" newpath\n"
" 0 0 moveto\n",
fp_out
);
fprintf (fp_out, " (%c) false charpath\n", numbers ? '1' : 'x');
fputs (
" pathbbox\n"
"grestore\n"
"2 div /Shift exch def\n"
"pop\n"
"pop\n"
"pop\n"
"\n"
"/y TopMargin def\n"
"\n",
fp_out
);
fprintf (fp_out, "/Min %g def\n/Max %g def\n\n", minvalue, maxvalue);
if (evenodd)
fputs ("/oe false def\n\n", fp_out);
fputs (
"/nl {\n"
" /y y LineSkip add LineSkip2 sub def\n"
"} bind def\n"
"\n",
fp_out
);
if (patterns || symbols || numbers)
fputs (
"/Cstroke {\n"
" COL { /YY y def } if\n"
" stroke\n"
"} bind def\n"
"\n",
fp_out
);
else if (colorlabel && ! colorlink)
fputs (
"/Cstroke {\n"
" COL {\n"
" CURRENTCOLOR\n"
" 0 setgray\n"
" stroke\n"
" SETCOLOR\n"
" } {\n"
" stroke\n"
" } ifelse\n"
"} bind def\n"
"\n",
fp_out
);
else
fputs (
"/Cstroke {\n"
" stroke\n"
"} bind def\n"
"\n",
fp_out
);
if (colorlabel)
fputs (
"/Cshow {\n"
" COL {\n"
" gsave\n"
" -1 -1 Down sub rmoveto\n"
" dup stringwidth pop 2 add dup 0 rlineto\n"
" 0 Down Up add 2 add rlineto\n"
" neg 0 rlineto\n"
" closepath\n"
" fill\n"
" grestore\n"
" gsave\n"
" currentgray .4 gt { 0 } { 1 } ifelse setgray\n"
" show\n"
" grestore\n"
" } {\n"
" show\n"
" } ifelse\n"
"} bind def\n"
"\n",
fp_out
);
else if (colorlink)
fputs (
"/Cshow {\n"
" COL {\n"
" CURRENTCOLOR\n"
" 0 setgray\n"
" 4 -1 roll\n"
" show\n"
" SETCOLOR\n"
" } {\n"
" show\n"
" } ifelse\n"
"} bind def \n"
"\n",
fp_out
);
else if (numbers)
fputs (
"/Cshow {\n"
" Font1 setfont\n"
" show\n"
" Font2 setfont\n"
"} bind def\n"
"\n",
fp_out
);
else
fputs (
"/Cshow {\n"
" show\n"
"} bind def\n"
"\n",
fp_out
);
if (labels) {
fputs (
"% stack in: (label)\n"
"% stach out: x y\n"
"/l {\n"
" dup stringwidth pop\n"
" neg LeftMargin add 4 sub y Shift sub moveto\n",
fp_out
);
if (evenodd)
fputs (
" oe {\n"
" LeftMargin2 LeftMargin sub 0 rmoveto\n"
" Cshow\n"
" gsave\n"
" LeftMargin2 y moveto\n"
" LeftMargin 4 sub y lineto\n"
" 0 setgray\n"
" oelinewidth setlinewidth\n"
" stroke\n"
" grestore\n"
" /oe false def\n"
" } {\n"
" Cshow\n"
" /oe true def\n"
" } ifelse\n",
fp_out
);
else
fputs (
" Cshow\n",
fp_out
);
fputs (
" LeftMargin y\n"
" /y y LineSkip sub def\n"
"} bind def\n"
"\n",
fp_out
);
} else
fputs (
"% stack in: -\n"
"% stach out: x y\n"
"/l {\n"
" LeftMargin y\n"
" /y y LineSkip sub def\n"
"} bind def\n"
"\n",
fp_out
);
fputs (
"% stack in: x1 y1 x2 y2 value\n"
"% stack out: x3 y3\n"
"/c {\n"
" Min sub EXP Width mul Max Min sub EXP div LeftMargin add\n",
fp_out
);
if (linktype == RECT)
fputs (
" 5 1 roll\n"
" 3 index 3 index moveto\n"
" 4 index 3 index lineto\n"
" 4 index 1 index lineto\n"
" 1 index 1 index lineto\n"
" Cstroke\n"
" exch pop\n"
" add 2 div\n"
" exch pop\n",
fp_out
);
else if (linktype == ARC)
fputs (
" /x3 exch def\n"
" /y2 exch def\n"
" /x2 exch def\n"
" /y1 exch def\n"
" /x1 exch def\n"
" /y3 y1 y2 add 2 div def\n"
" x1 y1 moveto\n"
" x3 x1 sub .552284 mul x1 add y1\n"
" x3 y1 y3 sub .552284 mul y3 add\n"
" x3 y3 curveto\n"
" x3 y2 y3 sub .552284 mul y3 add\n"
" x3 x2 sub .552284 mul x2 add y2\n"
" x2 y2 curveto\n"
" Cstroke\n"
" x3 y3\n",
fp_out
);
else
fputs (
" /x3 exch def\n"
" /y2 exch def\n"
" /x2 exch def\n"
" /y1 exch def\n"
" /x1 exch def\n"
" /y3 y1 y2 add 2 div def\n"
" x1 y1 moveto\n"
" x3 y3 lineto\n"
" x2 y2 lineto\n"
" Cstroke\n"
" x3 y3\n",
fp_out
);
fputs (
"} bind def\n"
"\n",
fp_out
);
fputs (
"% stack in: x y (text)\n"
"% stack out: x y\n"
"/n {\n"
" 2 index 3 add\n"
" 2 index 2 add Down add\n"
" moveto\n"
" Cshow\n"
"} bind def\n"
"\n",
fp_out
);
process (top);
fputs (
"pop pop\n"
"\n",
fp_out
);
if (ruler) {
fputs ("% This draws the ruler\n", fp_out);
if (numbers)
fputs ("Font1 setfont\n", fp_out);
fputs (
"/setmark1 {\n"
" Min sub EXP Width mul Max Min sub EXP div LeftMargin add\n"
" y moveto\n"
" 0 2 rlineto\n"
" stroke\n"
"} bind def\n"
"\n"
"/setmark {\n"
" dup\n"
" Min sub EXP Width mul Max Min sub EXP div LeftMargin add\n"
" y moveto\n"
" gsave\n"
" 0 4 rlineto\n"
" stroke\n"
" grestore\n"
" 0 FontSize neg rmoveto\n"
" 20 string cvs\n"
" dup stringwidth pop 2 div neg 0 rmoveto\n"
" show\n"
"} bind def\n"
"\n"
"/y y LineSkip add RulerSkip sub def\n"
"0 RulerStep 5 div Max {\n"
" dup Min ge { setmark1 } { pop } ifelse\n"
"} for\n"
"0 RulerStep Max {\n"
" dup Min ge { setmark } { pop } ifelse\n"
"} for\n"
"RulerStep neg 5 div dup Min {\n"
" dup Max le { setmark1 } { pop } ifelse\n"
"} for\n"
"RulerStep neg dup Min {\n"
" dup Max le { setmark } { pop } ifelse\n"
"} for\n"
"LeftMargin y moveto\n"
"Width 0 rlineto stroke\n"
"\n"
"% This draws the vertical line for X equals 0\n"
"Min 0 lt Max 0 gt and {\n"
" Min neg EXP Width mul Max Min sub EXP div LeftMargin add\n"
" dup\n"
" y\n"
" moveto\n"
" TopMargin FontSize 2 div add\n"
" lineto\n"
" [ 3 ] 0 setdash\n"
" stroke\n"
"} if\n"
"\n",
fp_out
);
}
fputs (
"end\n"
"showpage\n"
"%%EOF\n",
fp_out
);
if (outfile)
fclose (fp_out);
return 0;
}
int main (int argc, char *argv [])
{
int
i,
j,
k,
n,
p1 = 0,
p2 = 0,
run,
runnoise,
nn_noise,
nn_maxcl,
n_total,
counter;
float
sum,
ssum,
sd,
d;
char
*infile = NULL;
FILE
*fp = NULL;
time_t
tp;
#ifdef __WIN32__
struct timeb
tb;
#endif
no_mem_buffer = (char *) malloc (1024);
get_programname (argv [0]);
update_function = NULL;
arg_c = argc;
arg_v = argv;
process_args ();
if (! update_function)
syntax ();
if (n_runs > 1 && ((! cophenetic) || ! n_noise))
errit ("-r only useful in combination with -b or -c, and -N");
if (n_maxcl && ! cophenetic)
errit ("-m only useful in combination with -b or -c");
if (n_noise > 1 && ! cophenetic)
errit ("Multiple noise levels only in combination with -b or -c");
if (binary && ! n_maxcl)
errit ("No -b without -m");
switch (arg_c) {
case 1:
if (isatty (fileno (stdin)))
syntax ();
fp = stdin;
infile = "<stdin>";
break;
case 2:
infile = arg_v [1];
fp = fopen (infile, "r");
if (! fp)
errit ("Opening file \"%s\": %s", infile, strerror (errno));
break;
default:
syntax ();
}
GetLine (fp, 1, infile);
if (sscanf (buffer, "%i", &size) != 1)
errit (
"file \"%s\", line %i\nTable size expected",
infile,
input_line
);
labels = (char **) s_malloc (size * sizeof (char *));
for (i = 0; i < size; i++) {
GetLine (fp, 1, infile);
labels [i] = s_strdup (buffer);
}
diff_in = (float **) s_malloc (size * sizeof (float *));
for (i = 1; i < size; i++)
diff_in [i] = (float *) s_malloc (i * sizeof (float));
for (i = 1; i < size; i++) {
for (j = 0; j < i; j++) {
GetLine (fp, 1, infile);
if (sscanf (buffer, "%f", &d) != 1)
errit ("file \"%s\", line %i\nValue expected", infile, input_line);
diff_in [i][j] = d;
}
}
if (fp != stdin)
fclose (fp);
for (i = 0; i < n_maxcl; i++)
if (maxcl [i] > size)
errit ("Value for -m too large");
if (cophenetic) {
diff_cp = (float **) s_malloc (size * sizeof (float *));
for (i = 1; i < size; i++) {
diff_cp [i] = (float *) s_malloc (i * sizeof (float));
for (j = 0; j < i; j++)
diff_cp [i][j] = 0;
}
}
diff = (float **) s_malloc ((2 * size - 1) * sizeof (float *));
for (i = 0; i < 2 * size - 1; i++)
diff [i] = (float *) s_malloc ((2 * size - 1) * sizeof (float));
sd = 0;
if (n_noise) {
#ifdef __WIN32__
ftime (&tb);
srand (tb.millitm ^ (tb.time << 8));
#else
srand (time (NULL) ^ (getpid () << 8));
#endif
if (seed)
srand (seed);
n = 0;
sum = ssum = 0.0;
for (i = 0; i < size; i++)
for (j = 0; j < i; j++) {
sum += diff_in [i][j];
ssum += diff_in [i][j] * diff_in [i][j];
n++;
}
sd = sqrt ((ssum - sum * sum / (float) n) / (float) (n - 1));
}
cl = (CLUSTER *) s_malloc ((2 * size - 1) * sizeof (CLUSTER));
nn_noise = n_noise ? n_noise : 1;
nn_maxcl = n_maxcl ? n_maxcl : 1;
n_total = n_runs * nn_noise * nn_maxcl;
counter = n_runs * nn_noise;
if (counter > 10)
verbose = 1;
for (run = 0; run < n_runs; run++) {
for (runnoise = 0; runnoise < nn_noise; runnoise++) {
checkCancel();
for (i = 0; i < size; i++) {
diff [i][i] = 0;
for (j = 0; j < i; j++)
diff [i][j] = diff [j][i] = diff_in [i][j];
}
if (n_noise)
for (i = 0; i < size; i++)
for (j = 0; j < i; j++)
diff [i][j] = diff [j][i] = diff [i][j] + noise [runnoise] * sd * (((float) rand ()) / (float) RAND_MAX);
for (i = 0; i < size; i++) {
cl [i].used = 0;
cl [i].n_items = 1;
cl [i].cl1 = cl [i].cl2 = -1;
cl [i].f = 0.0;
cl [i].cluster = i;
}
for (i = size; i < 2 * size - 1; i++) {
cl [i].used = 0;
d = FLT_MAX;
for (j = 0; j < i; j++)
if (! cl [j].used)
for (k = 0; k < j; k++)
if ((! cl [k].used) && (diff [j][k] < d)) {
p1 = j;
p2 = k;
d = diff [j][k];
}
cl [i].n_items = cl [p1].n_items + cl [p2].n_items;
cl [p1].used = cl [p2].used = 1;
cl [i].cl1 = p1;
cl [i].cl2 = p2;
cl [i].f = d;
cl [i].cluster = i;
if (cophenetic) {
if (n_maxcl) {
k = 0;
for (j = 0; j < n_maxcl; j++)
if (i > 2 * size - 1 - maxcl [j])
k++;
if (k)
update_cp (binary ? (k / (float) n_total) : (k * d / (float) n_total), p1, p2);
} else
update_cp (binary ? (1.0 / (float) n_total) : (d / (float) n_total), p1, p2);
}
update_function (i);
}
if (verbose) {
fprintf (stderr, " %i \r", counter--);
fflush (stderr);
}
}
}
if (verbose)
fprintf (stderr, " \r");
if (outfile) {
fp_out = fopen (outfile, "w");
if (! fp_out)
errit ("Creating file \"%s\": %s", outfile, strerror (errno));
} else
fp_out = stdout;
time (&tp);
fprintf (
fp_out,
"# Created by %s, (c) Peter Kleiweg 1998 - 2007\n"
"# More info: http://www.let.rug.nl/~kleiweg/L04/\n"
"# More info: http://www.let.rug.nl/~kleiweg/clustering/\n"
"# Input file: %s\n"
"# Clustering algorithm: %s\n",
programname,
infile,
name_update
);
if (cophenetic && ! binary)
fprintf (fp_out, "# Cophenetic differences\n");
if (cophenetic && binary)
fprintf (fp_out, "# Binary differences\n");
if (n_noise) {
fputs ("# Noise:", fp_out);
for (i = 0; i < n_noise; i++) {
if (i && (i % 8 == 0))
fprintf (fp_out, "\n# ");
fprintf (fp_out, " %g", noise [i]);
}
fputs ("\n", fp_out);
}
if (n_maxcl) {
fputs ("# Clusters:", fp_out);
for (i = 0; i < n_maxcl; i++) {
if (i && (i % 16 == 0))
fprintf (fp_out, "\n# ");
fprintf (fp_out, " %i", maxcl [i]);
}
fputs ("\n", fp_out);
}
if (n_runs > 1)
fprintf (fp_out, "# Runs: %i\n", n_runs);
fprintf (
fp_out,
"# Date: %s\n",
asctime (localtime (&tp))
);
if (cophenetic) {
fprintf (fp_out, "%i\n", size);
for (i = 0; i < size; i++)
fprintf (fp_out, "%s\n", labels [i]);
for (i = 1; i < size; i++)
for (j = 0; j < i; j++)
fprintf (fp_out, "%g\n", diff_cp [i][j]);
} else {
if (sorted)
sortclus (2 * size - 2);
for (i = size; i < 2 * size - 1; i++) {
fprintf (fp_out, "%i %g\n", i, cl [i].f);
if (cl [i].cl1 < size)
fprintf (fp_out, "L %s\n", labels [cl [i].cl1]);
else
fprintf (fp_out, "C %i\n", cl [i].cl1);
if (cl [i].cl2 < size)
fprintf (fp_out, "L %s\n", labels [cl [i].cl2]);
else
fprintf (fp_out, "C %i\n", cl [i].cl2);
}
}
if (outfile)
fclose (fp_out);
return 0;
}
