"Fossies" - the Fresh Open Source Software Archive 
As a special service "Fossies" has tried to format the requested text file into HTML format (style:
standard) with prefixed line numbers.
Alternatively you can here
view or
download the uninterpreted source code file.
1 #############################################################################
2 ##
3 #F List( <obj> ) . . . . . . . . . . . . . . . . . . . . . convert to a list
4 ## Attention, the overloader handles this
5 ##
6 ## documentation see lib/init-methods.g
7 _List_func_list:=
8 function(fun,lis)
9 local res, i;
10
11 Print("\n");
12 Print("## WARNING! List(func, list) is soon to be renamed to Apply(...)\n");
13 Print("## To use `List' prefer functional Apply!\n");
14 Print("## Transisition time ends 2005-Feb-06!\n");
15
16 res:=[];
17 for i in lis do
18 _Add__list_any(res, fun(i));
19 od;
20 return res;
21 end;
22 _List_list_func:=
23 function(lis,fun)
24 return _List_func_list(fun,lis);
25 end;
26 _List_any:=
27 function(lis)
28 return List(lis);
29 end;
30
31
32 #############################################################################
33 ##
34 #F GetEntry( <record>, <string> [, optarg] )
35 ##
36 ## documentation see lib/init-methods.g
37 _GetEntry_rec_string:=
38 function(arg)
39 local re,spec,optarg;
40 CheckArgs(arg,["re","spec","optarg"],[,,rec(Fail:=FAILURE)]);
41 re:=__ARGREC.("re");
42 spec:=__ARGREC.("spec");
43 optarg:=__ARGREC.("optarg");
44 if IsRec(re) and IsBound(re.(spec)) then
45 return re.(spec);
46 fi;
47 ## overall-else
48 if IsBound(optarg.("Fail")) then
49 return optarg.Fail;
50 else
51 return FAILURE;
52 fi;
53 end;
54 _GetFailEntry:=re->_GetEntry_rec_string(re,"Fail",rec(Fail:=FAILURE));
55 _GetSuccessEntry:=re->_GetEntry_rec_string(re,"Success",rec(Fail:=SUCCESS));
56 #############################################################################
57 ##
58 #F GetEntry( <list>, <elt-ord^rat> [, optarg] )
59 ##
60 ## documentation see lib/init-methods.g
61 _GetEntry_list_eor:=
62 function(arg)
63 local lis,pos,optarg;
64 CheckArgs(arg,["lis","pos","optarg"],[,,rec(Fail:=FAILURE)]);
65 lis:=__ARGREC.("lis");
66 pos:=__ARGREC.("pos");
67 optarg:=__ARGREC.("optarg");
68 if IsInt(pos) and pos>0 and IsBound(lis[pos]) then
69 return lis[pos];
70 fi;
71 return _GetEntry_rec_string(optarg,"Fail",rec(Fail:=FAILURE));
72 end;
73
74
75
76 #############################################################################
77 ##
78 #F Butfirst( <list> ) (a.k.a. Rest)
79 ##
80 ## documentation see lib/init-methods.g
81 Butfirst:=
82 lis->_Remove_list_eor(lis,1);
83 Butfirst_:=
84 lis->_Remove__list_eor(lis,1);
85 Rest:=Butfirst;
86 Rest_:=Butfirst_;
87
88 #############################################################################
89 ##
90 #F First( <list> )
91 ##
92 ## documentation see lib/init-methods.g
93 First:=
94 lis->_GetEntry_list_eor(lis,1);
95
96 #############################################################################
97 ##
98 #F Butlast( <list> )
99 ##
100 Butlast:=
101 lis->_Remove_list_eor(lis,_Size_list(lis));
102 Butlast_:=
103 lis->_Remove__list_eor(lis,_Size_list(lis));
104
105 #############################################################################
106 ##
107 #F Last( <list> )
108 ##
109 ## documentation see lib/init-methods.g
110 Last:=
111 lis->_GetEntry_list_eor(lis,_Size_list(lis));
112
113
114
115 #############################################################################
116 ##
117 #F Apply_( <list>, <func> ) . apply a function to list entries destructively
118 ##
119 ## documentation see lib/init-methods.g
120 _Apply__func_list:=
121 function(fun,lis)
122 local i, a;
123
124 for i in [1.._Size_list(lis)] do
125 a := lis[i];
126 lis[i] := fun(a);
127 od;
128 end;
129 _Apply__list_func:=
130 function(lis,fun)
131 local i, a;
132
133 for i in [1.._Size_list(lis)] do
134 a := lis[i];
135 lis[i] := fun(a);
136 od;
137 end;
138
139 #############################################################################
140 ##
141 #F Apply( <list>, <func> ) . . . . . . . . apply a function to list entries
142 ##
143 ## documentation see lib/init-methods.g
144 _Apply_func_list:=
145 function(fun,lis)
146 local res, i;
147
148 # Print("\n");
149 # Print("## WARNING! Apply(...) now has same functionality as List(...)\n");
150 # Print("## To use applicative Apply prefer Apply_\n");
151 # Print("## Transisition time ends 2005-Feb-06!\n");
152
153 res:=[];
154 for i in lis do
155 _Add__list_any(res, fun(i));
156 od;
157 return res;
158 end;
159 _Apply_list_func:=
160 function(lis,fun)
161 return _Apply_func_list(fun,lis);
162 end;
163
164
165
166 #############################################################################
167 ##
168 #F Mapc(<func>, <list>)
169 ##
170 Mapc:=
171 function(fun,lis)
172 local i;
173 for i in lis do
174 fun(i);
175 od;
176 end;
177
178
179 #############################################################################
180 ##
181 #F Maprec(<func>, <record>)
182 ##
183 Maprec:=
184 function(fun,re)
185 local i;
186 for i in RecFields(re) do
187 fun(re.(i));
188 od;
189 end;
190
191
192 #############################################################################
193 ##
194 #F RunHookWithArg( <list>, <any> ) . . . . . . . .
195 ##
196 RunHookWithArg:=
197 function(hook,arg)
198 local i,gather,tmp;
199 gather:=[];
200 for i in hook do
201 tmp:=i(arg);
202 if not(tmp=VOID) then
203 _Add__list_any(gather,tmp);
204 fi;
205 od;
206 if gather=[] then
207 return VOID;
208 else
209 return gather;
210 fi;
211 end;
212
213
214 #############################################################################
215 ##
216 #F Mapconcat(<func>, <list>, <sep>) . . . . . . . . concatentation of lists
217 #F Mapconcat(<func>, <list>) . . . . . . . . . . . . concatentation of lists
218 ##
219 _Mapconcat_func_list_string:=
220 function(fun,lis,sep)
221 local i,gather;
222
223 gather:="";
224 if lis=false then
225 return false;
226 elif _Size_list(lis)=0 then
227 return gather;
228 else
229 for i in Butlast(lis) do
230 gather:=gather+fun(i)+sep;
231 od;
232 gather:=gather+fun(Last(lis));
233 return gather;
234 fi;
235 end;
236 _Mapconcat_func_list:=
237 function(fun,lis)
238 return(_Mapconcat_func_list_string(fun,lis," "));
239 end;
240
241
242
243 #############################################################################
244 ##
245 #F Concatenation( <list>, <list> ) . . . . . . . . . concatentation of lists
246 ##
247 Concatenation:= function(arg)
248 local cat, lst, len, i;
249
250 if _Size_list(arg)=0 then
251 return [];
252 elif _Size_list(arg)=1 and IsList(arg[1]) then
253 cat := [];
254 for lst in arg[1] do
255 Append_(cat, lst);
256 od;
257 else
258 cat := Copy(arg[1]);
259 len := _Size_list(arg);
260 for i in [2..len] do
261 Append_(cat, arg[i]);
262 od;
263
264 fi;
265 return cat;
266 end;
267
268
269 #############################################################################
270 ##
271 #F Flat( <list> ) . . . . . . . list of elements of a nested list structure
272 ##
273 Flat:=function(lis)
274 local flt, elm;
275
276 # make the flattened list
277 flt := [];
278 for elm in lis do
279 if not IsList(elm) then
280 _Add__list_any(flt, elm);
281 else
282 Append_( flt, Flat(elm) );
283 fi;
284 od;
285
286 # and return it
287 return flt;
288 end;
289
290
291 #############################################################################
292 ##
293 #F Reversed( <list> ) . . . . . . . . . . . reverse the elements in a list
294 ##
295 Reversed:=function(lis)
296 local rev, len, i;
297
298 rev := [];
299 len := _Size_list(lis);
300 for i in [0..len-1] do
301 _Add__list_any(rev, lis[len-i]);
302 od;
303
304 return rev;
305 end;
306
307
308 #############################################################################
309 ##
310 #F Sublist( <list>, <list> ) . . . . . . . . . . . extract a part of a list
311 ##
312 Sublist := function ( list1, list2 )
313 local sub, i;
314
315 sub := [];
316 for i in list2 do
317 _Add__list_any( sub, list1[i] );
318 od;
319
320 return sub;
321 end;
322
323
324 #############################################################################
325 ##
326 #F Filtered( <list>, <func> ) . . . . extract elements that have a property
327 ##
328 _Filtered_func_list:=
329 function(fun,lis)
330 local flt, elm;
331
332 flt := [];
333 for elm in lis do
334 if fun(elm) then
335 _Add__list_any(flt, elm);
336 fi;
337 od;
338
339 return flt;
340 end;
341 _Filtered_list_func:=
342 function(lis,fun)
343 return _Filtered_func_list(fun,lis);
344 end;
345
346
347 #############################################################################
348 ##
349 #F Filter( <func> ) . . . . . . . . . extract elements that have a property
350 ##
351 Filter:=
352 function(arg)
353 local fun;
354 fun := arg[1];
355 return
356 function(arg)
357 if IsBound(arg[1]) then
358 if IsString(arg[1]) then
359 return _Filtered_func_list(fun,arg);
360 elif IsList(arg[1]) then
361 return _Filtered_func_list(fun,arg[1]);
362 else
363 return _Filtered_func_list(fun,arg);
364 fi;
365 else
366 return VOID;
367 fi;
368 end;
369 end;
370
371
372 #############################################################################
373 ##
374 #F Number( <list> [, <func>] ) . . . . . count elements that have a property
375 ##
376 _Number_list:=
377 function(lis)
378 local nr, elm;
379
380 nr := 0;
381 for elm in lis do
382 nr := nr + 1;
383 od;
384 return nr;
385 end;
386 _Number_func_list:=
387 function(fun,lis)
388 local nr, elm;
389
390 nr := 0;
391 for elm in lis do
392 if fun(elm) then
393 nr:=nr+1;
394 fi;
395 od;
396 return nr;
397 end;
398 _Number_list_func:=
399 function(lis,fun)
400 return _Number_func_list(fun,lis);
401 end;
402 _Number_func:=
403 function(arg)
404 local fun;
405 fun := arg[1];
406 return
407 function(arg)
408 if IsBound(arg[1]) then
409 if IsString(arg[1]) then
410 return _Number_func_list(fun,arg);
411 elif IsList(arg[1]) then
412 return _Number_func_list(fun,arg[1]);
413 else
414 return _Number_func_list(fun,arg);
415 fi;
416 else
417 return VOID;
418 fi;
419 end;
420 end;
421
422
423 #############################################################################
424 ##
425 #F Compacted( <list> ) . . . . .
426 ##
427 Compacted :=
428 function(lis)
429 local res, # compacted of <list>, result
430 elm; # element of <list>
431 res := [];
432 for elm in lis do
433 _Add__list_any(res, elm);
434 od;
435 return res;
436 end;
437
438
439 #############################################################################
440 ##
441 #F Collected( <list> ) . . . . .
442 ##
443 Collected := function ( list )
444 local col, # collected of <list>, result
445 elm, # element of <list>
446 nr, # number of elements of <list> equal to <elm>
447 i; # loop variable
448
449 col := [];
450 for elm in Set( list ) do
451 nr := 0;
452 for i in list do
453 if i = elm then
454 nr := nr + 1;
455 fi;
456 od;
457 _Add__list_any( col, [ elm, nr ] );
458 od;
459 return col;
460 end;
461
462
463 #############################################################################
464 ##
465 #F Equivalenceclasses( <list>, <function> ) . calculate equivalence classes
466 ##
467 ##
468 ## returns
469 ##
470 ## rec(
471 ## classes := <list>,
472 ## indices := <list>
473 ## )
474 ##
475 Equivalenceclasses := function( list, isequal )
476 local ecl, idx, len, new, i, j;
477
478 if not IsList( list ) or not IsFunc( isequal ) then
479 Error( "usage: Equivalenceclasses( <list>, <function> )" );
480 fi;
481
482 len := 0;
483 ecl := [];
484 idx := [];
485 for i in [1.._Size_list( list )] do
486 new := true;
487 j := 1;
488 while new and j <= len do
489 if isequal( list[i], ecl[j][1] ) then
490 _Add__list_any( ecl[j], list[i] );
491 _Add__list_any( idx[j], i );
492 new := false;
493 fi;
494 j := j + 1;
495 od;
496 if new then
497 len := len + 1;
498 ecl[len] := [ list[i] ];
499 idx[len] := [ i ];
500 fi;
501 od;
502 return rec( classes := ecl, indices := idx );
503 end;
504
505
506 #############################################################################
507 ##
508 #F ForAll( <list>, <func> ) . . test a property for all elements of a list
509 ##
510 _ForAll_func_list:=
511 function(fun,lis)
512 local l;
513 for l in lis do
514 if not fun(l) then
515 return false;
516 fi;
517 od;
518 return true;
519 end;
520 _ForAll_list_func:=
521 function(lis,fun)
522 return _ForAll_func_list(fun,lis);
523 end;
524 _ForAll_func:=
525 function(arg)
526 local fun;
527 fun := arg[1];
528 return
529 function(arg)
530 if IsBound(arg[1]) then
531 if IsString(arg[1]) then
532 return _ForAll_func_list(fun,arg);
533 elif IsList(arg[1]) then
534 return _ForAll_func_list(fun,arg[1]);
535 else
536 return _ForAll_func_list(fun,arg);
537 fi;
538 else
539 return VOID;
540 fi;
541 end;
542 end;
543
544
545 #############################################################################
546 ##
547 #F ForAny( <list>, <func> ) . . . test a property for any element of a list
548 ##
549 _ForAny_func_list:=
550 function(fun,lis)
551 local l;
552
553 for l in lis do
554 if fun(l) then
555 return true;
556 fi;
557 od;
558 return false;
559 end;
560 _ForAny_list_func:=
561 function(lis,fun)
562 return _ForAny_func_list(fun,lis);
563 end;
564 _ForAny_func:=
565 function(arg)
566 local fun;
567 fun := arg[1];
568 return
569 function(arg)
570 if IsBound(arg[1]) then
571 if IsString(arg[1]) then
572 return _ForAny_func_list(fun,arg);
573 elif IsList(arg[1]) then
574 return _ForAny_func_list(fun,arg[1]);
575 else
576 return _ForAny_func_list(fun,arg);
577 fi;
578 else
579 return VOID;
580 fi;
581 end;
582 end;
583
584
585 #############################################################################
586 ##
587 #F First( <list>, <func> ) . . find first element in a list with a property
588 ##
589 _First_func_list:=
590 function(arg)
591 local fun,lis,optarg,l;
592
593 ## first of all, check the args
594 CheckArgs(arg,["fun","lis","optarg"],[,,__FAILUREREC]);
595 fun:=__ARGREC.("fun");
596 lis:=__ARGREC.("lis");
597 optarg:=__ARGREC.("optarg");
598
599 for l in lis do
600 if fun(l) then
601 return l;
602 fi;
603 od;
604 return _GetFailEntry(optarg);
605 end;
606 _First_list_func:=
607 function(arg)
608 local fun,lis,optarg;
609
610 ## first of all, check the args
611 CheckArgs(arg,["lis","fun","optarg"],[,,__FAILUREREC]);
612 fun:=__ARGREC.("fun");
613 lis:=__ARGREC.("lis");
614 optarg:=__ARGREC.("optarg");
615
616 return _First_func_list(fun,lis,optarg);
617 end;
618 _First_func:=
619 function(arg)
620 local fun,optarg;
621
622 ## first of all, check the args
623 CheckArgs(arg,["fun","optarg"],[,__FAILUREREC]);
624 fun:=__ARGREC.("fun");
625 optarg:=__ARGREC.("optarg");
626
627 return
628 function(arg)
629 if IsBound(arg[1]) then
630 if IsString(arg[1]) then
631 return _First_func_list(fun,arg,optarg);
632 elif IsList(arg[1]) then
633 return _First_func_list(fun,arg[1],optarg);
634 else
635 return _First_func_list(fun,arg,optarg);
636 fi;
637 else
638 return _GetFailEntry(optarg);
639 fi;
640 end;
641 end;
642
643
644 #############################################################################
645 ##
646 #F Last( <list>, <func> ) . . . find last element in a list with a property
647 ##
648 _Last_func_list:=
649 function(arg)
650 local fun,lis,optarg,l;
651
652 ## first of all, check the args
653 CheckArgs(arg,["fun","lis","optarg"],[,,__FAILUREREC]);
654 fun:=__ARGREC.("fun");
655 lis:=__ARGREC.("lis");
656 optarg:=__ARGREC.("optarg");
657
658 return _First_func_list(fun,Reversed(lis),optarg);
659 end;
660 _Last_list_func:=
661 function(arg)
662 local fun,lis,optarg;
663
664 ## first of all, check the args
665 CheckArgs(arg,["lis","fun","optarg"],[,,__FAILUREREC]);
666 fun:=__ARGREC.("fun");
667 lis:=__ARGREC.("lis");
668 optarg:=__ARGREC.("optarg");
669
670 return _Last_func_list(fun,lis,optarg);
671 end;
672 _Last_func:=
673 function(arg)
674 local fun,optarg;
675
676 ## first of all, check the args
677 CheckArgs(arg,["fun","optarg"],[,__FAILUREREC]);
678 fun:=__ARGREC.("fun");
679 optarg:=__ARGREC.("optarg");
680
681 return
682 function(arg)
683 if IsBound(arg[1]) then
684 if IsString(arg[1]) then
685 return _Last_func_list(fun,arg,optarg);
686 elif IsList(arg[1]) then
687 return _Last_func_list(fun,arg[1],optarg);
688 else
689 return _Last_func_list(fun,arg,optarg);
690 fi;
691 else
692 return _GetFailEntry(optarg);
693 fi;
694 end;
695 end;
696
697
698
699 #############################################################################
700 ##
701 #F PositionProperty( <list>, <func> ) position of an element with a property
702 ##
703 _PositionProperty_func_list:=
704 function(arg)
705 local fun,lis,i,optarg,elm;
706
707 ## now check the args
708 CheckArgs(arg,["fun","lis","optarg"],[,,__FAILUREREC]);
709 fun:=__ARGREC.("fun");
710 lis:=__ARGREC.("lis");
711 optarg:=__ARGREC.("optarg");
712
713 for i in [1.._Size_list(lis)] do
714 elm := _GetEntry_list_eor(lis,i,__FAILUREREC);
715 if IsSuccess(elm) then
716 if fun(elm) then
717 return i;
718 fi;
719 fi;
720 od;
721 return _GetFailEntry(optarg);
722 end;
723 _PositionProperty_list_func:=
724 function(arg)
725 local fun,lis,optarg;
726
727 ## now check the args
728 CheckArgs(arg,["lis","fun","optarg"],[,,__FAILUREREC]);
729 fun:=__ARGREC.("fun");
730 lis:=__ARGREC.("lis");
731 optarg:=__ARGREC.("optarg");
732
733 return _PositionProperty_func_list(fun,lis,optarg);
734 end;
735 _PositionProperty_func:=
736 function(arg)
737 local fun;
738 fun := arg[1];
739 return
740 function(arg)
741 if IsBound(arg[1]) then
742 if IsString(arg[1]) then
743 return _PositionProperty_func_list(fun,arg);
744 elif IsList(arg[1]) then
745 return _PositionProperty_func_list(fun,arg[1]);
746 else
747 return _PositionProperty_func_list(fun,arg);
748 fi;
749 else
750 return FAILURE;
751 fi;
752 end;
753 end;
754
755
756 #############################################################################
757 ##
758 #F PositionBound( <list> ) . . . . . . . . . . position of first bound entry
759 ##
760 PositionBound :=
761 function(lis)
762 local i;
763
764 # look for the first bound element
765 for i in [1..Length(lis)] do
766 if IsBound(lis[i]) then
767 return i;
768 fi;
769 od;
770 # no bound element found
771 return FAILURE;
772 end;
773
774
775
776 #############################################################################
777 ##
778 #F Cartesian( <list>, <list>.. ) . . . . . . . . cartesian product of lists
779 ##
780 Cartesian2 := function ( list, n, tup, i )
781 local tups, l;
782 if i = n+1 then
783 tup := Copy(tup);
784 tups := [ tup ];
785 else
786 tups := [];
787 for l in list[i] do
788 tup[i] := l;
789 Append_( tups, Cartesian2( list, n, tup, i+1 ) );
790 od;
791 fi;
792 return tups;
793 end;
794
795 Cartesian:=function(arg)
796 if _Size_list(arg) = 1 then
797 return Cartesian2( arg[1], _Size_list(arg[1]), [], 1 );
798 else
799 return Cartesian2( arg, _Size_list(arg), [], 1 );
800 fi;
801 end;
802
803
804 #############################################################################
805 ##
806 #F Sort( <list> ) . . . . . . . . . . . . . . . . . . . . . . . sort a list
807 ##
808 ## Sort() uses Shell's diminishing increment sort, which extends bubblesort.
809 ## The bubble sort works by running through the list again and again,
810 ## each time exchanging pairs of adjacent elements which are out of order.
811 ## Thus large elements "bubble" to the top, hence the name of the method.
812 ## However elements need many moves to come close to their final position.
813 ## In shellsort the first passes do not compare element j with its neighbor
814 ## but with the element j+h, where h is larger than one. Thus elements that
815 ## aren't at their final position make large moves towards the destination.
816 ## This increment h is diminished, until during the last pass it is one.
817 ## A good sequence of incremements is given by Knuth: (3^k-1)/2,... 13,4,1.
818 ## For this sequence shellsort uses on average approximatly N^1.25 moves.
819 ##
820 ## Shellsort is the method of choice to sort lists for various reasons:
821 ## Shellsort is quite easy to get right, much easier than, say, quicksort.
822 ## It runs as fast as quicksort for lists with less than ~5000 elements.
823 ## It handles both almost sorted and reverse sorted lists very good.
824 ## It works well in the presence of duplicate elements in the list.
825 ## Says Sedgewick: "In short, if you have a sorting problem, use the above
826 ## program, then determine whether the extra effort required to replace it
827 ## with a sophisticated method will be worthwile."
828 ##
829 ## Donald Knuth, The Art of Computer Programming, Vol.3, AddWes 1973, 84-95
830 ## Donald Shell, CACM 2, July 1959, 30-32
831 ## Robert Sedgewick, Algorithms 2nd ed., AddWes 1988, 107-123
832 ##
833 Sort := function ( arg )
834 local list, isLess, i, k, h, v;
835
836 if _Size_list(arg) = 1 and IsList(arg[1]) then
837 list := arg[1];
838 h := 1; while 9 * h + 4 < _Size_list(list) do h := 3 * h + 1; od;
839 while 0 < h do
840 for i in [ h+1 .. _Size_list(list) ] do
841 v := list[i]; k := i;
842 while h < k and v < list[k-h] do
843 list[k] := list[k-h]; k := k - h;
844 od;
845 list[k] := v;
846 od;
847 h := Div( h, 3 );
848 od;
849
850 elif _Size_list(arg) = 2 and IsList(arg[1]) and IsFunc(arg[2]) then
851 list := arg[1]; isLess := arg[2];
852 h := 1; while 9 * h + 4 < _Size_list(list) do h := 3 * h + 1; od;
853 while 0 < h do
854 for i in [ h+1 .. _Size_list(list) ] do
855 v := list[i]; k := i;
856 while h < k and isLess( v, list[k-h] ) do
857 list[k] := list[k-h]; k := k - h;
858 od;
859 list[k] := v;
860 od;
861 h := Div( h, 3 );
862 od;
863
864 else
865 Error("usage: Sort( <list> ) or Sort( <list>, <func> )");
866 fi;
867
868 end;
869
870
871 #############################################################################
872 ##
873 #F Sortex(<list>) . . . sort a list (stable), return the applied permutation
874 ##
875 Sortex :=
876 function(lis)
877 local both, perm, i;
878
879 # make a new list that contains the elements of <list> and their indices
880 both := [];
881 for i in [1..Length(lis)] do
882 both[i] := [lis[i], i];
883 od;
884
885 # sort the new list according to the first item (stable)
886 Sort(both);
887
888 # copy back and remember the permutation
889 perm := [];
890 for i in [1..Length(lis)] do
891 lis[i] := both[i][1];
892 perm[i] := both[i][2];
893 od;
894
895 # return the permutation mapping old <list> onto the sorted list
896 return PermList( perm )^(-1);
897 end;
898
899
900 #############################################################################
901 ##
902 #F SortParallel(<list>,<list2>) . . . . . . . . sort two lists in parallel
903 ##
904 SortParallel := function ( arg )
905 local lst, # list <lst> to be sorted, first argument
906 par, # list <par> to be sorted parallel, second argument
907 isLess, # comparison function, optional third argument
908 gap, # gap width
909 l, p, # elements from <lst> and <par>
910 i, k; # loop variables
911
912 if _Size_list(arg) = 2 and IsList(arg[1]) then
913 lst := arg[1];
914 par := arg[2];
915 gap := 1; while 9*gap+4 < _Size_list(lst) do gap := 3*gap+1; od;
916 while 0 < gap do
917 for i in [ gap+1 .. _Size_list(lst) ] do
918 l := lst[i]; p := par[i]; k := i;
919 while gap < k and l < lst[k-gap] do
920 lst[k] := lst[k-gap]; par[k] := par[k-gap]; k := k-gap;
921 od;
922 lst[k] := l; par[k] := p;
923 od;
924 gap := Div( gap, 3 );
925 od;
926
927 elif _Size_list(arg) = 3 and IsList(arg[1]) and IsFunc(arg[3]) then
928 lst := arg[1];
929 par := arg[2];
930 isLess := arg[3];
931 gap := 1; while 9*gap+4 < _Size_list(lst) do gap := 3*gap+1; od;
932 while 0 < gap do
933 for i in [ gap+1 .. _Size_list(lst) ] do
934 l := lst[i]; p := par[i]; k := i;
935 while gap < k and isLess( l, lst[k-gap] ) do
936 lst[k] := lst[k-gap]; par[k] := par[k-gap]; k := k-gap;
937 od;
938 lst[k] := l; par[k] := p;
939 od;
940 gap := Div( gap, 3 );
941 od;
942
943 else
944 Error("usage: SortParallel(<lst>,<par>[,<func>])");
945 fi;
946
947 end;
948
949
950
951 #############################################################################
952 ##
953 #F Permuted( <list>, <perm> ) . . . apply permutation <perm> to list <list>
954 ##
955 Permuted := function ( list, perm )
956 local permuted, i;
957 permuted := [];
958 for i in [1.._Size_list(list)] do
959 permuted[i^perm] := list[i];
960 od;
961 return permuted;
962 end;
963
964
965 #############################################################################
966 ##
967 #F PositionSorted( <list>, <elm> ) . . . . find an element in a sorted list
968 ##
969 ## 'PositionSorted' uses a binary search instead of the linear search used
970 ## 'Position'. This takes log to base 2 of '_Size_list( <list> )' comparisons.
971 ## The list <list> must be sorted however for 'PositionSorted' to work.
972 ##
973 ## Jon Bentley, Programming Pearls, AddWes 1986, 85-88
974 ##
975 ### REVISE ME!
976 PositionSorted := function ( arg )
977 local list, elm, isLess, l, m, h;
978
979 if _Size_list(arg) = 2 and IsList(arg[1]) then
980 list := arg[1]; elm := arg[2];
981 l := 0; h := _Size_list(list)+1;
982 while l+1 < h do # list[l]<elm & elm<=list[h] & l+1<h
983 m := Div( l + h, 2 ); # l < m < h
984 if list[m] < elm then l := m;
985 else h := m;
986 fi;
987 od;
988 return h; # list[l]<elm & elm<=list[h] & l+1=h
989
990 elif _Size_list(arg) = 3 and IsList(arg[1]) and Type(arg[3])=func then
991 list := arg[1]; elm := arg[2]; isLess := arg[3];
992 l := 0; h := _Size_list(list)+1;
993 while l+1 < h do # list[l]<elm & elm<=list[h] & l+1<h
994 m := Div( l + h, 2 ); # l < m < h
995 if isLess( list[m], elm ) then l := m;
996 else h := m;
997 fi;
998 od;
999 return h; # list[l]<elm & elm<=list[h] & l+1=h
1000
1001 else
1002 Error("usage: PositionSorted( <list>, <elm> [, <func>] )");
1003 fi;
1004 end;
1005
1006
1007 #############################################################################
1008 ##
1009 #F Product( <list> ) . . . . . . . . . . . product of the elements in a list
1010 ##
1011 ## 'Product( <list> )' \\
1012 ## 'Product( <list>, <func> )'
1013 ##
1014 ## When used in the first way 'Product' returns the product of the elements
1015 ## of the list <list>. When used in the second way 'Product' applies the
1016 ## function <func>, which must be a function taking one argument, and
1017 ## returns the product of the results. In either case if <list> is empty
1018 ## 'Product' returns 1.
1019 ##
1020 _Product_list:=
1021 function(lis)
1022 local prod, i;
1023
1024 if not IsList(lis) then
1025 return _Product(lis);
1026 fi;
1027 if _Size_list(lis) = 0 then
1028 prod := 1;
1029 else
1030 prod := lis[1];
1031 for i in [ 2 .. _Size_list(lis) ] do
1032 prod := prod * lis[i];
1033 od;
1034 fi;
1035 return prod;
1036 end;
1037 _Product_func_list:=
1038 function(fun,lis)
1039 local prod, i;
1040
1041 if _Size_list(lis) = 0 then
1042 prod := 1;
1043 else
1044 prod := fun( lis[1] );
1045 for i in [ 2 .. _Size_list(lis) ] do
1046 prod := prod * fun( lis[i] );
1047 od;
1048 fi;
1049 return prod;
1050 end;
1051 _Product_list_func:=
1052 function(lis,fun)
1053 return _Product_func_list(fun,lis);
1054 end;
1055 _Product_func:=
1056 function(fun)
1057 return
1058 function(arg)
1059 if IsBound(arg[1]) then
1060 if IsString(arg[1]) then
1061 return _Product_func_list(fun,arg);
1062 elif IsList(arg[1]) then
1063 return _Product_func_list(fun,arg[1]);
1064 else
1065 return _Product_func_list(fun,arg);
1066 fi;
1067 else
1068 return VOID;
1069 fi;
1070 end;
1071 end;
1072
1073
1074 #############################################################################
1075 ##
1076 #F Sum( <list> ) . . . . . . . . . . . . . . . sum of the elements of a list
1077 ##
1078 _Sum_list:=
1079 function(lis)
1080 local sum, i;
1081
1082 if not IsList(lis) then
1083 return _Sum(lis);
1084 fi;
1085 if _Size_list(lis) = 0 then
1086 sum := 0;
1087 else
1088 sum := lis[1];
1089 for i in [2.._Size_list(lis)] do
1090 sum := sum + lis[i];
1091 od;
1092 fi;
1093 return sum;
1094 end;
1095 _Sum_func_list:=
1096 function(fun,lis)
1097 local sum, i;
1098
1099 if _Size_list(lis)=0 then
1100 sum := 0;
1101 else
1102 sum := fun(lis[1]);
1103 for i in [2.._Size_list(lis)] do
1104 sum := sum + fun(lis[i]);
1105 od;
1106 fi;
1107 return sum;
1108 end;
1109 _Sum_list_func:=
1110 function(lis,fun)
1111 return _Sum_func_list(fun,lis);
1112 end;
1113 _Sum_func:=
1114 function(fun)
1115 return
1116 function(arg)
1117 if IsBound(arg[1]) then
1118 if IsString(arg[1]) then
1119 return _Sum_func_list(fun,arg);
1120 elif IsList(arg[1]) then
1121 return _Sum_func_list(fun,arg[1]);
1122 else
1123 return _Sum_func_list(fun,arg);
1124 fi;
1125 else
1126 return VOID;
1127 fi;
1128 end;
1129 end;
1130
1131
1132 #############################################################################
1133 ##
1134 #F Iterated( <list>, <func> ) . . . . . . . iterate a function over a list
1135 ##
1136 ### REVISE ME
1137 Iterated := function ( lis, fun )
1138 local res, i;
1139 if _Size_list(lis) = 0 then
1140 Error("Iterated: <list> must contain at least one element");
1141 fi;
1142 res := lis[1];
1143 for i in [ 2 .. _Size_list(lis) ] do
1144 res := fun( res, lis[i] );
1145 od;
1146 return res;
1147 end;
1148
1149
1150 #############################################################################
1151 ##
1152 #F Maximum( <obj>, <obj>... ) . . . . . . . . . . . . . maximum of integers
1153 ##
1154 ### REVISE ME
1155 Maximum := function ( arg )
1156 local max, elm;
1157 if _Size_list(arg) = 1 and IsList(arg[1]) then
1158 if _Size_list(arg[1]) = 0 then
1159 Error("Maximum: <list> must contain at least one element");
1160 fi;
1161 max := arg[1][_Size_list(arg[1])];
1162 for elm in arg[1] do
1163 if max < elm then
1164 max := elm;
1165 fi;
1166 od;
1167 elif _Size_list(arg) = 2 then
1168 if arg[1] > arg[2] then return arg[1];
1169 else return arg[2];
1170 fi;
1171 elif _Size_list(arg) > 2 then
1172 max := arg[_Size_list(arg)];
1173 for elm in arg do
1174 if max < elm then
1175 max := elm;
1176 fi;
1177 od;
1178 else
1179 Error("usage: Maximum( <obj>, <obj>... ) or Maximum( <list> )");
1180 fi;
1181 return max;
1182 end;
1183
1184
1185 #############################################################################
1186 ##
1187 #F Minimum( <obj>, <obj>... ) . . . . . . . . . . . . . minimum of integers
1188 ##
1189 ### REVISE ME
1190 Minimum := function ( arg )
1191 local min, elm;
1192 if _Size_list(arg) = 1 then
1193 if IsList(arg[1]) then
1194 if _Size_list(arg[1]) = 0 then
1195 Error("Minimum: <list> must contain at least one element");
1196 fi;
1197 min := arg[1][_Size_list(arg[1])];
1198 for elm in arg[1] do
1199 if min > elm then
1200 min := elm;
1201 fi;
1202 od;
1203 else # use KANT function Minimum
1204 return _Minimum(arg[1]);
1205 fi;
1206 elif _Size_list(arg) = 2 then
1207 if arg[1] < arg[2] then return arg[1];
1208 else return arg[2];
1209 fi;
1210 elif _Size_list(arg) > 2 then
1211 min := arg[_Size_list(arg)];
1212 for elm in arg do
1213 if min > elm then
1214 min := elm;
1215 fi;
1216 od;
1217 else
1218 Error("usage: Minimum( <nof(any)> ) or Minimum( <any> )");
1219 fi;
1220 return min;
1221 end;
1222
1223
1224 #############################################################################
1225 ##
1226 #F RandomList( <list> ) . . . . . . . . return a random element from a list
1227 ##
1228 #N 31-May-91 martin 'RandomList' should be internal
1229 ##
1230 R_N := 1; R_X := [];
1231
1232 RandomList := function ( list )
1233 R_N := R_N mod 55 + 1;
1234 R_X[R_N] := (R_X[R_N] + R_X[(R_N+30) mod 55+1]) mod 2^28;
1235 return list[ Div( R_X[R_N] * _Size_list(list), 2^28 ) + 1 ];
1236 end;
1237
1238 RandomSeed := function ( n )
1239 local i;
1240 R_N := 1; R_X := [ n ];
1241 for i in [2..55] do
1242 R_X[i] := (1664525 * R_X[i-1] + 1) mod 2^28;
1243 od;
1244 for i in [1..99] do
1245 R_N := R_N mod 55 + 1;
1246 R_X[R_N] := (R_X[R_N] + R_X[(R_N+30) mod 55+1]) mod 2^28;
1247 od;
1248 end;
1249
1250 if R_X = [] then RandomSeed( 1 ); fi;
1251
1252
1253 #############################################################################
1254 ##
1255 #F ListSplit( <list>, <elt-ord^rat> )
1256 ##
1257 ## Split the list <list> in parts of size <elt-ord^rat>
1258 ##
1259 ListSplit :=
1260 function ( L, n )
1261 local S, r;
1262 r := Truncate(Real( Length( L ) / n ));
1263 S := List( [ 0 .. r - 1 ], function ( i )
1264 return L{[ i * n + 1 .. (i + 1) * n ]};
1265 end );
1266 if Length( L ) > r * n then
1267 _Add__list_any( S, L{[ r * n + 1 .. Length( L ) ]} );
1268 fi;
1269 return S;
1270 end;
1271
1272