/****************************************************************************
* 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);
}
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);
}
/****************************************************************************
**
*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 );
}
}
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);
}