pelprgen.cc

Gambit 是一个游戏库理论软件

#ifdef LOG_PRINT 
  fprintf(stdout // was Pel_Out 
,"time used %d,\n",read_mark(time0))
#endif
;
*/  
 free_Gen_list(g);
   psys_free(P);
   return Xpl_to_Gen(Sl);
 }

/*
** Solve Command             (tested)
*/
Gen_node G_Solve(Gen_node g, int tweak){
   psys P;
   node Sl=0,Nl=0;
   /*   char *tmp; UNUSED */
   LOCS(2);
   PUSH_LOC(Sl);
   PUSH_LOC(Nl);
   if ( Gen_length(g)!=2||
        Can_Be_Vector(Gen_elt(g,1),Ply_T)<=0||
        Can_Be_List(Gen_elt(g,2))!=TRUE)
        return Rerror("Usage: Solve(PSys,{<Int>})",g);
   
   P=Gen_to_psys(Gen_elt(g,1));
   Nl=Gen_to_Ivector_list(Gen_lval(Gen_elt(g,2)));
   time0=set_mark();
   while (Nl!=0){
     Sl=list_cat(psys_solve(P,(Imatrix)Car(Car(Nl)),tweak),Sl);
     Nl=Cdr(Nl);
   }
   /*   Pel_New_Log(strcat(FilePrefix,".start")); */
#ifdef G_SOLVE_PRINT 
  fprintf(stdout /* was Pel_Log */,"%% Pelican Output File: Generic System and Solutions\n");

   fprintf(stdout /* was Pel_Log */,"G=");
   psys_fprint(stdout /* was Pel_Log */,P);
   fprintf(stdout /* was Pel_Log */,";\n");
   fprintf(stdout /* was Pel_Log */,"S=\n");
   xpl_fprint(stdout /* was Pel_Log */,Sl);
   /*   Pel_Open_Log(Pel_LogName);  */
   
  
#endif
;
   /*  SUSPICIOUS
 free_Gen_list(g);
 */
  psys_free(P);
   POP_LOCS();
   return Xpl_to_Gen(Sl);
 }

/*
** ParamSet Command                      (tested)
*/

Gen_node G_ParamSet(Gen_node g){
 Gen_node ptr;
 if (g==0) return Rerror("NULL Arg in SetParam",g);
 ptr=g;
  while (ptr!=0){
   if (ptr->type!=Idf_T)
      return Rerror("Expecting Identifier in SetParam",g);
   SET_D_PARAM(Hom_tol)
 /*  SET_I_PARAM(Hom_use_proj) */
   SET_D_PARAM(PN_dt0)
   SET_D_PARAM(PN_maxdt)
   SET_D_PARAM(PN_mindt)
   SET_D_PARAM(PN_scaledt)
   SET_D_PARAM(PN_cfac)
   SET_D_PARAM(PN_NYtol)
   SET_D_PARAM(PN_NDtol)
   SET_D_PARAM(PN_Nratio)
   SET_D_PARAM(PN_tfinal)
   SET_D_PARAM(PN_FYtol)
   SET_D_PARAM(PN_FDtol)
   SET_D_PARAM(PN_Fratio)
   SET_D_PARAM(PN_Nratio)
   SET_I_PARAM(PN_maxsteps)
   SET_B_PARAM(Show_Sys)
   SET_B_PARAM(Show_Xpl)
   SET_S_PARAM(FilePrefix)
   else if (strcmp(ptr->Genval.idval,"Use_Hompack")==0){
    Cont_Alg=USE_HOMPACK;
    ptr=ptr->next;
   }
   else if (strcmp(ptr->Genval.idval,"Use_PNewton")==0){
    Cont_Alg=USE_PNEWTON;
    ptr=ptr->next;
   }
   else return Rerror("Unrecognized Parameter",g);
  }
  free_Gen_list(g);
  return IDND("");
}

#undef SET_D_PARAM
#undef SET_I_PARAM
#undef SET_B_PARAM

/*
** ParamShow Command
*/
#define SHOW_PARAM(Svar,T)\
    else if (strcmp(ptr->Genval.idval,#Svar)==0)\
         fprintf(stdout /* was Pel_Out */,#Svar T,Svar);
#define SHOW_I_PARAM(Svar) SHOW_PARAM(Svar,"=%d")
#define SHOW_D_PARAM(Svar) SHOW_PARAM(Svar,"=%g")
#define SHOW_S_PARAM(Svar) SHOW_PARAM(Svar,"=%s")
#define SHOW_B_PARAM(Svar)\
    else if (strcmp(ptr->Genval.idval,#Svar)==0){\
        if (Svar==TRUE) fprintf(stdout /* was Pel_Out */,#Svar "=TRUE");\
        else fprintf(stdout /* was Pel_Out */,#Svar "=FALSE");\
    }
#define DIS_PARAM(Svar,T) fprintf(stdout /* was Pel_Out */,#Svar T,Svar);


Gen_node G_ParamShow(Gen_node g){
 Gen_node ptr;
 if (g==0) return Rerror("NULL Arg in ShowParam",g);
 ptr=g;
 while (ptr!=0){
   if (ptr->type!=Idf_T)
         return Rerror("Expecting Identifier ShowParam",g);
   SHOW_D_PARAM(Hom_tol)
   SHOW_D_PARAM(PN_dt0)
   SHOW_D_PARAM(PN_maxdt)
   SHOW_D_PARAM(PN_mindt)
   SHOW_D_PARAM(PN_scaledt)
   SHOW_D_PARAM(PN_cfac)
   SHOW_D_PARAM(PN_tfinal)
   SHOW_D_PARAM(PN_NYtol)
   SHOW_D_PARAM(PN_NDtol)
   SHOW_D_PARAM(PN_Nratio)
   SHOW_D_PARAM(PN_FYtol)
   SHOW_D_PARAM(PN_FDtol)
   SHOW_D_PARAM(PN_Fratio)
   SHOW_I_PARAM(PN_maxsteps)
   SHOW_B_PARAM(Show_Sys)
   SHOW_B_PARAM(Show_Xpl)
   SHOW_S_PARAM(FilePrefix)
/*   SHOW_I_PARAM(Hom_use_proj) */
   else if (strcmp(ptr->Genval.idval,"Cont_Alg")==0){
      if (Cont_Alg==USE_HOMPACK)
#ifdef LOG_PRINT
fprintf(stdout /* was Pel_Out */,"Using Hompack")
#endif
;
      else if (Cont_Alg==USE_PNEWTON)
#ifdef LOG_PRINT
fprintf(stdout /* was Pel_Out */,"Using PNewton")
#endif

;
   }
   else if (strcmp(ptr->Genval.idval,"Hom_Params")==0)
      print_Hom_params(stdout /* was Pel_Out */);
   else if (strcmp(ptr->Genval.idval,"PN_Params")==0){
     DIS_PARAM(PN_dt0,"= %g,   ")
     DIS_PARAM(PN_scaledt,"=%g, \n")
     DIS_PARAM(PN_maxdt,"= %g,  ")
     DIS_PARAM(PN_mindt,"= %g\n")
     DIS_PARAM(PN_cfac, "= %g,  ")
     DIS_PARAM(PN_tfinal," = %g,  ")
     DIS_PARAM(PN_maxsteps,"=%d\n")
     DIS_PARAM(PN_NYtol,"= %g,  ")
     DIS_PARAM(PN_NDtol,"= %g,  ")
     DIS_PARAM(PN_Nratio,"= %g\n")
     DIS_PARAM(PN_FYtol,"= %g,  ")
     DIS_PARAM(PN_FDtol,"= %g,  ")
     DIS_PARAM(PN_Fratio,"= %g\n")
   }
   else return Rerror("Unrecognized Parameter",g);
   ptr=ptr->next;
 }
 free_Gen_list(g);
 return IDND("");
}
#undef SHOW_PARAM
#undef SHOW_I_PARAM
#undef SHOW_D_PARAM
#undef SHOW_B_PARAM
#undef DIS_PARAM


/*
** NormSub Command (tested)
*/
Gen_node G_NormSub(Gen_node g){
  psys P;
  Imatrix Nrm;
  if (Gen_length(g)!=2 ||
     (Can_Be_Vector(Gen_elt(g,1),Ply_T)<=0)||
     (Can_Be_Vector(Gen_elt(g,2),Int_T)<=0))
      return Rerror("Usage: NormSub(<Ply>,<Int>)",g);
  P=Gen_to_psys(Gen_elt(g,1));
  Nrm=Gen_to_Imatrix(Gen_elt(g,2));
  P=psys_norm_sub(P,Nrm);
  free_Gen_list(g);
  g=Gen_from_psys(P);
  psys_free(P);
  Imatrix_free(Nrm);
  return g;
}

/*
** Lead Command (tested)
*/
Gen_node G_Lead(Gen_node g){                                 
  psys PS1,PS2;
  if (Gen_length(g)!=1 ||
     (Can_Be_Vector(Gen_elt(g,1),Ply_T)<=0))
      return Rerror("Usage: <Ply> Lead(<Ply>)",g);
  PS1=Gen_to_psys(g);             
  free_Gen_list(g);                 
  PS2=psys_lead(PS1);
  g=Gen_from_psys(PS2);
  psys_free(PS2);
  psys_free(PS1);
  return g;
}

/*
** Verify Command (tested)
*/
Gen_node G_Verify(Gen_node g){
  Gen_node ptr,res,ptc;
  psys PS;
  Dmatrix D;

  if (Gen_length(g)!=2|| 
      Can_Be_Vector(Gen_elt(g,1),Ply_T)<0||
      Can_Be_List(Gen_elt(g,2))!=TRUE)
  return Rerror("Usage: Verify(<Ply>,{<Dbl>}",g);
  PS=Gen_to_psys(Gen_elt(g,1));
  ptr=Gen_lval(Gen_elt(g,2));
  ptc=(res=gen_node());
  while(ptr!=0){
    if (Can_Be_Vector(ptr,Dbl_T)==2*N+3){
       D=Gen_to_Dmatrix(ptr);
       Gen_set_next(ptc,Dbl_To_Gen(psys_abs(PS,D)));
       ptc=Gen_next(ptc);
       Dmatrix_free(D);
    }
    ptr=Gen_next(ptr);
  }
  psys_free(PS);
  /*
  free_Gen_list(g);
  */ 
 g=List(Gen_next(res));
  free_Gen_node(res);
  return g;
}

/*
** Eval Command
*/
Gen_node G_Eval(Gen_node g){
  Gen_node ptr,res,ptc;
  psys PS;
  Dmatrix X=0,Y=0;
  Gmatrix V=0;
  int i,xp;

  if (Gen_length(g)!=2||
      Can_Be_Vector(Gen_elt(g,1),Ply_T)<0||
         ( ((xp=Can_Be_Xpnt(Gen_elt(g,2)))==FALSE) &&
           (Can_Be_List_Of(Gen_elt(g,2),*Can_Be_Xpnt)==FALSE)))
  return Rerror("Usage: Eval(<Ply>,{<Dbl>}",g);
  PS=Gen_to_psys(Gen_elt(g,1));
  if (xp==TRUE) ptr=Gen_elt(g,2);
  else ptr=Gen_lval(Gen_elt(g,2));
  ptc=(res=gen_node());
  while(ptr!=0){
    if (Can_Be_Vector(ptr,Dbl_T)==2*N+3){
       X=Gen_to_Dmatrix(ptr);
       V=Gmatrix_new(1,N);
       Y= psys_eval(PS,X,Y);
       for(i=1;i<=N;i++){
         *GMref(V,1,i)=Cpx_To_Gen(Complex(DVref(Y,2*i-1),DVref(Y,2*i)));
       }
       Gen_set_next(ptc,GMND(V));
       ptc=Gen_next(ptc);
       Dmatrix_free(X);
    }
    ptr=Gen_next(ptr);
  }
  psys_free(PS);
  free_Gen_list(g);
  Dmatrix_free(Y);
  if (xp==TRUE) g=Gen_next(res);
  else  g=List(Gen_next(res));
  free_Gen_node(res);
  return g;
}



/*
** BinSolve Command:  (tested)
*/
Gen_node G_BinSolve(Gen_node g){
   psys P;
   node Sl;
   if ( Gen_length(g)!=1|| Can_Be_Vector(Gen_elt(g,1),Ply_T)<=0)
      return Rerror("Usage: BinSolve(<Ply>)",g);
   P=Gen_to_psys(Gen_elt(g,1));
   time0=set_mark();
   Sl=psys_binsolve(P);
   free_Gen_list(g);
   psys_free(P);
   return Xpl_to_Gen(Sl);
 }

/*
** Scale Command       (tested)
*/
Gen_node G_Scale(Gen_node g){
 psys PS;
 Dmatrix S;
 int l;
 if ( 
    ((l=Gen_length(g))<1)||
    ((l>=1)&&(Can_Be_Vector(Gen_elt(g,1),Ply_T)<=0))||
    ((l>=2)&&(Gen_type(Gen_elt(g,2))!=Idf_T))||
    (l>2))
     return Rerror("Usage: Scale(<Ply>,[Idf])",g);
 PS=Gen_to_psys(g);
 S=psys_scale(PS);
 if (l==2) install(Gen_idval(Gen_elt(g,2)),Dmatrix_to_Gen(S));
 /*
 free_Gen_list(g);
 */ 
g=Gen_from_psys(PS);
 Dmatrix_free(S);
 psys_free(PS);
return g;
}

/* 
** UnScale Command         (tested)
*/
Gen_node G_UnScale(Gen_node g){
 Gen_node ptr, res,rptr;
 Dmatrix scl;
 Dmatrix root = NULL;  /* Initialized to get rid of C++ warning */

 if (g==0 || 
     Gen_length(g)!=2 || 
     Can_Be_Vector(Gen_elt(g,2),Dbl_T)!=N ||
     Can_Be_List(g)!=TRUE)
    
  return Rerror("Usage: UnScale({<Dbl>},<Dbl>)version 1",g);
 
 rptr=(res=gen_node());
 ptr=Gen_lval(g);
 scl=Gen_to_Dmatrix(Gen_elt(g,2));
 while(ptr!=0){
   if (Can_Be_Vector(ptr,Dbl_T)!=2*N+3){
      Dmatrix_free(scl);
      free_Gen_list(Gen_next(res));
      free_Gen_node(res);
       return
        Rerror("Usage: UnScale({<Dbl>},<Dbl>) version 2",g);
     }

  root=Gen_to_Dmatrix(ptr);
  xpnt_unscale(root,scl);
  Gen_set_next(rptr,Dmatrix_to_Gen(root));
  rptr=Gen_next(rptr);
  ptr=Gen_next(ptr);
 }
 /*
 free_Gen_list(g);
 */ 
 g=XPLND(Gen_next(res));
 free_Gen_node(res);
 Dmatrix_free(scl);
 Dmatrix_free(root);
 return g;             
}

/*
** ScaleXPL Command         (tested)
*/
Gen_node G_ScaleXPL(Gen_node g){
 Gen_node ptr, res,rptr;
 Dmatrix scl;
 Dmatrix root = NULL; /* Initialized to get rid of C++ warning. */
 int i;
   
 if (g==0 ||
     Gen_length(g)!=2 ||
     Can_Be_Vector(Gen_elt(g,2),Dbl_T)!=N ||
     Can_Be_List(g)!=TRUE)
     return Rerror("Usage: XScale({<Dbl>},<Dbl>)",g);
    
 rptr=(res=gen_node());
 ptr=Gen_lval(g);
 scl=Gen_to_Dmatrix(Gen_elt(g,2));
 while(ptr!=0){
   if (Can_Be_Vector(ptr,Dbl_T)!=2*N+3){
      Dmatrix_free(scl);
      free_Gen_list(Gen_next(res));
      free_Gen_node(res);
       return
        Rerror("Usage: UnScale({<Dbl>},<Dbl>)",g);
     }
  for(i=1;i<=N;i++){ if (DVref(scl,i)!=0.0) DVref(scl,i)=1.0/DVref(scl,i);}
  root=Gen_to_Dmatrix(ptr);
  xpnt_unscale(root,scl);
  Gen_set_next(rptr,Dmatrix_to_Gen(root));
  rptr=Gen_next(rptr);
  ptr=Gen_next(ptr);
 } 
 /* 
free_Gen_list(g);
*/ 
g=XPLND(Gen_next(res));
 free_Gen_node(res);
 Dmatrix_free(scl);
 Dmatrix_free(root);
 return g;
}



/*
** Affine Command
*/ 
Gen_node G_Affine(Gen_node g){
 Gen_node ptr, res,rptr;
 Dmatrix root;

 
 if (g==0 ||
     Gen_length(g)!=1 ||
     Can_Be_List(g)!=TRUE)
     return Rerror("Usage: Affine({<Dbl>})",g);

 rptr=(res=gen_node());
 ptr=Gen_lval(g);
 while(ptr!=0){
   if (Can_Be_Vector(ptr,Dbl_T)!=2*N+3){
      free_Gen_list(Gen_next(res));
      free_Gen_node(res);
       return
        Rerror("Usage: Affine({<Dbl>})",g);
   }
  root=Gen_to_Dmatrix(ptr);
  xpnt_affine(root);
  Gen_set_next(rptr,Dmatrix_to_Gen(root));
  rptr=Gen_next(rptr);
  ptr=Gen_next(ptr);
 }
 /*
 free_Gen_list(g);
 */ 
g=XPLND(Gen_next(res));
 free_Gen_node(res);
 return g;
}

/*
** Normalize Command
*/
Gen_node G_Normalize(Gen_node g){
 Gen_node ptr, res,rptr;
 Dmatrix root;

 if (g==0 ||
     Gen_length(g)!=1 ||
     Can_Be_List(g)!=TRUE)
     return Rerror("Usage: Normalize({<Dbl>})",g);

 rptr=(res=gen_node());
 ptr=Gen_lval(g);
 while(ptr!=0){
   if (Can_Be_Vector(ptr,Dbl_T)!=2*N+3){
      free_Gen_list(Gen_next(res));
      free_Gen_node(res);
       return
        Rerror("Usage: Normalize({<Dbl>})",g);
   }
  root=Gen_to_Dmatrix(ptr);
  xpnt_normalize(root);
  Gen_set_next(rptr,Dmatrix_to_Gen(root));
  rptr=Gen_next(rptr);
  ptr=Gen_next(ptr);
 }
 free_Gen_list(g);
 g=List(Gen_next(res));
 free_Gen_node(res);
 return g;
}



/*
** Set_T Command                (tested)
*/
Gen_node G_Set_T(Gen_node g){
  Gen_node ptr;
  double t0;
   if ( Gen_length(g)!=2||
        Can_Be_List(Gen_elt(g,1))!=TRUE ||
        Can_Be_Number(Gen_elt(g,2),Dbl_T)==FALSE)
        return Rerror("Usage: SetT({<Dbl>},Dbl)",g);

   ptr=Gen_lval(Gen_elt(g,1));
   t0=Gen_To_Dbl(Gen_elt(g,2));
   free_Gen_list(Gen_next(g));
   while(ptr!=0){
     if (Can_Be_Vector(ptr,Dbl_T)<1){
       return Rerror("Usage: SetT({<Dbl>},Dbl)",g);
     }
     free_Gen_node(*GMref(Gen_Mtx(ptr),1,GMcols(Gen_Mtx(ptr))));
     *GMref(Gen_Mtx(ptr),1,GMcols(Gen_Mtx(ptr)))=DBLND(t0);
     ptr=Gen_next(ptr);
   }
   return g;
}

Gen_node G_Re(Gen_node g){
   fcomplex c;
   if ( Gen_length(g)!=1|| Can_Be_Cpx(Gen_elt(g,1))!=TRUE)
        return Rerror("Usage: Re(Cpx)",g);
   c=Gen_To_Cpx(g);
   free_Gen_list(g);
   return DBLND(Real(c));
}
 

Gen_node G_Im(Gen_node g){ 
   fcomplex c; 
   if ( Gen_length(g)!=1|| Can_Be_Cpx(Gen_elt(g,1))!=TRUE)
        return Rerror("Usage: Re(Cpx)",g); 
   c=Gen_To_Cpx(g); 
   free_Gen_list(g); 
   return DBLND(Imag(c)); 
}