source: git/src/netbits.c @ 8a7804fb

main
Last change on this file since 8a7804fb was 0b99107, checked in by Olly Betts <olly@…>, 3 months ago

Eliminate old FSF addresses

Update GPL/LGPL licence files and boilerplate to direct people who
didn't receive the licence text to the FSF website, as the current
versions of the FSF licence texts now do, rather than giving a postal
address.

  • Property mode set to 100644
File size: 22.9 KB
Line 
1/* netbits.c
2 * Miscellaneous primitive network routines for Survex
3 * Copyright (C) 1992-2025 Olly Betts
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, see
17 * <https://www.gnu.org/licenses/>.
18 */
19
20#include <config.h>
21
22#if 0
23# define DEBUG_INVALID 1
24#endif
25
26#include "debug.h"
27#include "cavern.h"
28#include "filename.h"
29#include "message.h"
30#include "netbits.h"
31#include "datain.h" /* for compile_error */
32#include "osalloc.h"
33#include "validate.h"
34#include <math.h>
35
36#define THRESHOLD (REAL_EPSILON * 1000) /* 100 was too small */
37
38node *stn_iter = NULL; /* for FOR_EACH_STN */
39
40static struct {
41   prefix * to_name;
42   prefix * fr_name;
43   linkfor * leg;
44   int n;
45} last_leg = { NULL, NULL, NULL, 0 };
46
47void clear_last_leg(void) {
48   last_leg.to_name = NULL;
49}
50
51static char freeleg(node **stnptr);
52
53#ifdef NO_COVARIANCES
54static void check_var(const var *v) {
55   bool bad = false;
56
57   for (int i = 0; i < 3; i++) {
58      if (isnan(v[i])
59         printf("*** NaN!!!\n"), bad = true;
60   }
61   if (bad) print_var(v);
62   return;
63}
64#else
65#define V(A,B) ((*v)[A][B])
66static void check_var(const var *v) {
67   bool bad = false;
68   bool ok = false;
69#if DEBUG_INVALID
70   real det = 0.0;
71#endif
72
73   for (int i = 0; i < 3; i++) {
74      for (int j = 0; j < 3; j++) {
75         if (isnan(V(i, j)))
76            printf("*** NaN!!!\n"), bad = true, ok = true;
77         if (V(i, j) != 0.0) ok = true;
78      }
79   }
80   if (!ok) return; /* ignore all-zero matrices */
81
82#if DEBUG_INVALID
83   for (int i = 0; i < 3; i++) {
84      det += V(i, 0) * (V((i + 1) % 3, 1) * V((i + 2) % 3, 2) -
85                        V((i + 1) % 3, 2) * V((i + 2) % 3, 1));
86   }
87
88   if (fabs(det) < THRESHOLD)
89      printf("*** Singular!!!\n"), bad = true;
90#endif
91
92#if 0
93   /* don't check this - it isn't always the case! */
94   if (fabs(V(0,1) - V(1,0)) > THRESHOLD ||
95       fabs(V(0,2) - V(2,0)) > THRESHOLD ||
96       fabs(V(1,2) - V(2,1)) > THRESHOLD)
97      printf("*** Not symmetric!!!\n"), bad = true;
98   if (V(0,0) <= 0.0 || V(1,1) <= 0.0 || V(2,2) <= 0.0)
99      printf("*** Not positive definite (diag <= 0)!!!\n"), bad = true;
100   if (sqrd(V(0,1)) >= V(0,0)*V(1,1) || sqrd(V(0,2)) >= V(0,0)*V(2,2) ||
101       sqrd(V(1,0)) >= V(0,0)*V(1,1) || sqrd(V(2,0)) >= V(0,0)*V(2,2) ||
102       sqrd(V(1,2)) >= V(2,2)*V(1,1) || sqrd(V(2,1)) >= V(2,2)*V(1,1))
103      printf("*** Not positive definite (off diag^2 >= diag product)!!!\n"), bad = true;
104#endif
105   if (bad) print_var(*v);
106}
107
108#define SN(V,A,B) ((*(V))[(A)==(B)?(A):2+(A)+(B)])
109#define S(A,B) SN(v,A,B)
110
111static void check_svar(const svar *v) {
112   bool bad = false;
113   bool ok = false;
114#if DEBUG_INVALID
115   real det = 0.0;
116#endif
117
118   for (int i = 0; i < 6; i++) {
119      if (isnan((*v)[i]))
120         printf("*** NaN!!!\n"), bad = true, ok = true;
121      if ((*v)[i] != 0.0) ok = true;
122   }
123   if (!ok) return; /* ignore all-zero matrices */
124
125#if DEBUG_INVALID
126   for (int i = 0; i < 3; i++) {
127      det += S(i, 0) * (S((i + 1) % 3, 1) * S((i + 2) % 3, 2) -
128                        S((i + 1) % 3, 2) * S((i + 2) % 3, 1));
129   }
130
131   if (fabs(det) < THRESHOLD)
132      printf("*** Singular!!!\n"), bad = true;
133#endif
134
135#if 0
136   /* don't check this - it isn't always the case! */
137   if ((*v)[0] <= 0.0 || (*v)[1] <= 0.0 || (*v)[2] <= 0.0)
138      printf("*** Not positive definite (diag <= 0)!!!\n"), bad = true;
139   if (sqrd((*v)[3]) >= (*v)[0]*(*v)[1] ||
140       sqrd((*v)[4]) >= (*v)[0]*(*v)[2] ||
141       sqrd((*v)[5]) >= (*v)[1]*(*v)[2])
142      printf("*** Not positive definite (off diag^2 >= diag product)!!!\n"), bad = true;
143#endif
144   if (bad) print_svar(*v);
145}
146#endif
147
148static void check_d(const delta *d) {
149   bool bad = false;
150
151   for (int i = 0; i < 3; i++) {
152      if (isnan((*d)[i]))
153         printf("*** NaN!!!\n"), bad = true;
154   }
155
156   if (bad) printf("(%4.2f,%4.2f,%4.2f)\n", (*d)[0], (*d)[1], (*d)[2]);
157}
158
159/* insert at head of double-linked list */
160void
161add_stn_to_list(node **list, node *stn) {
162   SVX_ASSERT(list);
163   SVX_ASSERT(stn);
164   SVX_ASSERT(stn_iter != stn); /* if it does, we're still on a list... */
165#if 0
166   printf("add_stn_to_list(%p, [%p] ", list, stn);
167   if (stn->name) print_prefix(stn->name);
168   printf(")\n");
169#endif
170   stn->next = *list;
171   stn->prev = NULL;
172   if (*list) (*list)->prev = stn;
173   *list = stn;
174}
175
176/* remove from double-linked list */
177void
178remove_stn_from_list(node **list, node *stn) {
179   SVX_ASSERT(list);
180   SVX_ASSERT(stn);
181#if 0
182   printf("remove_stn_from_list(%p, [%p] ", list, stn);
183   if (stn->name) print_prefix(stn->name);
184   printf(")\n");
185#endif
186#if DEBUG_INVALID
187     {
188        /* Go back to the head of the list stn is actually on and
189         * check it's the same as the list we were asked to remove
190         * it from.
191         */
192        validate();
193        node *find_head = stn;
194        while (find_head->prev) {
195            find_head = find_head->prev;
196        }
197        SVX_ASSERT(find_head == *list);
198     }
199#endif
200   /* adjust the iterator if it points to the element we're deleting */
201   if (stn_iter == stn) stn_iter = stn_iter->next;
202   /* need a special case if we're removing the list head */
203   if (stn->prev == NULL) {
204      *list = stn->next;
205      if (*list) (*list)->prev = NULL;
206   } else {
207      stn->prev->next = stn->next;
208      if (stn->next) stn->next->prev = stn->prev;
209   }
210}
211
212/* Create (uses osmalloc) a forward leg containing the data in leg, or
213 * the reversed data in the reverse of leg, if leg doesn't hold data
214 */
215linkfor *
216copy_link(linkfor *leg)
217{
218   linkfor *legOut = osnew(linkfor);
219   if (data_here(leg)) {
220      for (int d = 2; d >= 0; d--) legOut->d[d] = leg->d[d];
221   } else {
222      leg = reverse_leg(leg);
223      SVX_ASSERT(data_here(leg));
224      for (int d = 2; d >= 0; d--) legOut->d[d] = -leg->d[d];
225   }
226#if 1
227# ifndef NO_COVARIANCES
228   check_svar(&(leg->v));
229   for (int i = 0; i < 6; i++) legOut->v[i] = leg->v[i];
230# else
231   for (int d = 2; d >= 0; d--) legOut->v[d] = leg->v[d];
232# endif
233#else
234   memcpy(legOut->v, leg->v, sizeof(svar));
235#endif
236   legOut->meta = pcs->meta;
237   if (pcs->meta) ++pcs->meta->ref_count;
238   return legOut;
239}
240
241/* Adds to the forward leg “leg”, the data in leg2, or the reversed data
242 * in the reverse of leg2, if leg2 doesn't hold data
243 */
244linkfor *
245addto_link(linkfor *leg, const linkfor *leg2)
246{
247   if (data_here(leg2)) {
248      adddd(&leg->d, &leg->d, &((linkfor *)leg2)->d);
249   } else {
250      leg2 = reverse_leg(leg2);
251      SVX_ASSERT(data_here(leg2));
252      subdd(&leg->d, &leg->d, &((linkfor *)leg2)->d);
253   }
254   addss(&leg->v, &leg->v, &((linkfor *)leg2)->v);
255   return leg;
256}
257
258static linkfor *
259addleg_(node *fr, node *to,
260        real dx, real dy, real dz,
261        real vx, real vy, real vz,
262#ifndef NO_COVARIANCES
263        real cyz, real czx, real cxy,
264#endif
265        int leg_flags)
266{
267   /* we have been asked to add a leg with the same node at both ends
268    * - this should be trapped by the caller */
269   SVX_ASSERT(fr->name != to->name);
270
271   linkfor *leg = osnew(linkfor);
272   linkfor *leg2 = (linkfor*)osnew(linkcommon);
273
274   int i = freeleg(&fr);
275   int j = freeleg(&to);
276
277   leg->l.to = to;
278   leg2->l.to = fr;
279   leg->d[0] = dx;
280   leg->d[1] = dy;
281   leg->d[2] = dz;
282#ifndef NO_COVARIANCES
283   leg->v[0] = vx;
284   leg->v[1] = vy;
285   leg->v[2] = vz;
286   leg->v[3] = cxy;
287   leg->v[4] = czx;
288   leg->v[5] = cyz;
289   check_svar(&(leg->v));
290#else
291   leg->v[0] = vx;
292   leg->v[1] = vy;
293   leg->v[2] = vz;
294#endif
295   leg2->l.reverse = i;
296   leg->l.reverse = j | FLAG_DATAHERE | leg_flags;
297
298   leg->l.flags = pcs->flags | (pcs->recorded_style << FLAGS_STYLE_BIT0);
299   leg->meta = pcs->meta;
300   if (pcs->meta) ++pcs->meta->ref_count;
301
302   fr->leg[i] = leg;
303   to->leg[j] = leg2;
304
305   return leg;
306}
307
308/* Add a leg between names *fr_name and *to_name
309 * If either is a three node, then it is split into two
310 * and the data structure adjusted as necessary.
311 */
312void
313addlegbyname(prefix *fr_name, prefix *to_name, bool fToFirst,
314             real dx, real dy, real dz,
315             real vx, real vy, real vz
316#ifndef NO_COVARIANCES
317             , real cyz, real czx, real cxy
318#endif
319             )
320{
321   if (to_name == fr_name) {
322      int type = pcs->from_equals_to_is_only_a_warning ? DIAG_WARN : DIAG_ERR;
323      /* TRANSLATORS: Here a "survey leg" is a set of measurements between two
324       * "survey stations".
325       *
326       * %s is replaced by the name of the station. */
327      compile_diagnostic(type, /*Survey leg with same station (“%s”) at both ends - typing error?*/50,
328                         sprint_prefix(to_name));
329      return;
330   }
331   node *to, *fr;
332   if (fToFirst) {
333      to = StnFromPfx(to_name);
334      fr = StnFromPfx(fr_name);
335   } else {
336      fr = StnFromPfx(fr_name);
337      to = StnFromPfx(to_name);
338   }
339   if (last_leg.to_name) {
340      if (last_leg.to_name == to_name && last_leg.fr_name == fr_name) {
341         /* FIXME: Not the right way to average... */
342         linkfor * leg = last_leg.leg;
343         int n = last_leg.n++;
344         leg->d[0] = (leg->d[0] * n + dx) / (n + 1);
345         leg->d[1] = (leg->d[1] * n + dy) / (n + 1);
346         leg->d[2] = (leg->d[2] * n + dz) / (n + 1);
347#ifndef NO_COVARIANCES
348         leg->v[0] = (leg->v[0] * n + vx) / (n + 1);
349         leg->v[1] = (leg->v[1] * n + vy) / (n + 1);
350         leg->v[2] = (leg->v[2] * n + vz) / (n + 1);
351         leg->v[3] = (leg->v[3] * n + cxy) / (n + 1);
352         leg->v[4] = (leg->v[4] * n + czx) / (n + 1);
353         leg->v[5] = (leg->v[5] * n + cyz) / (n + 1);
354         check_svar(&(leg->v));
355#else
356         leg->v[0] = (leg->v[0] * n + vx) / (n + 1);
357         leg->v[1] = (leg->v[1] * n + vy) / (n + 1);
358         leg->v[2] = (leg->v[2] * n + vz) / (n + 1);
359#endif
360         return;
361      }
362   }
363   cLegs++;
364
365   /* Suppress "unused fixed point" warnings for these stations. */
366   fr_name->sflags &= ~BIT(SFLAGS_UNUSED_FIXED_POINT);
367   to_name->sflags &= ~BIT(SFLAGS_UNUSED_FIXED_POINT);
368
369   last_leg.to_name = to_name;
370   last_leg.fr_name = fr_name;
371   last_leg.n = 1;
372   last_leg.leg = addleg_(fr, to, dx, dy, dz, vx, vy, vz,
373#ifndef NO_COVARIANCES
374                          cyz, czx, cxy,
375#endif
376                          0);
377}
378
379/* helper function for replace_pfx */
380static void
381replace_pfx_(node *stn, node *from, pos *pos_with, bool move_to_fixedlist)
382{
383   if (move_to_fixedlist) {
384      remove_stn_from_list(&stnlist, stn);
385      add_stn_to_list(&fixedlist, stn);
386   }
387   stn->name->pos = pos_with;
388   for (int d = 0; d < 3; d++) {
389      linkfor *leg = stn->leg[d];
390      if (!leg) break;
391      node *to = leg->l.to;
392      if (to == from) continue;
393
394      if (fZeros(data_here(leg) ? &leg->v : &reverse_leg(leg)->v))
395         replace_pfx_(to, stn, pos_with, move_to_fixedlist);
396   }
397}
398
399/* We used to iterate over the whole station list (inefficient) - now we
400 * just look at any neighbouring nodes to see if they are equated */
401static void
402replace_pfx(const prefix *pfx_replace, const prefix *pfx_with)
403{
404   SVX_ASSERT(pfx_replace);
405   SVX_ASSERT(pfx_with);
406   bool move_to_fixedlist = !pfx_fixed(pfx_replace) && pfx_fixed(pfx_with);
407   pos *pos_replace = pfx_replace->pos;
408   SVX_ASSERT(pos_replace != pfx_with->pos);
409
410   replace_pfx_(pfx_replace->stn, NULL, pfx_with->pos, move_to_fixedlist);
411
412#if DEBUG_INVALID
413   for (node *stn = stnlist; stn; stn = stn->next) {
414      SVX_ASSERT(stn->name->pos != pos_replace);
415   }
416   for (node *stn = fixedlist; stn; stn = stn->next) {
417      SVX_ASSERT(stn->name->pos != pos_replace);
418   }
419#endif
420
421   /* free the (now-unused) old pos */
422   free(pos_replace);
423}
424
425// Add equating leg between existing stations whose names are name1 and name2.
426void
427process_equate(prefix *name1, prefix *name2)
428{
429   clear_last_leg();
430   if (name1 == name2) {
431      /* catch something like *equate "fred fred" */
432      /* TRANSLATORS: Here "station" is a survey station, not a train station.
433       */
434      compile_diagnostic(DIAG_WARN, /*Station “%s” equated to itself*/13,
435                         sprint_prefix(name1));
436      return;
437   }
438   node *stn1 = StnFromPfx(name1);
439   node *stn2 = StnFromPfx(name2);
440   /* equate nodes if not already equated */
441   if (name1->pos != name2->pos) {
442      if (pfx_fixed(name1)) {
443         bool name2_fixed = pfx_fixed(name2);
444         if (name2_fixed) {
445            /* both are fixed, but let them off iff their coordinates match */
446            char *s = osstrdup(sprint_prefix(name1));
447            for (int d = 2; d >= 0; d--) {
448               if (name1->pos->p[d] != name2->pos->p[d]) {
449                  compile_diagnostic(DIAG_ERR, /*Tried to equate two non-equal fixed stations: “%s” and “%s”*/52,
450                                     s, sprint_prefix(name2));
451                  free(s);
452                  return;
453               }
454            }
455            /* TRANSLATORS: "equal" as in:
456             *
457             * *fix a 1 2 3
458             * *fix b 1 2 3
459             * *equate a b */
460            compile_diagnostic(DIAG_WARN, /*Equating two equal fixed points: “%s” and “%s”*/53,
461                               s, sprint_prefix(name2));
462            free(s);
463         }
464
465         /* name1 is fixed, so replace all refs to name2's pos with name1's */
466         replace_pfx(name2, name1);
467      } else {
468         /* name1 isn't fixed, so replace all refs to its pos with name2's */
469         replace_pfx(name1, name2);
470      }
471
472      /* Suppress "unused fixed point" warnings for these stations. */
473      name1->sflags &= ~BIT(SFLAGS_UNUSED_FIXED_POINT);
474      name2->sflags &= ~BIT(SFLAGS_UNUSED_FIXED_POINT);
475
476      /* count equates as legs for now... */
477      cLegs++;
478      addleg_(stn1, stn2,
479              (real)0.0, (real)0.0, (real)0.0,
480              (real)0.0, (real)0.0, (real)0.0,
481#ifndef NO_COVARIANCES
482              (real)0.0, (real)0.0, (real)0.0,
483#endif
484              FLAG_FAKE);
485   }
486}
487
488/* Add a 'fake' leg (not counted or treated as a use of a fixed point) between
489 * existing stations *fr and *to (which *must* be different).
490 *
491 * If either node is a three node, then it is split into two
492 * and the data structure adjusted as necessary.
493 */
494void
495addfakeleg(node *fr, node *to,
496           real dx, real dy, real dz,
497           real vx, real vy, real vz
498#ifndef NO_COVARIANCES
499           , real cyz, real czx, real cxy
500#endif
501           )
502{
503   clear_last_leg();
504   addleg_(fr, to, dx, dy, dz, vx, vy, vz,
505#ifndef NO_COVARIANCES
506           cyz, czx, cxy,
507#endif
508           FLAG_FAKE);
509}
510
511static char
512freeleg(node **stnptr)
513{
514   node *stn = *stnptr;
515
516   if (stn->leg[0] == NULL) return 0; /* leg[0] unused */
517   if (stn->leg[1] == NULL) return 1; /* leg[1] unused */
518   if (stn->leg[2] == NULL) return 2; /* leg[2] unused */
519
520   /* All legs used, so split node in two */
521   node *newstn = osnew(node);
522   linkfor *leg = osnew(linkfor);
523   linkfor *leg2 = (linkfor*)osnew(linkcommon);
524
525   *stnptr = newstn;
526
527   add_stn_to_list(fixed(stn) ? &fixedlist : &stnlist, newstn);
528   newstn->name = stn->name;
529
530   leg->l.to = newstn;
531   leg->d[0] = leg->d[1] = leg->d[2] = (real)0.0;
532
533#ifndef NO_COVARIANCES
534   for (int i = 0; i < 6; i++) leg->v[i] = (real)0.0;
535#else
536   leg->v[0] = leg->v[1] = leg->v[2] = (real)0.0;
537#endif
538   leg->l.reverse = 1 | FLAG_DATAHERE | FLAG_FAKE;
539   leg->l.flags = pcs->flags | (pcs->recorded_style << FLAGS_STYLE_BIT0);
540
541   leg2->l.to = stn;
542   leg2->l.reverse = 0;
543
544   // NB this preserves pos->stn->leg[0] pointing to the "real" fixed point
545   // for stations fixed with error estimates.
546   newstn->leg[0] = stn->leg[0];
547   // Update the reverse leg.
548   reverse_leg(newstn->leg[0])->l.to = newstn;
549   newstn->leg[1] = leg2;
550
551   stn->leg[0] = leg;
552
553   newstn->leg[2] = NULL; /* needed as newstn->leg[dirn]==NULL indicates unused */
554
555   return 2; /* leg[2] unused */
556}
557
558node *
559StnFromPfx(prefix *name)
560{
561   if (name->stn != NULL) return name->stn;
562   node *stn = osnew(node);
563   stn->name = name;
564   bool fixed = false;
565   if (name->pos == NULL) {
566      name->pos = osnew(pos);
567      unfix(stn);
568   } else {
569      fixed = pfx_fixed(name);
570   }
571   stn->leg[0] = stn->leg[1] = stn->leg[2] = NULL;
572   add_stn_to_list(fixed ? &fixedlist : &stnlist, stn);
573   name->stn = stn;
574   // Don't re-count a station which already exists from before a `*solve`.
575   // After we solve we delete and NULL-out its `node*`, but set SFLAGS_SOLVED.
576   if (!TSTBIT(name->sflags, SFLAGS_SOLVED)) cStns++;
577   return stn;
578}
579
580extern void
581fprint_prefix(FILE *fh, const prefix *ptr)
582{
583   SVX_ASSERT(ptr);
584   if (TSTBIT(ptr->sflags, SFLAGS_ANON)) {
585      /* We release the stations, so ptr->stn is NULL late on, so we can't
586       * use that to print "anonymous station surveyed from somesurvey.12"
587       * here.  FIXME */
588      fputs("anonymous station", fh);
589      /* FIXME: if ident is set, show it? */
590      return;
591   }
592   if (ptr->up != NULL) {
593      fprint_prefix(fh, ptr->up);
594      if (ptr->up->up != NULL) fputc(output_separator, fh);
595      SVX_ASSERT(prefix_ident(ptr));
596      fputs(prefix_ident(ptr), fh);
597   }
598}
599
600static char *buffer = NULL;
601static size_t buffer_len = 256;
602
603static size_t
604sprint_prefix_(const prefix *ptr)
605{
606   size_t len = 1;
607   if (ptr->up != NULL) {
608      const char *ident = prefix_ident(ptr);
609      SVX_ASSERT(ident);
610      len = sprint_prefix_(ptr->up);
611      size_t end = len - 1;
612      if (ptr->up->up != NULL) len++;
613      len += strlen(ident);
614      if (len > buffer_len) {
615         buffer = osrealloc(buffer, len);
616         buffer_len = len;
617      }
618      char *p = buffer + end;
619      if (ptr->up->up != NULL) *p++ = output_separator;
620      strcpy(p, ident);
621   }
622   return len;
623}
624
625extern char *
626sprint_prefix(const prefix *ptr)
627{
628   SVX_ASSERT(ptr);
629   if (!buffer) buffer = osmalloc(buffer_len);
630   if (TSTBIT(ptr->sflags, SFLAGS_ANON)) {
631      /* We release the stations, so ptr->stn is NULL late on, so we can't
632       * use that to print "anonymous station surveyed from somesurvey.12"
633       * here.  FIXME */
634      strcpy(buffer, "anonymous station");
635      /* FIXME: if ident is set, show it? */
636      return buffer;
637   }
638   *buffer = '\0';
639   sprint_prefix_(ptr);
640   return buffer;
641}
642
643/* r = ab ; r,a,b are variance matrices */
644void
645mulss(var *r, const svar *a, const svar *b)
646{
647#ifdef NO_COVARIANCES
648   /* variance-only version */
649   (*r)[0] = (*a)[0] * (*b)[0];
650   (*r)[1] = (*a)[1] * (*b)[1];
651   (*r)[2] = (*a)[2] * (*b)[2];
652#else
653#if 0
654   SVX_ASSERT((const var *)r != a);
655   SVX_ASSERT((const var *)r != b);
656#endif
657
658   check_svar(a);
659   check_svar(b);
660
661   for (int i = 0; i < 3; i++) {
662      for (int j = 0; j < 3; j++) {
663         real tot = 0;
664         for (int k = 0; k < 3; k++) {
665            tot += SN(a,i,k) * SN(b,k,j);
666         }
667         (*r)[i][j] = tot;
668      }
669   }
670   check_var(r);
671#endif
672}
673
674#ifndef NO_COVARIANCES
675/* r = ab ; r,a,b are variance matrices */
676void
677smulvs(svar *r, const var *a, const svar *b)
678{
679#if 0
680   SVX_ASSERT((const var *)r != a);
681#endif
682   SVX_ASSERT((const svar *)r != b);
683
684   check_var(a);
685   check_svar(b);
686
687   (*r)[3]=(*r)[4]=(*r)[5]=-999;
688   for (int i = 0; i < 3; i++) {
689      for (int j = 0; j < 3; j++) {
690         real tot = 0;
691         for (int k = 0; k < 3; k++) {
692            tot += (*a)[i][k] * SN(b,k,j);
693         }
694         if (i <= j)
695            SN(r,i,j) = tot;
696         else if (fabs(SN(r,j,i) - tot) > THRESHOLD) {
697            printf("not sym - %d,%d = %f, %d,%d was %f\n",
698                   i,j,tot,j,i,SN(r,j,i));
699            BUG("smulvs didn't produce a sym mx\n");
700         }
701      }
702   }
703   check_svar(r);
704}
705#endif
706
707/* r = vb ; r,b delta vectors; a variance matrix */
708void
709mulsd(delta *r, const svar *v, const delta *b)
710{
711#ifdef NO_COVARIANCES
712   /* variance-only version */
713   (*r)[0] = (*v)[0] * (*b)[0];
714   (*r)[1] = (*v)[1] * (*b)[1];
715   (*r)[2] = (*v)[2] * (*b)[2];
716#else
717   SVX_ASSERT((const delta*)r != b);
718   check_svar(v);
719   check_d(b);
720
721   for (int i = 0; i < 3; i++) {
722      real tot = 0;
723      for (int j = 0; j < 3; j++) tot += S(i,j) * (*b)[j];
724      (*r)[i] = tot;
725   }
726   check_d(r);
727#endif
728}
729
730/* r = ca ; r,a variance matrices; c real scaling factor  */
731void
732mulsc(svar *r, const svar *a, real c)
733{
734#ifdef NO_COVARIANCES
735   /* variance-only version */
736   (*r)[0] = (*a)[0] * c;
737   (*r)[1] = (*a)[1] * c;
738   (*r)[2] = (*a)[2] * c;
739#else
740   check_svar(a);
741   for (int i = 0; i < 6; i++) (*r)[i] = (*a)[i] * c;
742   check_svar(r);
743#endif
744}
745
746/* r = a + b ; r,a,b delta vectors */
747void
748adddd(delta *r, const delta *a, const delta *b)
749{
750   check_d(a);
751   check_d(b);
752   (*r)[0] = (*a)[0] + (*b)[0];
753   (*r)[1] = (*a)[1] + (*b)[1];
754   (*r)[2] = (*a)[2] + (*b)[2];
755   check_d(r);
756}
757
758/* r = a - b ; r,a,b delta vectors */
759void
760subdd(delta *r, const delta *a, const delta *b) {
761   check_d(a);
762   check_d(b);
763   (*r)[0] = (*a)[0] - (*b)[0];
764   (*r)[1] = (*a)[1] - (*b)[1];
765   (*r)[2] = (*a)[2] - (*b)[2];
766   check_d(r);
767}
768
769/* r = a + b ; r,a,b variance matrices */
770void
771addss(svar *r, const svar *a, const svar *b)
772{
773#ifdef NO_COVARIANCES
774   /* variance-only version */
775   (*r)[0] = (*a)[0] + (*b)[0];
776   (*r)[1] = (*a)[1] + (*b)[1];
777   (*r)[2] = (*a)[2] + (*b)[2];
778#else
779   check_svar(a);
780   check_svar(b);
781   for (int i = 0; i < 6; i++) (*r)[i] = (*a)[i] + (*b)[i];
782   check_svar(r);
783#endif
784}
785
786/* r = a - b ; r,a,b variance matrices */
787void
788subss(svar *r, const svar *a, const svar *b)
789{
790#ifdef NO_COVARIANCES
791   /* variance-only version */
792   (*r)[0] = (*a)[0] - (*b)[0];
793   (*r)[1] = (*a)[1] - (*b)[1];
794   (*r)[2] = (*a)[2] - (*b)[2];
795#else
796   check_svar(a);
797   check_svar(b);
798   for (int i = 0; i < 6; i++) (*r)[i] = (*a)[i] - (*b)[i];
799   check_svar(r);
800#endif
801}
802
803/* inv = v^-1 ; inv,v variance matrices */
804extern int
805invert_svar(svar *inv, const svar *v)
806{
807#ifdef NO_COVARIANCES
808   for (int i = 0; i < 3; i++) {
809      if ((*v)[i] == 0.0) return 0; /* matrix is singular */
810      (*inv)[i] = 1.0 / (*v)[i];
811   }
812#else
813#if 0
814   SVX_ASSERT((const var *)inv != v);
815#endif
816
817   check_svar(v);
818   /* a d e
819    * d b f
820    * e f c
821    */
822   real a = (*v)[0], b = (*v)[1], c = (*v)[2];
823   real d = (*v)[3], e = (*v)[4], f = (*v)[5];
824   real bcff = b * c - f * f;
825   real efcd = e * f - c * d;
826   real dfbe = d * f - b * e;
827   real det = a * bcff + d * efcd + e * dfbe;
828
829   if (det == 0.0) {
830      /* printf("det=%.20f\n", det); */
831      return 0; /* matrix is singular */
832   }
833
834   det = 1 / det;
835
836   (*inv)[0] = det * bcff;
837   (*inv)[1] = det * (c * a - e * e);
838   (*inv)[2] = det * (a * b - d * d);
839   (*inv)[3] = det * efcd;
840   (*inv)[4] = det * dfbe;
841   (*inv)[5] = det * (e * d - a * f);
842
843#if 0
844   /* This test fires very occasionally, and there's not much point in
845    * it anyhow - the matrix inversion algorithm is simple enough that
846    * we can be confident it's correctly implemented, so we might as
847    * well save the cycles and not perform this check.
848    */
849     { /* check that original * inverse = identity matrix */
850        int i;
851        var p;
852        real D = 0;
853        mulss(&p, v, inv);
854        for (i = 0; i < 3; i++) {
855           int j;
856           for (j = 0; j < 3; j++) D += fabs(p[i][j] - (real)(i==j));
857        }
858        if (D > THRESHOLD) {
859           printf("original * inverse=\n");
860           print_svar(*v);
861           printf("*\n");
862           print_svar(*inv);
863           printf("=\n");
864           print_var(p);
865           BUG("matrix didn't invert");
866        }
867        check_svar(inv);
868     }
869#endif
870#endif
871   return 1;
872}
873
874/* r = (b^-1)a ; r,a delta vectors; b variance matrix */
875#ifndef NO_COVARIANCES
876void
877divds(delta *r, const delta *a, const svar *b)
878{
879#ifdef NO_COVARIANCES
880   /* variance-only version */
881   (*r)[0] = (*a)[0] / (*b)[0];
882   (*r)[1] = (*a)[1] / (*b)[1];
883   (*r)[2] = (*a)[2] / (*b)[2];
884#else
885   svar b_inv;
886   if (!invert_svar(&b_inv, b)) {
887      print_svar(*b);
888      BUG("covariance matrix is singular");
889   }
890   mulsd(r, &b_inv, a);
891#endif
892}
893#endif
894
895bool
896fZeros(const svar *v) {
897#ifdef NO_COVARIANCES
898   /* variance-only version */
899   return ((*v)[0] == 0.0 && (*v)[1] == 0.0 && (*v)[2] == 0.0);
900#else
901   check_svar(v);
902   for (int i = 0; i < 6; i++) if ((*v)[i] != 0.0) return false;
903
904   return true;
905#endif
906}
Note: See TracBrowser for help on using the repository browser.