"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 ### qaos.k - Interfacing the QaoS database from KASH
2 ##
3 ## Copyright (C) 2005 by Sebastian Freundt, Sebastian Pauli
4 ## Authors: Sebastian Freundt <freundt@math.tu-berlin.de>
5 ## Sebastian Pauli <pauli@math.tu-berlin.de>
6 ## Created: 2005/03/01
7 ## Keywords:
8 ##
9 ## This program is free software; you can redistribute it and/or modify it
10 ## under a BSD-like licence.
11 ##
12 ## Redistribution and use in source and binary forms, with or without
13 ## modification, are permitted provided that the following conditions are met:
14 ## Redistributions of source code must retain the above copyright notice, this
15 ## list of conditions and the following disclaimer.
16 ## Redistributions in binary form must reproduce the above copyright notice,
17 ## this list of conditions and the following disclaimer in the documentation
18 ## and/or other materials provided with the distribution.
19 ## Neither the name of the Technical University of Berlin nor the names of its
20 ## contributors may be used to endorse or promote products derived from this
21 ## software without specific prior written permission.
22 ##
23 ## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
24 ## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
25 ## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
26 ## ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
27 ## LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
28 ## CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
29 ## SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
30 ## INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
31 ## CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
32 ## ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33 ## POSSIBILITY OF SUCH DAMAGE.
34 ##
35 ## Code:
36
37
38 ### global variables
39 _PackageName := "QaoS";
40 _PackageVersion := "1.0";
41 _PackageShortDescription := "Interfacing Algebraic Databases";
42 _PackageHint := "Type `?Qaos' for help.";
43
44
45 ## operations
46 _QaosOperations :=
47 function(arg)
48 local desc,recf,printf;
49
50 if Length(arg) < 1 or Length(arg) > 2 then
51 desc := "object";
52 recf := i->i.("base");
53 elif Length(arg) = 1 then
54 if IsFunc(arg[1]) then
55 printf := arg[1];
56 else
57 desc := arg[1];
58 recf := i->i.("base");
59 printf :=
60 function(r)
61 Print("<",desc," from database: ",recf(r), ">");
62 end;
63 fi;
64 elif Length(arg) = 2 then
65 desc := arg[1];
66 if IsFunc(arg[2]) then
67 recf := arg[2];
68 else
69 recf := i->i.(arg[2]);
70 fi;
71 printf :=
72 function(r)
73 Print("<",desc," from database: ",recf(r), ">");
74 end;
75 fi;
76 return rec(Print := printf);
77 end;
78
79
80 _QaosBase := "http://qaos.math.tu-berlin.de/qaos/";
81 _QaosBaseS := "https://qaos.math.tu-berlin.de/qaos/";
82
83 _QaosModules := Alist(["query","query.scm"]);
84 _QaosQueryActions := Alist(["query","Go"],["help","Help"],["count","Count"]);
85 _QaosQueryTypes :=
86 Alist(
87 ["anf",rec(
88 basefield := "generator",
89 description := "rational field extension",
90 ops := _QaosOperations(~[2].description))],
91 ["trnsg",rec(
92 basefield := "name",
93 description := "transitive group",
94 ops := _QaosOperations(~[2].description))],
95 ["finf",rec(
96 basefield := "generator",
97 description := "finite field extension",
98 ops := _QaosOperations(~[2].description))]);
99
100
101 ## auxiliary funs
102
103 UrlEncode:=
104 function(string)
105 local tmp, new, mpos, j, length, tmpstring, startpos, endpos;
106 tmp:=ShallowCopy(string);
107 mpos := StringMatchPositions("[^ 0-9A-Za-z]",tmp);
108
109 ## the trivial case
110 if Length(mpos) = 0 then
111 Replace_(tmp," ","+");
112 return tmp;
113 fi;
114
115 new := "";
116 for j in [1..Length(mpos)] do
117 ## copy the non-matching string
118 if j>1 then
119 startpos := mpos[j-1][2];
120 else
121 startpos := 1;
122 fi;
123 endpos := mpos[j][1];
124 length := endpos-startpos;
125 tmpstring := Substring(tmp, startpos, length);
126 new := new + tmpstring;
127
128 ## now copy and transform the matched string
129 startpos := mpos[j][1];
130 endpos := mpos[j][2];
131 length := endpos-startpos;
132 tmpstring := Substring(tmp, startpos, length);
133 new := new + "%" + Hex(tmpstring);
134 od;
135
136 ## copy unmatched data at the end
137 endpos:=mpos[Length(mpos)][2];
138 length:=Length(tmp)+1-endpos;
139 if length>0 then
140 new := new + Substring(tmp,endpos,length);
141 fi;
142
143 ## now wipe spaces
144 Replace_(new," ","+");
145 return new;
146 end;
147
148
149
150 InstallDocumentation(
151 rec(
152 kind := "KEYWORD",
153 name := "QaoS",
154 short := "",
155 see := [DocHash("QaosNumberField(string)"),
156 DocHash("QaosTransitiveGroup(string)")]),
157 rec(ForceAdd:=TRUE));
158
159
160
161 #############################################################################
162 ##
163 #F Qaos generic funs
164 ##
165 QaosGenericQueryResult:=
166 function(arg)
167 local query,optarg,limit,offset,uri,buf,pip,result,
168 type, action, basefield, ops, colgroups;
169
170 CheckArgs(arg,["query","offset","limit","optarg"],[,,,rec()]);
171 query := __ARGREC.("query");
172 limit := __ARGREC.("limit");
173 offset := __ARGREC.("offset");
174 optarg := __ARGREC.("optarg");
175 type := _GetEntry_rec_string(optarg,"Type",rec(Fail:="anf"));
176 action := _GetEntry_rec_string(optarg,"Action",rec(Fail:="query"));
177 colgroups := _GetEntry_rec_string(optarg,"ColGroups",
178 rec(Fail:=["cgall","size","struct"]));
179
180 uri:=
181 _QaosBase + Assoc(_QaosModules,"query") +
182 "?type="+type+
183 "&mode=keyword"+
184 "&query="+
185 UrlEncode(query)+
186 "&action="+Assoc(_QaosQueryActions, action)+
187 Mapconcat(i->"&"+i+"=on", colgroups, "")+
188 "&offset=" + SPrint(offset)+
189 "&limit=" + SPrint(limit)+
190 "&output=kash";
191
192 result:=Pipe("curl -k -s \""+uri+"\"","");
193 return result;
194 end;
195 QaosGenericQuery:=
196 function(arg)
197 local query,optarg,limit,offset, result,L,l,stime,
198 type, typeval, basefield, ops;
199
200 CheckArgs(arg,["query","offset","limit","optarg"],[,,,rec()]);
201 query := __ARGREC.("query");
202 limit := __ARGREC.("limit");
203 offset := __ARGREC.("offset");
204 optarg := __ARGREC.("optarg");
205
206 type := _GetEntry_rec_string(optarg,"Type",rec(Fail:="anf"));
207 typeval := Assoc(_QaosQueryTypes,type);
208 basefield := _GetEntry_rec_string(optarg,"BaseField",
209 rec(Fail:=typeval.basefield));
210 ops := _GetEntry_rec_string(optarg,"Operations",
211 rec(Fail:=typeval.ops));
212
213 optarg.("type") := type;
214
215 stime := UTime();
216 result := QaosGenericQueryResult(query,offset,limit,optarg);
217
218 L := EvalString(result);
219 if not IsRec(L) then
220 L := rec(base:=L);
221 fi;
222
223 if Type(L) = void then
224 result := ""; ## do nothing
225 elif not Type(L)=string and IsList(L) then
226 for l in L do
227 l.("base") := l.(basefield);
228 l.("operations") := ops;
229 l.("id") := type + "_id";
230 if IsBound(l.("field_alist")) then
231 l.("field_alist") := L.("field_alist");
232 fi;
233 od;
234 ops :=
235 _QaosOperations(
236 function(r)
237 if Length(r)<1 then
238 Print("<collection from database: no matches; "+
239 "\""+query+"\">");
240 elif Length(r)=1 then
241 Print("<collection from database: 1 "+typeval.description+"; "+
242 "\""+query+"\">");
243 else
244 Print("<collection from database: ",Length(r),
245 " "+typeval.description+"s"+"; "+
246 "\""+query+"\">");
247 fi;
248 end);
249 else
250 ops :=
251 _QaosOperations(
252 function(r)
253 if Base(r)<1 then
254 Print("no "+typeval.description+"s satisfy "+
255 "\""+query+"\"");
256 elif Base(r)=1 then
257 Print("1 "+typeval.description+" satisfies "+
258 "\""+query+"\"");
259 else
260 Print(Base(r)," "+typeval.description+"s satisfy "+
261 "\""+query+"\"");
262 fi;
263 end);
264 fi;
265
266 ## for timing purposes
267 Print("Time: ",UTime()-stime," s\n");
268
269 L.query := query;
270 L.optarg := optarg;
271 L.operations := ops;
272
273 return L;
274 end;
275
276
277
278 #############################################################################
279 ##
280 #F QaosNumberField(<string> [, optarg])
281 ##
282 if not IsBound(QaosNumberFieldDefaultLimit) then
283 QaosNumberFieldDefaultLimit := 25;
284 fi;
285 InstallDocumentation(
286 rec(
287 kind := "FUNCTION",
288 name := "QaosNumberField",
289 sin := [[string, "query"]],
290 opt := [[elt-ord^rat,"Limit",
291 "Determines how many fields may be retrieved maximally",
292 rec(Default:=QaosNumberFieldDefaultLimit)],
293 [elt-ord^rat,"Offset",
294 "Determines an offset of fields",
295 rec(Default:=0)],
296 [string,"Action",
297 "Determines which action to perform on the query string. "+
298 "Possible values are `query' and `count'.",
299 rec(Default:="query")],
300 [list,"ColGroups",
301 "Determines which information to return. "+
302 "This is a list of column group specifiers.",
303 rec(Default:=["cgall"])]],
304 sou := [[list, "L"]],
305 short :=
306 "Searches the Algebraic Objects Database in Berlin. "+
307 "The query string equals the keyword search method in the web surface.\n"+
308 "See `"+_QaosBase+Assoc(_QaosModules,"query")+
309 "?type=anf&action="+Assoc(_QaosQueryActions,"help")+"' "+
310 "for more information about the syntax and keywords.\n\n"+
311
312 "Note: You must have `curl' (see http://curl.haxx.se) installed and "+
313 "properly configured in order to use QaoS from within KASH."),
314 rec(ForceAdd:=TRUE));
315 QaosNumberField:=
316 function(arg)
317 local query,optarg,offset,limit,action,colgroups;
318
319 CheckArgs(arg,["query","optarg"],
320 [,rec(Limit:=QaosNumberFieldDefaultLimit)]);
321 query := __ARGREC.("query");
322 optarg := __ARGREC.("optarg");
323 limit := _GetEntry_rec_string(optarg,"Limit",
324 rec(Fail:=QaosNumberFieldDefaultLimit));
325 offset := _GetEntry_rec_string(optarg,"Offset", rec(Fail:=0));
326 action := _GetEntry_rec_string(optarg,"Action", rec(Fail:="query"));
327 colgroups := _GetEntry_rec_string(optarg,"ColGroups",
328 rec(Fail:=["cgall"]));
329
330 optarg.Type := "anf";
331 optarg.Action := action;
332 optarg.ColGroups := colgroups;
333
334 return QaosGenericQuery(query,offset,limit,optarg);
335 end;
336
337
338
339 #############################################################################
340 ##
341 #F QaosFunctionField(<string> [, optarg])
342 ##
343 QaosPolynomialAlgebra:=
344 function(baseobj,elmlist)
345 if not IsList(elmlist) then
346 return baseobj;
347 elif IsList(elmlist) and Length(elmlist)=0 then
348 return PolynomialAlgebra(QaosPolynomialAlgebra(baseobj,0));
349 else
350 return PolynomialAlgebra(QaosPolynomialAlgebra(baseobj,elmlist[1]));
351 fi;
352 end;
353 QaosPolynomial:=
354 function(baseobj,elmlist)
355 local reduced_elm, polyalg, len;
356 if not IsList(elmlist) then
357 return Element(baseobj,elmlist);
358 elif IsList(elmlist) and Length(elmlist)=0 then
359 return Element(baseobj,0);
360 else
361 polyalg := QaosPolynomialAlgebra(baseobj,elmlist);
362 len := Length(elmlist);
363 return
364 polyalg.1^len+Sum(Apply([1..len],
365 i->polyalg.1^(len-i)*QaosPolynomial(baseobj,elmlist[i])));
366 fi;
367 end;
368 if not IsBound(QaosFunctionFieldDefaultLimit) then
369 QaosFunctionFieldDefaultLimit := 25;
370 fi;
371 InstallDocumentation(
372 rec(
373 kind := "FUNCTION",
374 name := "QaosFunctionField",
375 sin := [[string, "query"]],
376 opt := [[elt-ord^rat,"Limit",
377 "Determines how many fields may be retrieved maximally",
378 rec(Default:=QaosNumberFieldDefaultLimit)],
379 [elt-ord^rat,"Offset",
380 "Determines an offset of fields",
381 rec(Default:=0)],
382 [string,"Action",
383 "Determines which action to perform on the query string. "+
384 "Possible values are `query' and `count'.",
385 rec(Default:="query")],
386 [list,"ColGroups",
387 "Determines which information to return. "+
388 "This is a list of column group specifiers.",
389 rec(Default:=["cgall"])]],
390 sou := [[list, "L"]],
391 short :=
392 "Searches the Algebraic Objects Database in Berlin. "+
393 "The query string equals the keyword search method in the web surface.\n"+
394 "See `"+_QaosBase+Assoc(_QaosModules,"query")+
395 "?type=anf&action="+Assoc(_QaosQueryActions,"help")+"' "+
396 "for more information about the syntax and keywords.\n\n"+
397
398 "Note: You must have `curl' (see http://curl.haxx.se) installed and "+
399 "properly configured in order to use QaoS from within KASH."),
400 rec(ForceAdd:=TRUE));
401 QaosFunctionField:=
402 function(arg)
403 local query,optarg,offset,limit,action,colgroups,
404 result, base_to_poly, find_prime_field, i;
405
406 CheckArgs(arg,["query","optarg"],
407 [,rec(Limit:=QaosFunctionFieldDefaultLimit)]);
408 query := __ARGREC.("query");
409 optarg := __ARGREC.("optarg");
410 limit := _GetEntry_rec_string(optarg,"Limit",
411 rec(Fail:=QaosFunctionFieldDefaultLimit));
412 offset := _GetEntry_rec_string(optarg,"Offset", rec(Fail:=0));
413 action := _GetEntry_rec_string(optarg,"Action", rec(Fail:="query"));
414 colgroups := _GetEntry_rec_string(optarg,"ColGroups",
415 rec(Fail:=["cgall"]));
416
417 optarg.Type := "finf";
418 optarg.Action := action;
419 optarg.ColGroups := colgroups;
420
421 result := QaosGenericQuery(query,offset,limit,optarg);
422
423 find_prime_field:=
424 function(dbobj)
425 local constf;
426 constf:=Last(dbobj.tree);
427 return FiniteField(constf[1]^constf[2]);
428 end;
429 base_to_poly:=
430 function(dbobj)
431 local constf;
432 constf:=find_prime_field(dbobj);
433 dbobj.base:=QaosPolynomial(constf,dbobj.generator);
434 dbobj.disc:=QaosPolynomial(constf,dbobj.disc);
435 return dbobj;
436 end;
437
438 # ## now re-assign the correct base
439 # if action="query" then
440 # for i in result do
441 # i.base := i.tree.base;
442 # od;
443 # fi;
444
445 return result;
446 end;
447
448
449
450 #############################################################################
451 ##
452 #F QaosTransitiveGroup(<string> [, optarg])
453 ##
454 if not IsBound(QaosTransitiveGroupDefaultLimit) then
455 QaosTransitiveGroupDefaultLimit := 25;
456 fi;
457 InstallDocumentation(
458 rec(
459 kind := "FUNCTION",
460 name := "QaosTransitiveGroup",
461 sin := [[string, "query"]],
462 opt := [[elt-ord^rat,"Limit",
463 "Determines how many groups may be retrieved maximally",
464 rec(Default:=QaosTransitiveGroupDefaultLimit)],
465 [elt-ord^rat,"Offset",
466 "Determines an offset of groups",
467 rec(Default:=0)],
468 [string,"Action",
469 "Determines which action to perform on the query string. "+
470 "Possible values are `query' and `count'.",
471 rec(Default:="query")],
472 [list,"ColGroups",
473 "Determines which information to return. "+
474 "This is a list of column group specifiers.",
475 rec(Default:=["cgall"])]],
476 sou := [[list, "L"]],
477 short :=
478 "Searches the Algebraic Objects Database in Berlin. "+
479 "The query string equals the keyword search method in the web surface.\n"+
480 "See `"+_QaosBase+Assoc(_QaosModules,"query")+
481 "?type=trnsg&action="+Assoc(_QaosQueryActions,"help")+"' "+
482 "for more information about the syntax and keywords.\n\n"+
483
484 "Note: You must have `curl' (see http://curl.haxx.se) installed and "+
485 "properly configured in order to use QaoS from within KASH."),
486 rec(ForceAdd:=TRUE));
487 QaosTransitiveGroup:=
488 function(arg)
489 local query,optarg,offset,limit,action,colgroups;
490
491 CheckArgs(arg,["query","optarg"],
492 [,rec(Limit:=QaosTransitiveGroupDefaultLimit)]);
493 query := __ARGREC.("query");
494 optarg := __ARGREC.("optarg");
495 offset := _GetEntry_rec_string(optarg,"Offset", rec(Fail:=0));
496 limit := _GetEntry_rec_string(optarg,"Limit",
497 rec(Fail:=QaosTransitiveGroupDefaultLimit));
498 action := _GetEntry_rec_string(optarg,"Action", rec(Fail:="query"));
499 colgroups := _GetEntry_rec_string(optarg,"ColGroups",
500 rec(Fail:=["cgall"]));
501
502 optarg.Type := "trnsg";
503 optarg.Action := action;
504 optarg.ColGroups := colgroups;
505
506 return QaosGenericQuery(query,offset,limit,optarg);
507 end;
508
509
510
511
512 #############################################################################
513 ##
514 #F Accessor Funs
515 ##
516 InstallDocumentation(
517 rec(
518 kind := "FUNCTION",
519 name := "QaosResult",
520 sin := [[list, "collection"]],
521 sou := [[list, "L"]],
522 short :=
523 "Return the actual list of objects in `collection'."),
524 rec(ForceAdd:=TRUE));
525 QaosResult:=
526 function(coll)
527 return coll.base;
528 end;
529
530 if not IsBound(_Qaos_PreviousClassNumber) then
531 _Qaos_PreviousClassNumber := ClassNumber;
532 fi;
533 ClassNumber := function( arg )
534 if Length(arg) = 1 then
535 if IsRec(arg[1]) then
536 if IsBound(arg[1].class_num) then
537 return arg[1].class_num;
538 fi;
539 fi;
540 return _Qaos_PreviousClassNumber(arg[1]);
541 elif Length(arg) = 2 then
542 return _Qaos_PreviousClassNumber(arg[1],arg[2]);
543 else
544 Error("ClassNumber: wrong number of arguments");
545 fi;
546 end;
547
548 if not IsBound(_Qaos_PreviousClassGroup) then
549 _Qaos_PreviousClassGroup := ClassGroup;
550 fi;
551 ClassGroup := function( arg )
552 if Length(arg) = 1 then
553 if IsRec(arg[1]) then
554 if IsBound(arg[1].class_group) then
555 return AbelianGroup(arg[1].class_group);
556 fi;
557 fi;
558 return _Qaos_PreviousClassGroup(arg[1]);
559 elif Length(arg) = 2 then
560 return _Qaos_PreviousClassGroup(arg[1],arg[2]);
561 else
562 Error("ClassGroup: wrong number of arguments");
563 fi;
564 end;
565
566
567 if not IsBound(_Qaos_PreviousUnitGroup) then
568 _Qaos_PreviousUnitGroup := UnitGroup;
569 fi;
570 UnitGroup := function( arg )
571 local ug,fug;
572 if Length(arg) = 1 then
573 if IsRec(arg[1]) then
574 if IsBound(arg[1].unit_group) then
575 ug := arg[1].unit_group;
576 fug := FreeAbelianGroup(ug[2]+1);
577 return Quotient(fug, fug.1*ug[1]);
578 fi;
579 fi;
580 return _Qaos_PreviousUnitGroup(arg[1]);
581 elif Length(arg) = 2 then
582 return _Qaos_PreviousUnitGroup(arg[1],arg[2]);
583 else
584 Error("UnitGroup: wrong number of arguments");
585 fi;
586 end;
587
588
589 if not IsBound(_Qaos_PreviousDiscrimininant) then
590 _Qaos_PreviousDiscrimininant := Discriminant;
591 fi;
592 Discriminant := function( arg )
593 if Length(arg) = 1 then
594 if IsRec(arg[1]) then
595 if IsBound(arg[1].disc) then
596 return arg[1].disc;
597 fi;
598 fi;
599 return _Qaos_PreviousDiscrimininant(arg[1]);
600 elif Length(arg) = 2 then
601 return _Qaos_PreviousDiscrimininant(arg[1],arg[2]);
602 else
603 Error("Discriminant: wrong number of arguments");
604 fi;
605 end;
606
607
608 if not IsBound(_Qaos_PreviousGalois) then
609 _Qaos_PreviousGalois := Galois;
610 fi;
611 Galois := function( arg )
612 local g;
613 if Length(arg) = 1 then
614 if IsRec(arg[1]) then
615 if IsBound(arg[1].galois_group) then
616 if arg[1].galois_group <> FAILURE then
617 return arg[1].galois_group;
618 else
619 # if galgrp is not set, compute it
620 g := _Qaos_PreviousGalois(arg[1]);
621 arg[1].galois_group := g.base;
622 return g;
623 fi;
624 fi;
625 fi;
626 return _Qaos_PreviousGalois(arg[1]);
627 elif Length(arg) = 2 then
628 return _Qaos_PreviousGalois(arg[1],arg[2]);
629 else
630 Error("Galois: wrong number of arguments");
631 fi;
632 end;
633
634
635 if not IsBound(_Qaos_PreviousRegulator) then
636 _Qaos_PreviousRegulator := Regulator;
637 fi;
638 Regulator := function( arg )
639 if Length(arg) = 1 then
640 if IsRec(arg[1]) then
641 if IsBound(arg[1].reg) then
642 return arg[1].reg;
643 fi;
644 else
645 return _Qaos_PreviousRegulator(arg[1]);
646 fi;
647 elif Length(arg) = 2 then
648 return _Qaos_PreviousRegulator(arg[1],arg[2]);
649 else
650 Error("Regulator: wrong number of arguments");
651 fi;
652 end;
653
654 if not IsBound(_Qaos_PreviousSignature) then
655 _Qaos_PreviousSignature := Signature;
656 fi;
657 Signature := function( arg )
658 if Length(arg) = 1 then
659 if IsRec(arg[1]) then
660 if IsBound(arg[1].sig_re) and IsBound(arg[1].sig_im) then
661 return [arg[1].sig_re, arg[1].sig_im];
662 fi;
663 else
664 return _Qaos_PreviousSignature(arg[1]);
665 fi;
666 elif Length(arg) = 2 then
667 return _Qaos_PreviousSignature(arg[1],arg[2]);
668 else
669 Error("Signature: wrong number of arguments");
670 fi;
671 end;
672
673
674
675
676
677 #############################################################################
678 ##
679 #F Data Completer Funs
680 ##
681 QaosObjectNF :=
682 function(object)
683 if not IsBound(object.NF) then
684 if Degree(object)>1 then
685 object.NF := NumberField(object);
686 else
687 object.NF := FAILURE;
688 fi;
689 fi;
690 return object.NF;
691 end;
692
693 QaosObjectFF :=
694 function(object)
695 if not IsBound(object.FF) then
696 if Degree(object)>1 then
697 object.FF := FunctionField(object);
698 else
699 object.FF := FAILURE;
700 fi;
701 fi;
702 return object.FF;
703 end;
704
705 QaosObjectMO :=
706 function(object)
707 if not IsBound(object.MO) then
708 if Type(object)=elt-alg^pol then
709 object.MO := MaximalOrder(object);
710 elif Type(object)=elt-alg^pol/fld^fin then
711 if Degree(object)>1 then
712 object.MO := MaximalOrderFinite(QaosObjectFF(object));
713 else
714 object.MO := FAILURE;
715 fi;
716 fi;
717 fi;
718 return object.MO;
719 end;
720
721 QaosObjectCG :=
722 function(object)
723 if not IsBound(object.CG) then
724 if Degree(object)>1 then
725 object.CG := ClassGroup(QaosObjectMO(object));
726 else
727 object.CG := FAILURE;
728 fi;
729 fi;
730 return object.CG;
731 end;
732
733 QaosObjectIU :=
734 function(object)
735 if not IsBound(object.IU) then
736 object.IU := IndependentUnits(QaosObjectMO(object));
737 fi;
738 return object.IU;
739 end;
740
741 QaosCompute\:num_ind_fund_un:=
742 function(object)
743 if not IsBound(object.UG) then
744 object.UG := UnitGroup(QaosObjectNF(object));
745 fi;
746 return TorsionFreeRank(object.UG);
747 end;
748 QaosCompute\:num_ind_fund_un:=
749 function(object)
750 return TorsionFreeRank(QaosObjectIU(object));
751 end;
752 QaosCompute\:num_roots_un:=
753 function(object)
754 if not IsBound(object.UG) then
755 object.UG := UnitGroup(QaosObjectNF(object));
756 fi;
757 return Order(TorsionSubgroup(object.UG));
758 end;
759 QaosCompute\:num_roots_un:=
760 function(object)
761 return Order(TorsionSubgroup(QaosObjectIU(object)));
762 end;
763 QaosCompute\:unit_group:=
764 function(object)
765 return [QaosCompute\:num_roots_un(object),
766 QaosCompute\:num_ind_fund_un(object)];
767 end;
768
769 QaosCompute\:galois_group_id:=
770 function(object)
771 if not IsBound(object.GG) then
772 object.GG := _Qaos_PreviousGalois(object);
773 fi;
774 return "get_group_id_by_tn("+SPrint(object.GG.("ext1"))+","+
775 SPrint(object.GG.("ext2"))+")";
776 end;
777 QaosCompute\:galois_group:=
778 function(object)
779 if not IsBound(object.GG) then
780 object.GG := _Qaos_PreviousGalois(object);
781 fi;
782 ## This string is stored elsewhere, no need to recompute it
783 return FAILURE; ## Base(object.GG);
784 end;
785 QaosCompute\:gal_grp_ord:=
786 function(object)
787 if not IsBound(object.GG) then
788 object.GG := _Qaos_PreviousGalois(object);
789 fi;
790 ## object.GG is a string actually, not a group
791 return FAILURE; ##Order(object.GG);
792 end;
793
794 QaosCompute\:class_num :=
795 function(object)
796 if Degree(object)>1 then
797 return Order(QaosObjectCG(object));
798 else
799 return FAILURE;
800 fi;
801 end;
802 QaosCompute\:class_group :=
803 function(object)
804 if Degree(object)>1 then
805 return AbelianInvariants(QaosObjectCG(object));
806 else
807 return FAILURE;
808 fi;
809 end;
810
811 QaosCompute\:disc_f :=
812 function(object)
813 if IsZero(object.disc) then
814 return FAILURE;
815 else
816 return Factorisation(object.disc);
817 fi;
818 end;
819
820
821 QaosComputeMissingDataAlist:=
822 Alist(
823 ["galois_group_id",QaosCompute\:galois_group_id],
824 ##["galois_group",QaosCompute\:galois_group],
825 ##["gal_grp_ord",QaosCompute\:gal_grp_ord],
826 ["class_num",QaosCompute\:class_num],
827 ["class_group",QaosCompute\:class_group],
828 ["num_ind_fund_un",QaosCompute\:num_ind_fund_un],
829 ["num_roots_un",QaosCompute\:num_roots_un],
830 ["disc_f",QaosCompute\:disc_f]);
831
832 QaosComputeMissingData:=
833 function(object,recfield)
834 local cfun;
835 cfun := Assoc(QaosComputeMissingDataAlist,recfield);
836 if IsFunc(cfun) then
837 object.(recfield) := cfun(object);
838 fi;
839 return object.(recfield);
840 end;
841
842 QaosMissingData:=
843 function(object)
844 if IsRec(object) then
845 return Filtered(i->object.(i)=FAILURE,RecFields(object));
846 else
847 Error("Stupid, heh?");
848 fi;
849 end;
850
851
852
853 #############################################################################
854 ##
855 #F SQL-Retransformer Funs
856 ##
857 QaosConvertSQL\:class_group :=
858 function(object)
859 return "ARRAY["+Mapconcat(i->SPrint(i), List(object.("class_group")), ",")+"]";
860 end;
861 QaosConvertSQL\:disc_f :=
862 function(object)
863 local poly_to_sql, factor_to_sql, over_finf, trans_deg;
864 over_finf := Last(object.tree[2]);
865 trans_deg := object.tree[1][4]-1;
866 poly_to_sql :=
867 function(p)
868 p := Butfirst(Reverse(ElementToSequence(p)));
869 return "finfs_element_vector_to_finf_elms_id"+
870 "(" + SPrint(over_finf) + "," + SPrint(trans_deg) + "," +
871 "ARRAY["+Mapconcat(i->SPrint(i), List(p), ",")+"])";
872 end;
873 factor_to_sql :=
874 function(f)
875 return "ARRAY["+poly_to_sql(f[1])+","+SPrint(f[2])+"]";
876 end;
877 return "ARRAY[" + Mapconcat(i->factor_to_sql(i), List(object.disc_f), ",") + "]";
878 end;
879
880 QaosConvertSQLAlist:=
881 Alist(
882 ["class_group", QaosConvertSQL\:class_group],
883 ["disc_f", QaosConvertSQL\:disc_f]);
884 QaosObjectRecfield\-\>SQL :=
885 function(object, recfield)
886 local cfun;
887 cfun := Assoc(QaosConvertSQLAlist, recfield);
888 if cfun = FAILURE then
889 return SPrint(object.(recfield));
890 else
891 return cfun(object);
892 fi;
893 end;
894
895 _QaosMissingDatum\-\>SQL :=
896 function(object, recfield)
897 if not object.(recfield) = FAILURE then
898 return
899 Assoc(object.field_alist,recfield).column+
900 "="+QaosObjectRecfield\-\>SQL(object,recfield);
901 else
902 return "";
903 fi;
904 end;
905 _QaosSqlUpdateSkel :=
906 function(object,recfield)
907 return "UPDATE "+Assoc(object.field_alist,recfield).table+" SET";
908 end;
909 _QaosMissingData\-\>SQL :=
910 function(object, missing_list)
911 if Length(missing_list) > 0 then
912 return
913 _QaosSqlUpdateSkel(object,object.("id"))+" "+
914 Mapconcat(i->_QaosMissingDatum\-\>SQL(object,i), missing_list, ", ")+
915 " WHERE "+object.("id")+" = "+SPrint(object.(object.("id")))+";";
916 else
917 return VOID;
918 fi;
919 end;
920 QaosMissingData\-\>SQL :=
921 function(object)
922 local missing_before, missing_after, missing_diff;
923
924 missing_before := QaosMissingData(object);
925
926 ## now compute some of the missing things
927 Mapc(i->QaosComputeMissingData(object,i),missing_before);
928
929 missing_after := QaosMissingData(object);
930 missing_diff := DryDifference(missing_before,missing_after);
931
932 return _QaosMissingData\-\>SQL(object, missing_diff);
933 end;
934
935 QaosCollection\-\>SQL:=
936 function(object_collection)
937 local QMD;
938 QMD:=
939 function(obj)
940 local val;
941 val := QaosMissingData\-\>SQL(obj);
942 if val = VOID then
943 return "";
944 else
945 return val;
946 fi;
947 end;
948 return Mapconcat(i->QMD(i),object_collection,"\n");
949 end;
950
951
952 QaosLPolyToSQLbottommost :=
953 function(p,over_finf,trans_deg)
954 local arr;
955 arr := Mapconcat(i->SPrint(i), List(p), ",");
956 if Length(arr)=0 then
957 return "finfs_element_vector_to_finf_elms_id"+
958 "(" + SPrint(over_finf) + "," + SPrint(trans_deg) + "," +
959 "'{}'::bigint[])";
960 else
961 return "finfs_element_vector_to_finf_elms_id"+
962 "(" + SPrint(over_finf) + "," + SPrint(trans_deg) + "," +
963 "ARRAY["+arr+"])";
964 fi;
965 end;
966 HasSublists :=
967 function(l)
968 if IsList(l) then
969 return ForAny(i->IsList(i),l);
970 else
971 return false;
972 fi;
973 end;
974 QaosLPolyToSQL :=
975 function(p,over_finf,trans_deg)
976 if HasSublists(p) then
977 return "ARRAY["+ Mapconcat(i->QaosLPolyToSQL(i,over_finf,trans_deg),
978 List(p), ",") +"]";
979 else
980 return QaosLPolyToSQLbottommost(p,over_finf,trans_deg);
981 fi;
982 end;
983 QaosFunctionFieldToSQL :=
984 function(obj)
985 local gpoly, gpoly_l, cfield, cfield\[x\], bang_to_palg, p_to_l;
986
987 cfield := ConstantField(obj);
988 cfield\[x\] := PolynomialAlgebra(cfield);
989
990 bang_to_palg := poly->Element(cfield\[x\], poly);
991 p_to_l :=
992 function(p)
993 local banged;
994 if p in cfield then
995 return p;
996 else
997 banged :=
998 Reversed(Apply(i->p_to_l(bang_to_palg(i)),
999 List(ElementToSequence(p))));
1000 return Butfirst(banged);
1001 fi;
1002 end;
1003
1004 gpoly := MinimalPolynomial(obj.1);
1005 gpoly_l := p_to_l(gpoly);
1006
1007 return "INSERT INTO finfs_elms (finf_id, finf_elm, transcendency_degree) "+
1008 "VALUES (5, "+QaosLPolyToSQL(gpoly_l,5,0)+", 1)";
1009 end;
1010
1011
1012 ############################################################################
1013 ##
1014 ## Identification functions
1015 ##
1016 IsInQaosFinfs :=
1017 function(object)
1018 ## for finite fields
1019 local char,charq, q,qq, deg,degq;
1020
1021 char := Base(Characteristic(object));
1022 charq := "c"+SPrint(char);
1023
1024 q := Base(Size(object));
1025 if q=char then
1026 qq := "p";
1027 else
1028 qq := "q"+SPrint(q);
1029 fi;
1030
1031 deg := Base(Degree(object));
1032 degq := "ad"+SPrint(deg);
1033
1034 return Mapconcat(i->i,["td0",degq,charq]," ");
1035 end;
1036
1037 IsInQaosFinfsTD1 :=
1038 function(object)
1039 ## for function fields
1040 local char,charq, q,qq, deg,degq, fmo,disc,discq;
1041
1042 char := Base(Characteristic(object));
1043 charq := "c"+SPrint(char);
1044
1045 q := Base(Size(ConstantField(object)));
1046 if q=char then
1047 qq := "p";
1048 else
1049 qq := "q"+SPrint(q);
1050 fi;
1051
1052 deg := Base(Degree(object));
1053 degq := "ad"+SPrint(deg);
1054
1055 fmo:=MaximalOrderFinite(object);
1056 disc := Base(Discriminant(fmo));
1057 discq := "disc"+SPrint(disc);
1058
1059 return Mapconcat(i->i,["td1",degq,charq,discq]," ");
1060 end;
1061
1062 IsInQaosRatfs :=
1063 function(object)
1064 ## for rational fields
1065 local deg,degq, sig_re,sig_req, disc,discq;
1066
1067 deg := Base(Degree(object));
1068 degq := "d"+SPrint(deg);
1069
1070 disc := Base(Discriminant(object));
1071 discq := "disc"+SPrint(disc);
1072
1073 sig_re := Base(Signature(object));
1074 sig_req := "sr"+SPrint(sig_re);
1075
1076 return Mapconcat(i->i,[degq, discq, sig_req]," ");
1077 end;
1078
1079 IsInQaos :=
1080 function(object)
1081 #"Test whether `object' is contained in QaoS. "+
1082 #"Therefore, generate a query out of object.";
1083 if Type(object) = fld^fin then
1084 return IsInQaosFinfs(object);
1085 elif (Type(object) = fld^rat) or (Type(object) = fld^num/fld^rat) then
1086 return IsInQaosRatfs(object);
1087 else
1088 Error("Object type not supported.");
1089 fi;
1090 return FALSE;
1091 end;
1092
1093
1094
1095 if (not IsBound(_QaosBannerShown) or not _QaosBannerShown) then
1096 _PackageBanner :=
1097 "\n## Loaded package " +_PackageName+" " +_PackageVersion+" " +
1098 "("+ _PackageShortDescription + ")\n" +
1099 "## by Sebastian Freundt (http://www.math.tu-berlin.de/~freundt/)\n"+
1100 "## Sebastian Pauli (http://www.math.tu-berlin.de/~pauli/)\n"+
1101 "## " +_PackageHint+ "\n";
1102 _QaosBannerShown:=TRUE;
1103 fi;
1104