"Fossies" - the Fresh Open Source Software Archive

Member "KASH3-lib-archindep-2008-07-31/lib/ideals.k" (3 Sep 2008, 3188 Bytes) of package /linux/misc/old/KASH3-lib-archindep-2008-07-31.tar.gz:


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 #converts ideal of imaginary quadratic order to quadratic form
    3    IdealToQuadraticForm:=function(I)
    4      local O,a,b,c,w,t,n,ba,L,D,d;
    5      O:=Order(I);
    6      D:=Discriminant(O);
    7      d:=Denominator(I);
    8      if d <> 1 then 
    9        return IdealToQuadraticForm(d*I);
   10      fi;
   11      n:=Norm(I);
   12      w:=O.2;
   13      ba:=Basis(I);
   14      a:=List(ba[1])[1];
   15      b:=List(ba[2])[1];
   16      c:=List(ba[2])[2];
   17      L:=[Coerce(Z,a/c), Coerce(Z,(-2*b/c-Trace(w))),Norm(b+c*w)/(a*c)];
   18      Assert(L[2]^2-4*L[1]*L[3]=D, " quadratic form has discriminant of order");
   19      return rec(base:=L,ext1:=O);
   20    end;
   21 
   22 #converts quadratic form to ideal of imaginary quadratic order
   23    QuadraticFormToIdeal:=function(L)
   24      local O,w,a,b,I,b2;
   25      O:=L.ext1;
   26      w:=O.2;
   27      L:=Base(L);
   28      a:=L[1];
   29      b:=L[2];
   30      b2:=Coerce(Integers(),(-b-Trace(w))/2) mod a;
   31      I:=a*O+(b2+w)*O;
   32      return I;
   33   end;
   34 
   35 #returns ideal J such that I*J = [1]
   36    IdInvert:=function(I)
   37      local L,a,b,O,w;
   38      O:=Order(I);
   39      if IsPrincipal(I) then
   40        return 1*O;
   41      fi; 
   42      L:=Base(IdealToQuadraticForm(I));
   43      w:=O.2;
   44      if not GCD(L) = 1 then
   45        return Error(I," is not invertible");
   46      fi;
   47      a:=L[1];
   48      b:=L[2];
   49      return 1*O+((b-Trace(w)+2*w)/(2*a))*O;
   50    end;
   51 
   52 
   53 #debugging function
   54    Assert:= function(b,s)
   55      if b then return;
   56      else return Error("Assumption: ",s,"failed!");
   57      fi;
   58    end;
   59 
   60 
   61 
   62 #subfunction for IdealToQuadraticForm
   63    _step3:= function(a,b,c)
   64      local tmp,_step2;
   65      _step2:= function(a,b,c)
   66        local q,r,k;
   67        k:= 2*a;
   68        q:= Div(b,k);
   69        r:= b mod k;
   70        if r>a then
   71          r:= r-k;
   72          q:= q+1;
   73        fi;
   74        c:= c-Coerce(Integers(),1/2*(b+r)*q);
   75        b:=r;
   76        return _step3(a,b,c);
   77      end;
   78      if a>c then
   79        b:= -b;
   80        tmp:=a;
   81        a:=c;
   82        c:= tmp;
   83        return _step2(a,b,c);
   84      elif a=c and b<0 then
   85        b:=-b;
   86        return [a,b,c];
   87      else return [a,b,c];
   88      fi; 
   89    end;
   90 
   91 
   92 #tests if a quadratic form is reduced
   93    RedTest:= function(L)
   94      local a,b,c;
   95      a:= L[1];
   96      b:= L[2];
   97      c:= L[3];
   98      if (Abs(b)<= a) and (a<=c) then
   99         if (Abs(b) = a) or (a=c) then
  100            if b>0 then 
  101               return true;
  102            else return false;
  103            fi;
  104         else return true;
  105         fi;
  106      else return false;
  107      fi;
  108    end;
  109 
  110 #Reduction of a quadratic form
  111    QuadReduction:= function(R)
  112      local O,L,a,b,c,I2,ba,phi,s,_step2;
  113      _step2:= function(a,b,c)
  114         local q,r,k;
  115         k:= 2*a;
  116         q:= Div(b,k);
  117         r:= b mod k;
  118         if r>a then
  119            r:= r-k;
  120            q:= q+1;
  121         fi;
  122         c:= c-Coerce(Integers(),1/2*(b+r)*q);
  123         b:=r;
  124         return _step3(a,b,c);
  125      end;
  126      O:=R.ext1;
  127      L:=Base(R);
  128      a:= Coerce(Integers(), L[1]);
  129      b:= Coerce(Integers(),L[2]);
  130      c:= Coerce(Integers(),L[3]);
  131      if (-a<b and b<=a) then
  132          L:= _step3(a,b,c);
  133      else L:= _step2(a,b,c);
  134      fi;
  135      return rec(base:=L,ext1:=O);
  136    end;
  137 
  138 #Reduction of an ideal
  139    IdReduction:=function(I)
  140      local L;
  141      L:=IdealToQuadraticForm(I);
  142      L:=QuadReduction(L);
  143      return QuadraticFormToIdeal(L);
  144    end;
  145 
  146 
  147 
  148 
  149 
  150 
  151