Exemple #1
0
/****************************************************************************
 * FIND_RATIONALFUNCTION solves the Hurwitz problem
 ****************************************************************************/
static Obj FIND_RATIONALFUNCTION (Obj self, Obj gap_degrees, Obj gap_values, Obj gap_c, Obj gap_num, Obj gap_den, Obj params)
{
  size_t degree = 2, s;

  s = LEN_PLIST(gap_degrees);

  if (s != LEN_PLIST(gap_values)+3 || s != LEN_PLIST(gap_c)+3)
    return Fail;

  size_t d[s], i;
  gsl_complex c[s-3], v[s];

  for (i = 0; i < s; i++) {
    d[i] = INT_INTOBJ(ELM_PLIST(gap_degrees,i+1));
    degree += d[i]-1;
    if (i < s-3) {
      v[i] = VAL_GSL_COMPLEX(ELM_PLIST(gap_values,i+1));
      c[i] = VAL_GSL_COMPLEX(ELM_PLIST(gap_c,i+1));
    } else if (i == s-3)
      GSL_SET_COMPLEX(v+i, 1.0, 0.0);
    else if (i == s-2)
      GSL_SET_COMPLEX(v+i, 0.0, 0.0);
    else if (i == s-1)
      GSL_SET_COMPLEX(v+i, HUGE_VAL, HUGE_VAL);
  }
  degree /= 2;

  gsl_complex num_data[degree+1], den_data[degree+1];
  polynomial num = { LEN_PLIST(gap_num)-1, num_data },
    den = { LEN_PLIST(gap_den)-1, den_data };
    
  for (i = 0; i <= num.degree; i++)
    num.data[i] = VAL_GSL_COMPLEX(ELM_PLIST(gap_num,i+1));
  for (i = 0; i <= den.degree; i++)
    den.data[i] = VAL_GSL_COMPLEX(ELM_PLIST(gap_den,i+1));
    
  int status = solve_hurwitz (degree, s, d, v, c, &num, &den,
    INT_INTOBJ(ELM_PLIST(params,1)), VAL_FLOAT(ELM_PLIST(params,2)), VAL_FLOAT(ELM_PLIST(params,3)));

  if (status != GSL_SUCCESS)
    return INTOBJ_INT(status);

  for (i = 0; i < s-3; i++)
    set_elm_plist(gap_c,i+1, NEW_COMPLEX_GSL(c+i));

  GROW_PLIST(gap_num, num.degree+1);
  SET_LEN_PLIST(gap_num, num.degree+1);
  for (i = 0; i <= num.degree; i++)
    set_elm_plist(gap_num,i+1, NEW_COMPLEX_GSL(num.data+i));

  GROW_PLIST(gap_den, den.degree+1);
  SET_LEN_PLIST(gap_den, den.degree+1);
  for (i = 0; i <= den.degree; i++)
    set_elm_plist(gap_den,i+1, NEW_COMPLEX_GSL(den.data+i));

  return INTOBJ_INT(status);
}
Exemple #2
0
static inline void PushObj(Obj obj) {
  Obj stack = TLS(SerializationStack);
  UInt len = LEN_PLIST(stack);
  len++;
  GROW_PLIST(stack, len);
  SET_LEN_PLIST(stack, len);
  SET_ELM_PLIST(stack, len, obj);
}
Exemple #3
0
/****************************************************************************
**


*F  FuncADD_SET( <self>, <set>, <obj> ) . . . . . . . add an element to a set
**
**  'FuncADD_SET' implements the internal function 'AddSet'.
**
**  'AddSet( <set>, <obj> )'
**
**  'AddSet' adds <obj>, which may be an object  of an arbitrary type, to the
**  set <set>, which must be a proper set.  If <obj> is already an element of
**  the set <set>, then <set> is not changed.  Otherwise <obj> is inserted at
**  the correct position such that <set> is again a set afterwards.
**
**  'AddSet' does not return  anything, it is only  called for the side effect
**  of changing <set>.
*/
Obj FuncADD_SET (
		 Obj                 self,
		 Obj                 set,
		 Obj                 obj )
{
  UInt                len;            /* logical length of the list      */
  UInt                pos;            /* position                        */
  UInt                isCyc;          /* True if the set being added to consists
					 of kernel cyclotomics           */
  UInt                notpos;         /* position of an original element
					 (not the new one)               */
  UInt                wasHom;
  UInt                wasNHom;
  UInt                wasTab;
    
  /* check the arguments                                                 */
  while ( ! IsSet(set) || ! IS_MUTABLE_OBJ(set) ) {
    set = ErrorReturnObj(
			 "AddSet: <set> must be a mutable proper set (not a %s)",
			 (Int)TNAM_OBJ(set), 0L,
			 "you can replace <set> via 'return <set>;'" );
  }
  len = LEN_LIST(set);

  /* perform the binary search to find the position                      */
  pos = PositionSortedDensePlist( set, obj );

  /* add the element to the set if it is not already there               */
  if ( len < pos || ! EQ( ELM_PLIST(set,pos), obj ) ) {
    GROW_PLIST( set, len+1 );
    SET_LEN_PLIST( set, len+1 );
    {
      Obj *ptr;
      ptr = PTR_BAG(set);
      memmove((void *)(ptr + pos+1),(void*)(ptr+pos),(size_t)(sizeof(Obj)*(len+1-pos)));
#if 0
      for ( i = len+1; pos < i; i-- ) {
	*ptr = *(ptr-1);
	ptr--;   */
	/* SET_ELM_PLIST( set, i, ELM_PLIST(set,i-1) ); */
      }
#endif
    }
    SET_ELM_PLIST( set, pos, obj );
    CHANGED_BAG( set );

    /* fix up the type of the result                                   */
    if ( HAS_FILT_LIST( set, FN_IS_SSORT ) ) {
      isCyc = (TNUM_OBJ(set) == T_PLIST_CYC_SSORT);
      wasHom = HAS_FILT_LIST(set, FN_IS_HOMOG);
      wasTab = HAS_FILT_LIST(set, FN_IS_TABLE);
      wasNHom = HAS_FILT_LIST(set, FN_IS_NHOMOG);
      CLEAR_FILTS_LIST(set);
      /* the result of addset is always dense */
      SET_FILT_LIST( set, FN_IS_DENSE );

				/* if the object we added was not
                                   mutable then we might be able to
                                   conclude more */
      if ( ! IS_MUTABLE_OBJ(obj) ) {
				/* a one element list is automatically
                                   homogenous  and ssorted */
	if (len == 0 )
	  {
	    if (TNUM_OBJ(obj) <= T_CYC)
	      RetypeBag( set, T_PLIST_CYC_SSORT);
	    else
	      {
		SET_FILT_LIST( set, FN_IS_HOMOG );
		SET_FILT_LIST( set, FN_IS_SSORT );
		if (IS_HOMOG_LIST(obj))	/* it might be a table */
		  SET_FILT_LIST( set, FN_IS_TABLE );
	      }
	  }
	else
	  {
	    /* Now determine homogeneity */
	    if (isCyc)
	      if (TNUM_OBJ(obj) <= T_CYC)
		RetypeBag( set, T_PLIST_CYC_SSORT);
	      else
		{
		  RESET_FILT_LIST(set, FN_IS_HOMOG);
		  SET_FILT_LIST(set, FN_IS_NHOMOG);
		}
	    else if (wasHom)
	      {
		if (!SyInitializing) {
		  notpos = (pos == 1) ? 2 : 1;
		  if (FAMILY_OBJ(ELM_PLIST(set,notpos)) == FAMILY_OBJ(obj))
		    {
		      SET_FILT_LIST(set, FN_IS_HOMOG);
		      if (wasTab) {
			if (IS_HOMOG_LIST( obj ))
			  SET_FILT_LIST(set, FN_IS_TABLE);
		      }
		    }

		  else
		    SET_FILT_LIST(set, FN_IS_NHOMOG);
		}
	      }
	    else if (wasNHom)
	      SET_FILT_LIST(set, FN_IS_NHOMOG);
	  }
      }
      SET_FILT_LIST( set, FN_IS_SSORT );
    }
    else {
      CLEAR_FILTS_LIST(set);
      SET_FILT_LIST( set, FN_IS_DENSE );
    }
  }
Exemple #4
0
UInt            RNamName (
    const Char *        name )
{
    Obj                 rnam;           /* record name (as imm intobj)     */
    UInt                pos;            /* hash position                   */
    UInt                len;            /* length of name                  */
    Char                namx [1024];    /* temporary copy of <name>        */
    Obj                 string;         /* temporary string object <name>  */
    Obj                 table;          /* temporary copy of <HashRNam>    */
    Obj                 rnam2;          /* one element of <table>          */
    const Char *        p;              /* loop variable                   */
    UInt                i;              /* loop variable                   */

    /* start looking in the table at the following hash position           */
    pos = 0;
    len = 0;
    for ( p = name; *p != '\0'; p++ ) {
        pos = 65599 * pos + *p;
        len++;
    }
    pos = (pos % SizeRNam) + 1;

    if(len >= 1023) {
        // Note: We can't pass 'name' here, as it might get moved by garbage collection
        ErrorQuit("Record names must consist of less than 1023 characters", 0, 0);
    }
    /* look through the table until we find a free slot or the global      */
    while ( (rnam = ELM_PLIST( HashRNam, pos )) != 0
         && strncmp( NAME_RNAM( INT_INTOBJ(rnam) ), name, 1023 ) ) {
        pos = (pos % SizeRNam) + 1;
    }

    /* if we did not find the global variable, make a new one and enter it */
    /* (copy the name first, to avoid a stale pointer in case of a GC)     */
    if ( rnam == 0 ) {
        CountRNam++;
        rnam = INTOBJ_INT(CountRNam);
        SET_ELM_PLIST( HashRNam, pos, rnam );
        strlcpy( namx, name, sizeof(namx) );
        C_NEW_STRING_DYN(string, namx);
        GROW_PLIST(    NamesRNam,   CountRNam );
        SET_LEN_PLIST( NamesRNam,   CountRNam );
        SET_ELM_PLIST( NamesRNam,   CountRNam, string );
        CHANGED_BAG(   NamesRNam );
    }

    /* if the table is too crowed, make a larger one, rehash the names     */
    if ( SizeRNam < 3 * CountRNam / 2 ) {
        table = HashRNam;
        SizeRNam = 2 * SizeRNam + 1;
        HashRNam = NEW_PLIST( T_PLIST, SizeRNam );
        SET_LEN_PLIST( HashRNam, SizeRNam );
        for ( i = 1; i <= (SizeRNam-1)/2; i++ ) {
            rnam2 = ELM_PLIST( table, i );
            if ( rnam2 == 0 )  continue;
            pos = 0;
            for ( p = NAME_RNAM( INT_INTOBJ(rnam2) ); *p != '\0'; p++ ) {
                pos = 65599 * pos + *p;
            }
            pos = (pos % SizeRNam) + 1;
            while ( ELM_PLIST( HashRNam, pos ) != 0 ) {
                pos = (pos % SizeRNam) + 1;
            }
            SET_ELM_PLIST( HashRNam, pos, rnam2 );
        }
    }

    /* return the record name                                              */
    return INT_INTOBJ(rnam);
}