source: git/Singular/dyn_modules/interval/interval.cc @ d57b302

fieker-DuValspielwiese
Last change on this file since d57b302 was d57b302, checked in by Hans Schoenemann <hannes@…>, 7 years ago
fix: built-in version of interval.so
  • Property mode set to 100644
File size: 28.2 KB
Line 
1#include "kernel/mod2.h"
2#include "Singular/blackbox.h"
3#include "Singular/dyn_modules/interval/interval.h"
4#include "Singular/ipshell.h" // for iiCheckTypes
5#include "Singular/links/ssiLink.h"
6#include "Singular/mod_lib.h"
7
8/*
9 * CONSTRUCTORS & DESTRUCTORS
10 */
11
12/* interval */
13
14interval::interval()
15{
16    lower = nInit(0);
17    upper = nInit(0);
18    R = currRing;
19    R->ref++;
20}
21
22interval::interval(number a)
23{
24    lower = a;
25    upper = nCopy(a);
26    R = currRing;
27    R->ref++;
28}
29
30interval::interval(number a, number b)
31{
32    lower = a;
33    upper = b;
34    R = currRing;
35    R->ref++;
36}
37
38interval::interval(interval *I)
39{
40    lower = nCopy(I->lower);
41    upper = nCopy(I->upper);
42    R = I->R;
43    R->ref++;
44}
45
46interval::~interval()
47{
48    nDelete(&lower);
49    nDelete(&upper);
50    R->ref--;
51}
52
53/* box */
54
55box::box()
56{
57    R = currRing;
58    int i, n = R->N;
59    intervals = (interval**) omAlloc0(n * sizeof(interval*));
60    if (intervals != NULL)
61    {
62        for (i = 0; i < n; i++)
63        {
64            intervals[i] = new interval();
65        }
66    }
67    R->ref++;
68}
69
70box::box(box* B)
71{
72    R = B->R;
73    int i, n = R->N;
74    intervals = (interval**) omAlloc0(n * sizeof(interval*));
75    if (intervals != NULL)
76    {
77        for (i = 0; i < n; i++)
78        {
79            intervals[i] = new interval(B->intervals[i]);
80        }
81    }
82    R->ref++;
83}
84
85box::~box()
86{
87    int i, n = R->N;
88    for (i = 0; i < n; i++)
89    {
90        delete intervals[i];
91    }
92    omFree((void**) intervals);
93    R->ref--;
94}
95
96// does not copy
97box& box::setInterval(int i, interval *I)
98{
99    if (0 <= i && i < R->N)
100    {
101        delete intervals[i];
102        intervals[i] = I;
103    }
104    return *this;
105}
106
107/*
108 * TYPE IDs
109 */
110
111static int intervalID;
112static int boxID;
113
114/*
115 * INTERVAL FUNCTIONS
116 */
117
118static void* interval_Init(blackbox*)
119{
120    return (void*) new interval();
121}
122
123// convert interval to string
124static char* interval_String(blackbox*, void *d)
125{
126    if (d == NULL)
127    {
128        // invalid object
129        return omStrDup("[?]");
130    }
131    else
132    {
133        interval* i = (interval*) d;
134
135        // use nWrite since nothing better (?) exists
136        StringSetS("[");
137        nWrite(i->lower);
138        StringAppendS(", ");
139        nWrite(i->upper);
140        StringAppendS("]");
141
142        return StringEndS();
143    }
144}
145
146static void* interval_Copy(blackbox*, void *d)
147{
148    return (void*) new interval((interval*) d);
149}
150
151// destroy interval
152static void interval_Destroy(blackbox*, void *d)
153{
154    if (d != NULL)
155        delete (interval*) d;
156}
157
158// assigning values to intervals
159static BOOLEAN interval_Assign(leftv result, leftv args)
160{
161    assume(result->Typ() == intervalID);
162    interval *RES;
163
164    /*
165     * Allow assignments of the form
166     *  I = a,
167     *  I = a, b,
168     *  I = J
169     * where a, b numbers or ints and J interval
170     */
171
172    number n1, n2;
173
174    if (args->Typ() == INT_CMD)
175    {
176        n1 = nInit((int)(long) args->Data());
177    }
178    else if (args->Typ() == NUMBER_CMD)
179    {
180        n1 = (number) args->CopyD();
181    }
182    else if (args->Typ() == intervalID)
183    {
184        interval *I = (interval*) args->Data();
185        n1 = nCopy(I->lower);
186        n2 = nCopy(I->upper);
187    }
188    else
189    {
190        WerrorS("Input not supported: first argument not int or number");
191        return TRUE;
192    }
193
194    // check if second argument exists
195    if (args->Typ() == intervalID)
196    {
197        RES = new interval(n1, n2);
198    }
199    else if (args->next == NULL)
200    {
201        RES = new interval(n1);
202    }
203    else
204    {
205        if (args->next->Typ() == INT_CMD)
206        {
207            n2 = nInit((int)(long) args->next->Data());
208        }
209        else if (args->next->Typ() == NUMBER_CMD)
210        {
211            n2 = (number) args->next->CopyD();
212        }
213        else
214        {
215            WerrorS("Input not supported: second argument not int or number");
216            return TRUE;
217        }
218
219        RES = new interval(n1, n2);
220    }
221
222    // destroy data of result if it exists
223    if (result->Data() != NULL)
224    {
225        delete (interval*) result->Data();
226    }
227
228    if (result->rtyp == IDHDL)
229    {
230        IDDATA((idhdl)result->data) = (char*) RES;
231    }
232    else
233    {
234        result->rtyp = intervalID;
235        result->data = (void*) RES;
236    }
237
238    args->CleanUp();
239    return FALSE;
240}
241
242static BOOLEAN length(leftv result, leftv arg)
243{
244    if (arg != NULL && arg->Typ() == intervalID)
245    {
246        interval *I = (interval*) arg->Data();
247        result->rtyp = NUMBER_CMD;
248        result->data = (void*) nSub(I->upper, I->lower);
249        arg->CleanUp();
250        return FALSE;
251    }
252
253    WerrorS("syntax: length(<interval>)");
254    return TRUE;
255}
256
257// interval -> interval procedures
258
259static interval* intervalScalarMultiply(number a, interval *I)
260{
261    number lo, up;
262    if (nGreaterZero(a))
263    {
264        lo = nMult(a, I->lower);
265        up = nMult(a, I->upper);
266    }
267    else
268    {
269        lo = nMult(a, I->upper);
270        up = nMult(a, I->lower);
271    }
272
273    nNormalize(lo);
274    nNormalize(up);
275
276    return new interval(lo, up);
277}
278
279static interval* intervalMultiply(interval *I, interval *J)
280{
281    number lo, up;
282    number nums[4];
283    nums[0] = nMult(I->lower, J->lower);
284    nums[1] = nMult(I->lower, J->upper);
285    nums[2] = nMult(I->upper, J->lower);
286    nums[3] = nMult(I->upper, J->upper);
287
288    int i, imax = 0, imin = 0;
289    for (i = 1; i < 4; i++)
290    {
291        if (nGreater(nums[i], nums[imax]))
292        {
293            imax = i;
294        }
295        if (nGreater(nums[imin], nums[i]))
296        {
297            imin = i;
298        }
299    }
300
301    lo = nCopy(nums[imin]);
302    up = nCopy(nums[imax]);
303
304    // delete products
305    for (i = 0; i < 4; i++)
306    {
307        nDelete(&nums[i]);
308    }
309
310    nNormalize(lo);
311    nNormalize(up);
312
313    return new interval(lo, up);
314}
315
316static interval* intervalAdd(interval *I, interval *J)
317{
318    number lo = nAdd(I->lower, J->lower),
319           up = nAdd(I->upper, J->upper);
320
321    nNormalize(lo);
322    nNormalize(up);
323
324    return new interval(lo, up);
325}
326
327static interval* intervalSubtract(interval *I, interval *J)
328{
329    number lo = nSub(I->lower, J->upper),
330           up = nSub(I->upper, J->lower);
331
332    nNormalize(lo);
333    nNormalize(up);
334
335    return new interval(lo, up);
336}
337
338static bool intervalEqual(interval *I, interval *J)
339{
340    return nEqual(I->lower, J->lower) && nEqual(I->upper, J->upper);
341}
342
343// ckeck if zero is contained in an interval
344static bool intervalContainsZero(interval *I)
345{
346    number n = nMult(I->lower, I->upper);
347    bool result = !nGreaterZero(n);
348    // delete helper number
349    nDelete(&n);
350
351    return result;
352}
353
354static interval* intervalPower(interval *I, int p)
355{
356    if (p == 0)
357    {
358        return new interval(nInit(1));
359    }
360
361    // no initialisation required (?)
362    number lo, up;
363
364    nPower(I->lower, p, &lo);
365    nPower(I->upper, p, &up);
366
367    // should work now
368    if (p % 2 == 1)
369    {
370        return new interval(lo, up);
371    }
372    else
373    {
374        // perform pointer swap if necessary
375        number tmp;
376        if (nGreater(lo, up))
377        {
378            tmp = up;
379            up = lo;
380            lo = tmp;
381        }
382
383        if (intervalContainsZero(I))
384        {
385            nDelete(&lo);
386            lo = nInit(0);
387        }
388        return new interval(lo, up);
389    }
390}
391
392/*
393 * BINARY OPERATIONS:
394 * Cases handled:
395 *      I + J,
396 *
397 *      I - J,
398 *
399 *      a * J,
400 *      I * a,
401 *      I * J,
402 *
403 *      a / J,
404 *      I / a,
405 *      I / J
406 *
407 *      I ^ n,
408 *
409 *      I == J
410 *
411 *  where I, J, interval, a, b int or number, n int
412 */
413
414static BOOLEAN interval_Op2(int op, leftv result, leftv i1, leftv i2)
415{
416    interval *RES;
417
418    switch(op)
419    {
420        case '+':
421        {
422            if (i1->Typ() != intervalID || i2->Typ() != intervalID)
423            {
424                WerrorS("syntax: <interval> + <interval>");
425                return TRUE;
426            }
427            interval *I1, *I2;
428            I1 = (interval*) i1->Data();
429            I2 = (interval*) i2->Data();
430
431            RES = intervalAdd(I1, I2);
432            break;
433        }
434        case '-':
435        {
436            if (i1->Typ() != intervalID || i2->Typ() != intervalID)
437            {
438                WerrorS("syntax: <interval> - <interval>");
439                return TRUE;
440            }
441            interval *I1, *I2;
442            I1 = (interval*) i1->Data();
443            I2 = (interval*) i2->Data();
444
445            RES = intervalSubtract(I1, I2);
446            break;
447        }
448        case '*':
449        {
450            if (i1->Typ() == i2->Typ())
451            {
452                // both must be intervals
453                interval *I1, *I2;
454                I1 = (interval*) i1->Data();
455                I2 = (interval*) i2->Data();
456
457                RES = intervalMultiply(I1, I2);
458            }
459            else
460            {
461                // one arg is scalar, one is interval
462                // give new names to reduce to one case
463                leftv iscalar, iinterv;
464                if (i1->Typ() != intervalID)
465                {
466                    // i1 is scalar
467                    iscalar = i1;
468                    iinterv = i2;
469                }
470                else
471                {
472                    // i2 is scalar
473                    iscalar = i2;
474                    iinterv = i1;
475                }
476                number n;
477
478                switch (iscalar->Typ())
479                {
480                    case INT_CMD:
481                        { n = nInit((int)(long) iscalar->Data()); break; }
482                    case NUMBER_CMD:
483                        { n = (number) iscalar->CopyD(); break; }
484                    default:
485                        { WerrorS("first argument not int/number/interval"); return TRUE; }
486                }
487
488                interval *I = (interval*) iinterv->Data();
489
490                RES = intervalScalarMultiply(n, I);
491                // n no longer needed, delete it
492                nDelete(&n);
493            }
494
495            break;
496        }
497        case '/':
498        {
499            if(i2->Typ() == intervalID)
500            {
501                interval *I2;
502                I2 = (interval*) i2->Data();
503
504                // make sure I2 is invertible
505                if(intervalContainsZero(I2))
506                {
507                    WerrorS("second interval contains zero");
508                    return TRUE;
509                }
510
511                number invlo, invup;
512                invlo = nInvers(I2->lower);
513                invup = nInvers(I2->upper);
514
515                // inverse interval
516                interval *I2inv = new interval(invup, invlo);
517
518                if (i1->Typ() == intervalID)
519                {
520                    interval *I1 = (interval*) i1->Data();
521                    RES = intervalMultiply(I1, I2inv);
522                }
523                else
524                {
525                    // i1 is not an interval
526                    number n;
527                    switch (i1->Typ())
528                    {
529                        case INT_CMD:
530                        {
531                            n = nInit((int)(long) i1->Data());
532                            break;
533                        }
534                        case NUMBER_CMD:
535                        {
536                            n = nCopy((number) i1->Data());
537                            break;
538                        }
539                        default:
540                        {
541                            WerrorS("first argument not int/number/interval");
542                            delete I2inv;
543                            return TRUE;
544                        }
545                    }
546                    RES = intervalScalarMultiply(n, I2inv);
547                    nDelete(&n);
548                }
549
550                delete I2inv;
551                break;
552            }
553            else
554            {
555                // i2 is not an interval
556                interval *I1 = (interval*) i1->Data();
557                number n;
558                switch(i2->Typ())
559                {
560                    case INT_CMD:
561                        { n = nInit((int)(long) i2->Data()); break; }
562                    case NUMBER_CMD:
563                        { n = nCopy((number) i2->Data()); break; }
564                    default:
565                    {
566                        WerrorS("second argument not int/number/interval");
567                        return TRUE;
568                    }
569                }
570                // handle zero to prevent memory leak (?)
571                if (nIsZero(n))
572                {
573                    WerrorS("<interval>/0 not supported");
574                    return TRUE;
575                }
576
577                number nInv = nInvers(n);
578                nDelete(&n);
579                RES = intervalScalarMultiply(nInv, I1);
580                nDelete(&nInv);
581
582                break;
583            }
584
585            break;
586        }
587        case '^':
588        {
589            if (i1->Typ() != intervalID || i2->Typ() != INT_CMD)
590            {
591                WerrorS("syntax: <interval> ^ <int>");
592                return TRUE;
593            }
594            int p = (int)(long) i2->Data();
595            if (p < 0)
596            {
597                WerrorS("<interval> ^ n not implemented for n < 0");
598                return TRUE;
599            }
600            interval *I = (interval*) i1->Data();
601
602            RES = intervalPower(I, p);
603            break;
604        }
605        case EQUAL_EQUAL:
606        {
607            if (i1->Typ() != intervalID || i2->Typ() != intervalID)
608            {
609                WerrorS("syntax: <interval> == <interval>");
610                return TRUE;
611            }
612            interval *I1, *I2;
613            I1 = (interval*) i1->Data();
614            I2 = (interval*) i2->Data();
615
616            result->rtyp = INT_CMD;
617            result->data = (void*) intervalEqual(I1, I2);
618            i1->CleanUp();
619            i2->CleanUp();
620            return FALSE;
621        }
622        case '[':
623        {
624            if (i1->Typ() != intervalID || i2->Typ() != INT_CMD)
625            {
626                WerrorS("syntax: <interval>[<int>]");
627                return TRUE;
628            }
629
630            interval *I = (interval*) i1->Data();
631            int n = (int)(long) i2->Data();
632
633            number out;
634            if (n == 1)
635            {
636                out = nCopy(I->lower);
637            }
638            else if (n == 2)
639            {
640                out = nCopy(I->upper);
641            }
642            else
643            {
644                WerrorS("Allowed indices are 1 and 2");
645                return TRUE;
646            }
647
648            // delete number in result
649            if (result != NULL && result->Data() != NULL)
650            {
651                number r = (number) result->Data();
652                nDelete(&r);
653            }
654
655            result->rtyp = NUMBER_CMD;
656            result->data = (void*) out;
657            i1->CleanUp();
658            i2->CleanUp();
659            return FALSE;
660        }
661        default:
662        {
663            // use default error
664            return blackboxDefaultOp2(op, result, i1, i2);
665        }
666    }
667
668    // destroy data of result if it exists
669    if (result->Data() != NULL)
670    {
671        delete (interval*) result->Data();
672    }
673
674    result->rtyp = intervalID;
675    result->data = (void*) RES;
676    i1->CleanUp();
677    i2->CleanUp();
678    return FALSE;
679}
680
681static BOOLEAN interval_serialize(blackbox*, void *d, si_link f)
682{
683    /*
684     * Format: "interval" setring number number
685     */
686    interval *I = (interval*) d;
687
688    sleftv l, lo, up;
689    memset(&l, 0, sizeof(l));
690    memset(&lo, 0, sizeof(lo));
691    memset(&up, 0, sizeof(up));
692
693    l.rtyp = STRING_CMD;
694    l.data = (void*) "interval";
695
696    lo.rtyp = NUMBER_CMD;
697    lo.data = (void*) I->lower;
698
699    up.rtyp = NUMBER_CMD;
700    up.data = (void*) I->upper;
701
702    f->m->Write(f, &l);
703
704    ring R = I->R;
705
706    f->m->SetRing(f, R, TRUE);
707    f->m->Write(f, &lo);
708    f->m->Write(f, &up);
709
710    // no idea
711    if (R != currRing)
712        f->m->SetRing(f, currRing, FALSE);
713
714    return FALSE;
715}
716
717static BOOLEAN interval_deserialize(blackbox**, void **d, si_link f)
718{
719    leftv l;
720
721    l = f->m->Read(f);
722    l->next = f->m->Read(f);
723
724    number lo = (number) l->CopyD(),
725           up = (number) l->next->CopyD();
726
727    l->CleanUp();
728
729    *d = (void*) new interval(lo, up);
730    return FALSE;
731}
732
733/*
734 * BOX FUNCTIONS
735 */
736
737static void* box_Init(blackbox*)
738{
739    return (void*) new box();
740}
741
742static void* box_Copy(blackbox*, void *d)
743{
744    return (void*) new box((box*) d);
745}
746
747static void box_Destroy(blackbox*, void *d)
748{
749    if (d != NULL)
750        delete (box*) d;
751}
752
753static char* box_String(blackbox*, void *d)
754{
755    blackbox *b_i = getBlackboxStuff(intervalID);
756    box *B = (box*) d;
757    int i, n = B->R->N;
758
759    if (B == NULL || B->intervals == NULL)
760    {
761        return omStrDup("ooo");
762    }
763
764    StringSetS(interval_String(b_i, (void*) B->intervals[0]));
765
766    for (i = 1; i < n; i++)
767    {
768        // interpret box as Cartesian product, hence use " x "
769        StringAppendS(" x ");
770        StringAppendS(interval_String(b_i, (void*) B->intervals[i]));
771    }
772    return StringEndS();
773}
774
775// assigning values to intervals
776static BOOLEAN box_Assign(leftv result, leftv args)
777{
778    assume(result->Typ() == boxID);
779    box *RES;
780
781    /*
782     * Allow assignments of the form
783     *
784     *      B = C,
785     *      B = l,
786     *
787     * where B, C boxes, l list of intervals
788     */
789
790    if (args->Typ() == boxID)
791    {
792        box *B = (box*) args->Data();
793        RES = new box(B);
794    }
795    else if (args->Typ() == LIST_CMD)
796    {
797        RES = new box();
798        lists l = (lists) args->Data();
799
800        int i, m = lSize(l), n = currRing->N;
801        // minimum
802        int M = m > n ? n : m;
803
804        for (i = 0; i <= M; i++)
805        {
806            if (l->m[i].Typ() != intervalID)
807            {
808                WerrorS("list contains non-intervals");
809                delete RES;
810                args->CleanUp();
811                return TRUE;
812            }
813            RES->setInterval(i, (interval*) l->m[i].CopyD());
814
815            // make sure rings of boxes and their intervals are consistent
816            // this is important for serialization
817            if (RES->R != RES->intervals[i]->R)
818            {
819                if (RES->R->cf != RES->intervals[i]->R->cf)
820                {
821                    WerrorS("Passing interval to ring with different coefficient field");
822                    delete RES;
823                    args->CleanUp();
824                    return TRUE;
825                }
826
827                RES->intervals[i]->R->ref--;
828                RES->R->ref++;
829                RES->intervals[i]->R = RES->R;
830            }
831        }
832    }
833    else
834    {
835        WerrorS("Input not supported: first argument not box, list, or interval");
836        return TRUE;
837    }
838
839    // destroy data of result if it exists
840    if (result != NULL && result->Data() != NULL)
841    {
842        delete (box*) result->Data();
843    }
844
845    if (result->rtyp == IDHDL)
846    {
847        IDDATA((idhdl)result->data) = (char*) RES;
848    }
849    else
850    {
851        result->rtyp = boxID;
852        result->data = (void*) RES;
853    }
854    args->CleanUp();
855
856    return FALSE;
857}
858
859static BOOLEAN box_Op2(int op, leftv result, leftv b1, leftv b2)
860{
861    if (b1 == NULL || b1->Typ() != boxID)
862    {
863        Werror("first argument is not box but type(%d), second is type(%d)",
864            b1->Typ(), b2->Typ());
865        return TRUE;
866    }
867
868    box *B1 = (box*) b1->Data();
869    int n = B1->R->N;
870
871    box *RES;
872    switch(op)
873    {
874        case '[':
875        {
876            if (b2 == NULL || b2->Typ() != INT_CMD)
877            {
878                WerrorS("second argument not int");
879                return TRUE;
880            }
881            if (result->Data() != NULL)
882            {
883                delete (interval*) result->Data();
884            }
885
886            int i = (int)(long) b2->Data();
887
888            if (i < 1 || i > n)
889            {
890                WerrorS("index out of bounds");
891                return TRUE;
892            }
893
894            // delete data of result
895            if (result->Data() != NULL)
896            {
897                delete (interval*) result->Data();
898            }
899
900            result->rtyp = intervalID;
901            result->data = (void*) new interval(B1->intervals[i-1]);
902            b1->CleanUp();
903            b2->CleanUp();
904            return FALSE;
905        }
906        case '-':
907        {
908            if (b2 == NULL || b2->Typ() != boxID)
909            {
910                WerrorS("second argument not box");
911            }
912            if (result->Data() != NULL)
913            {
914                delete (box*) result->Data();
915            }
916
917            box *B2 = (box*) b2->Data();
918            // maybe try to skip this initialisation
919            // copying def of box() results in segfault?
920            RES = new box();
921            int i;
922            for (i = 0; i < n; i++)
923            {
924                RES->setInterval(i, intervalSubtract(B1->intervals[i], B2->intervals[i]));
925            }
926
927            if (result->Data() != NULL)
928            {
929                delete (box*) result->Data();
930            }
931
932            result->rtyp = boxID;
933            result->data = (void*) RES;
934            b1->CleanUp();
935            b2->CleanUp();
936            return FALSE;
937        }
938        case EQUAL_EQUAL:
939        {
940            if (b2 == NULL || b2->Typ() != boxID)
941            {
942                WerrorS("second argument not box");
943            }
944            box *B2 = (box*) b2->Data();
945            int i;
946            bool res = true;
947            for (i = 0; i < n; i++)
948            {
949                if (!intervalEqual(B1->intervals[i], B2->intervals[i]))
950                {
951                    res = false;
952                    break;
953                }
954            }
955
956            result->rtyp = INT_CMD;
957            result->data = (void*) res;
958            b1->CleanUp();
959            b2->CleanUp();
960            return FALSE;
961        }
962        default:
963            return blackboxDefaultOp2(op, result, b1, b2);
964    }
965}
966
967static BOOLEAN box_OpM(int op, leftv result, leftv args)
968{
969    leftv a = args;
970    switch(op)
971    {
972        case INTERSECT_CMD:
973        {
974            if (args->Typ() != boxID)
975            {
976                WerrorS("can only intersect boxes");
977                return TRUE;
978            }
979            box *B = (box*) args->Data();
980            int i, n = B->R->N;
981            number lowerb[n], upperb[n];
982
983            // do not copy, use same pointers, copy at the end
984            for (i = 0; i < n; i++)
985            {
986                lowerb[i] = B->intervals[i]->lower;
987                upperb[i] = B->intervals[i]->upper;
988            }
989
990            args = args->next;
991            while(args != NULL)
992            {
993                if (args->Typ() != boxID)
994                {
995                    WerrorS("can only intersect boxes");
996                    return TRUE;
997                }
998
999                B = (box*) args->Data();
1000                for (i = 0; i < n; i++)
1001                {
1002                    if (nGreater(B->intervals[i]->lower, lowerb[i]))
1003                    {
1004                        lowerb[i] = B->intervals[i]->lower;
1005                    }
1006                    if (nGreater(upperb[i], B->intervals[i]->upper))
1007                    {
1008                        upperb[i] = B->intervals[i]->upper;
1009                    }
1010
1011                    if (nGreater(lowerb[i], upperb[i]))
1012                    {
1013                        result->rtyp = INT_CMD;
1014                        result->data = (void*) (-1);
1015                        a->CleanUp();
1016                        return FALSE;
1017                    }
1018                }
1019                args = args->next;
1020            }
1021
1022            // now copy the numbers
1023            box *RES = new box();
1024            for (i = 0; i < n; i++)
1025            {
1026                RES->setInterval(i, new interval(nCopy(lowerb[i]), nCopy(upperb[i])));
1027            }
1028
1029            result->rtyp = boxID;
1030            result->data = (void*) RES;
1031            a->CleanUp();
1032            return FALSE;
1033        }
1034        default:
1035            return blackboxDefaultOpM(op, result, args);
1036    }
1037}
1038
1039static BOOLEAN box_serialize(blackbox*, void *d, si_link f)
1040{
1041    /*
1042     * Format: "box" setring intervals[1] .. intervals[N]
1043     */
1044    box *B = (box*) d;
1045    int N = B->R->N, i;
1046    sleftv l, iv;
1047    memset(&l, 0, sizeof(l));
1048    memset(&iv, 0, sizeof(iv));
1049
1050    l.rtyp = STRING_CMD;
1051    l.data = (void*) "box";
1052
1053    f->m->Write(f, &l);
1054
1055    f->m->SetRing(f, B->R, TRUE);
1056
1057    iv.rtyp = intervalID;
1058    for (i = 0; i < N; i++)
1059    {
1060        iv.data = (void*) B->intervals[i];
1061        f->m->Write(f, &iv);
1062    }
1063
1064    if (currRing != B->R)
1065        f->m->SetRing(f, currRing, FALSE);
1066
1067    return FALSE;
1068}
1069
1070static BOOLEAN box_deserialize(blackbox**, void **d, si_link f)
1071{
1072    leftv l;
1073
1074    // read once to set ring
1075    l = f->m->Read(f);
1076
1077    ring R = currRing;
1078    int i, N = R->N;
1079    box *B = new box();
1080
1081    B->setInterval(0, (interval*) l->CopyD());
1082    l->CleanUp();
1083
1084    for (i = 1; i < N; i++)
1085    {
1086        l = f->m->Read(f);
1087        B->setInterval(0, (interval*) l->CopyD());
1088        l->CleanUp();
1089    }
1090
1091    *d = (void*) B;
1092    return FALSE;
1093}
1094
1095static BOOLEAN boxSet(leftv result, leftv args)
1096{
1097    assume(result->Typ() == boxID);
1098
1099    // check for proper types
1100    const short t[] = {3, (short) boxID, INT_CMD, (short) intervalID};
1101    if (!iiCheckTypes(args, t, 1))
1102    {
1103        return TRUE;
1104    }
1105    box *B = (box*) args->Data();
1106    int n = B->R->N,
1107        i = (int)(long) args->next->Data();
1108    interval *I = (interval*) args->next->next->Data();
1109
1110    if (i < 1 || i > n)
1111    {
1112        WerrorS("index out of range");
1113        return TRUE;
1114    }
1115
1116    box *RES = new box(B);
1117
1118    RES->setInterval(i-1, new interval(I));
1119
1120    // same as above, ensure ring consistency
1121    if (RES->R != RES->intervals[i-1]->R)
1122    {
1123        if (RES->R->cf != RES->intervals[i-1]->R->cf)
1124        {
1125            WerrorS("Passing interval to ring with different coefficient field");
1126            delete RES;
1127            args->CleanUp();
1128            return TRUE;
1129        }
1130
1131        RES->intervals[i]->R->ref--;
1132        RES->R->ref++;
1133        RES->intervals[i]->R = RES->R;
1134    }
1135
1136    result->rtyp = boxID;
1137    result->data = (void*) RES;
1138    args->CleanUp();
1139    return FALSE;
1140}
1141
1142/*
1143 * POLY FUNCTIONS
1144 */
1145
1146static BOOLEAN evalPolyAtBox(leftv result, leftv args)
1147{
1148    assume(result->Typ() == intervalID);
1149
1150    const short t[] = {2, POLY_CMD, (short) boxID};
1151    if (!iiCheckTypes(args, t, 1))
1152    {
1153        return TRUE;
1154    }
1155
1156    poly p = (poly) args->Data();
1157    box *B = (box*) args->next->Data();
1158    int i, pot, n = B->R->N;
1159
1160    interval *tmp, *tmpPot, *tmpMonom, *RES = new interval();
1161
1162    while(p != NULL)
1163    {
1164        tmpMonom = new interval(nInit(1));
1165
1166        for (i = 1; i <= n; i++)
1167        {
1168            pot = pGetExp(p, i);
1169
1170            tmpPot = intervalPower(B->intervals[i-1], pot);
1171            tmp = intervalMultiply(tmpMonom, tmpPot);
1172
1173            delete tmpMonom;
1174            delete tmpPot;
1175
1176            tmpMonom = tmp;
1177        }
1178
1179        tmp = intervalScalarMultiply(p->coef, tmpMonom);
1180        delete tmpMonom;
1181        tmpMonom = tmp;
1182
1183        tmp = intervalAdd(RES, tmpMonom);
1184        delete RES;
1185        delete tmpMonom;
1186
1187        RES = tmp;
1188
1189        p = p->next;
1190    }
1191
1192    if (result->Data() != NULL)
1193    {
1194        delete (box*) result->Data();
1195    }
1196
1197    result->rtyp = intervalID;
1198    result->data = (void*) RES;
1199    args->CleanUp();
1200    return FALSE;
1201}
1202
1203/*
1204 * INIT MODULE
1205 */
1206
1207extern "C" int SI_MOD_INIT(interval)(SModulFunctions* psModulFunctions)
1208{
1209    blackbox *b_iv = (blackbox*) omAlloc0(sizeof(blackbox)),
1210             *b_bx = (blackbox*) omAlloc0(sizeof(blackbox));
1211
1212    b_iv->blackbox_Init        = interval_Init;
1213    b_iv->blackbox_Copy        = interval_Copy;
1214    b_iv->blackbox_destroy     = interval_Destroy;
1215    b_iv->blackbox_String      = interval_String;
1216    b_iv->blackbox_Assign      = interval_Assign;
1217    b_iv->blackbox_Op2         = interval_Op2;
1218    b_iv->blackbox_serialize   = interval_serialize;
1219    b_iv->blackbox_deserialize = interval_deserialize;
1220
1221    intervalID = setBlackboxStuff(b_iv, "interval");
1222
1223    b_bx->blackbox_Init        = box_Init;
1224    b_bx->blackbox_Copy        = box_Copy;
1225    b_bx->blackbox_destroy     = box_Destroy;
1226    b_bx->blackbox_String      = box_String;
1227    b_bx->blackbox_Assign      = box_Assign;
1228    b_bx->blackbox_Op2         = box_Op2;
1229    b_bx->blackbox_OpM         = box_OpM;
1230    b_bx->blackbox_serialize   = box_serialize;
1231    b_bx->blackbox_deserialize = box_deserialize;
1232
1233    boxID = setBlackboxStuff(b_bx, "box");
1234
1235    // add additional functions
1236    psModulFunctions->iiAddCproc("interval.so", "length", FALSE, length);
1237    psModulFunctions->iiAddCproc("interval.so", "boxSet", FALSE, boxSet);
1238    psModulFunctions->iiAddCproc("interval.so", "evalPolyAtBox", FALSE,
1239        evalPolyAtBox);
1240
1241    // TODO add help strings
1242
1243    return MAX_TOK;
1244}
1245
1246// vim: spell spelllang=en
Note: See TracBrowser for help on using the repository browser.