Changeset 96f136 in git

Timestamp:

Feb 8, 2011, 2:57:14 PM (13 years ago)

Author:

Frank Seelisch <seelisch@…>

Branches:

(u'spielwiese', '8e0ad00ce244dfd0756200662572aef8402f13d5')

Children:

771339b035d62cf81e4a3ef0a2b6c35ea5273147

Parents:

06fdbe869e26dea8a81df51c687bbbf427761929

Message:

new command factmodd (Hensel factors in K[[x]][y])

git-svn-id: file:///usr/local/Singular/svn/trunk@13830 2c84dea3-7e68-4137-9b89-c4e89433aadc

Location:

Singular

Files:

• iparith.cc (modified) (1 diff)
• table.h (modified) (2 diffs)
• tok.h (modified) (1 diff)

Singular/iparith.cc

@@ -7864 +7864 @@
 };
 #endif
-
+static BOOLEAN jjFactModD_M(leftv res, leftv v)
+{
+  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
+     see doc in /kernel/linearAlgebra.h
+     
+     valid argument lists:
+     - (poly h, int d),
+     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
+     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
+                                                          in list of ring vars,
+     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
+                                                optional: all 4 optional args
+     result:
+     - list with the two factors f and g such that
+       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
+  
+  poly h      = NULL;
+  int  d      =    1;
+  poly f0     = NULL;
+  poly g0     = NULL;
+  int  xIndex =    1;   /* default index if none provided */
+  int  yIndex =    2;   /* default index if none provided */
+  
+  leftv u = v; int factorsGiven = 0;
+  if ((u == NULL) || (u->Typ() != POLY_CMD))
+  {
+    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
+    return TRUE;
+  }
+  else h = (poly)u->Data();
+  u = u->next;
+  if ((u == NULL) || (u->Typ() != INT_CMD))
+  {
+    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
+    return TRUE;
+  }
+  else d = (int)(long)u->Data();
+  u = u->next;
+  if ((u != NULL) && (u->Typ() == POLY_CMD))
+  {
+    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
+    {
+      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
+      return TRUE;
+    }
+    else
+    {
+      f0 = (poly)u->Data();
+      g0 = (poly)u->next->Data();
+      factorsGiven = 1;
+      u = u->next->next;
+    }
+  }
+  if ((u != NULL) && (u->Typ() == INT_CMD))
+  {
+    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
+    {
+      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
+      return TRUE;
+    }
+    else
+    {
+      xIndex = (int)(long)u->Data();
+      yIndex = (int)(long)u->next->Data();
+      u = u->next->next;
+    }
+  }
+  if (u != NULL)
+  {
+    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
+    return TRUE;
+  }
+  
+  /* checks for provided arguments */
+  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
+  {
+    WerrorS("expected non-constant polynomial argument(s)");
+    return TRUE;
+  }
+  int n = rVar(currRing);
+  if ((xIndex < 1) || (n < xIndex))
+  {
+    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
+    return TRUE;
+  }
+  if ((yIndex < 1) || (n < yIndex))
+  {
+    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
+    return TRUE;
+  }
+  if (xIndex == yIndex)
+  {
+    WerrorS("expected distinct indices for variables x and y");
+    return TRUE;
+  }
+  
+  /* computation of f0 and g0 if missing */
+  if (factorsGiven == 0)
+  {
+#ifdef HAVE_FACTORY
+    poly h0 = pSubst(pCopy(h), xIndex, NULL);
+    intvec* v = NULL;
+    ideal i = singclap_factorize(h0, &v, 0);
+    if (i == NULL) return TRUE;
+    ivTest(i);
+    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
+    {
+      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
+      return TRUE;
+    }
+    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
+    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
+    idDelete(&i);
+#else
+    WerrorS("cannot factorize h(0,y) due to missing module 'factory'");
+    return TRUE;
+#endif
+  }
+  
+  poly f; poly g;
+  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
+  lists L = (lists)omAllocBin(slists_bin);
+  L->Init(2);
+  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
+  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
+  res->rtyp = LIST_CMD;
+  res->data = (char*)L;
+  return FALSE;
+}
 static BOOLEAN jjSTATUS_M(leftv res, leftv v)
 {

Singular/table.h

@@ -858 +858 @@
 ,{D(jjSTD_HILB_WP), STD_CMD,       IDEAL_CMD,           4      , NO_PLURAL |ALLOW_RING}
 ,{D(jjQRDS),      QRDS_CMD,        LIST_CMD,            4      , ALLOW_PLURAL |ALLOW_RING}
+,{D(jjFactModD_M),FMD_CMD,         LIST_CMD,           -2      , ALLOW_PLURAL |ALLOW_RING}
 #ifdef HAVE_FANS
 //,{D(jjADDADJ),    ADDADJ_CMD,      NONE,               -2      , NO_PLURAL |NO_RING}
@@ -937 +938 @@
   { "export",      0, EXPORT_CMD ,        EXPORT_CMD},
   { "exportto",    0, EXPORTTO_CMD ,      CMD_2},
+  { "factmodd",    0, FMD_CMD ,           CMD_M},
   { "factorize",   0, FAC_CMD ,           CMD_12},
   { "farey",       0, FAREY_CMD ,         CMD_2},

Singular/tok.h

@@ -84 +84 @@
   FIND_CMD,
   FACSTD_CMD,
+  FMD_CMD,
   FWALK_CMD,
   FGLM_CMD,