Logo Search packages:      
Sourcecode: wims version File versions  Download package

sp.c

/*    Copyright (C) 1998 XIAO, Gang of Universite de Nice - Sophia Antipolis
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

char *setpre="";

void sp_evalue(char *p, int ptype)
{
    char *p1, *p2, *pe;
    
    p1=strparchr(p,',');
    if(p1==NULL) {
      fprintf(outf,"%stmp%d=%s\n\n",setpre,prepcnt,p);
      return;
    }
    *p1++=0; fprintf(outf,"%sevaltmp=%s\n\n", setpre,p);
    for(; p1!=NULL; p1=p2){
      p1=find_word_start(p1);
      p2=strparchr(p1,',');
      if(p2!=NULL) *p2++=0;
      pe=strchr(p1,'=');
      if(pe==NULL) continue;
      *pe++=0; *find_word_end(p1)=0;
      if(*p1==0) continue;
      fprintf(outf,"%sevaltmp=!mathsubst %s=(%s) in $evaltmp\n",
            setpre,p1,pe);
    }
    fprintf(outf,"%stmp%d=($evaltmp)\n",setpre,prepcnt);
}

      /* simple roots.  */
void sp_solve(char *p, int ptype)
{
    fprintf(outf,"%stmp=!replace internal .. by , in %s \n\n\
!distribute items $tmp into tmp1,tmp2,tmp3\n\
%stmp2=!replace internal = by , in $tmp2\n\
!distribute items $tmp2 into tmp4,tmp5\n\
%stmp%d=!solve $tmp1 for $tmp4 = $tmp5 to $tmp3 \n",
          setpre,p,setpre,setpre,prepcnt);
}

      /* use maxima to do formal derivation.    */
void sp_diff(char *p, int ptype)
{
    fprintf(outf,"%stmp=!translate ;\";': to $     $ in %s\n\n\
%stmp=!lower $tmp\n\
%stmp%d=!exec maxima diff($tmp);\n",
          setpre,p,setpre,setpre,prepcnt);
}

      /* user pari to compute matrix determinant. */
void sp_det(char *p, int ptype)
{
    fprintf(outf,"%stmp=!translate $      $ to ; in %s\n\n\
%stmp%d=!exec pari matdet([$tmp])\n",
          setpre,p,setpre,prepcnt);
}

      /* use maxima to do formal integration,
       * but pari for numerical integration. */
void sp_int(char *p, int ptype)
{
    char *s, *intp;
 
    if((s=strchr(p,'='))!=NULL) *s=',';
    if((s=strstr(p,".."))!=NULL) {*s=','; *(s+1)=' ';}
    if(ptype==pt_func || ptype==pt_text) intp="integrate";
    else intp="romberg";
    fprintf(outf,"%stmp=!translate ;\";': to $     $ in %s\n\n\
%stmp=!lower $tmp \n\
%stmp%d=!exec maxima %s($tmp);\n",
          setpre,p,setpre,setpre,prepcnt,intp);
    return;
    if(ptype==pt_func || ptype==pt_text) {
      if((s=strchr(p,'='))!=NULL) *s=',';
      if((s=strstr(p,".."))!=NULL) {*s=','; *(s+1)=' ';}
      fprintf(outf,"%stmp=!translate ;\";': to $     $ in %s\n\n\
%stmp=!lower $tmp \n\
%stmp%d=!exec maxima integrate($tmp);\n",
            setpre,p,setpre,setpre,prepcnt);
    }
    else {
      char *p1, *p2;
      p1=strparchr(p,','); if(p1==NULL) return; /* This is an error */
      *p1++=0; p2=p;
      if(strchr(p1,'=')==NULL) {
          p=p1;p1=p2;p2=p;
      }
      if(strchr(p1,'=')==NULL) return; /* again an error */
      p=strstr(p1,".."); if(p!=NULL) {
          *p=',';*(p+1)=' ';
      }
      fprintf(outf,"%stmp=!translate ;\";': to $     $ in %s,%s\n\n\
%stmp=!lower $tmp\n\
%stmp%d=!exec pari intnum($tmp)\n",
            setpre,p1,p2,setpre,setpre,prepcnt);
    }
}

void sp_htmlmath(char *p, int ptype)
{
    fprintf(outf,"%stmp%d=!htmlmath %s\n\n",setpre,prepcnt,p);
}

void sp_texmath(char *p, int ptype)
{
    fprintf(outf,"%stmp%d=!texmath %s\n\n",setpre,prepcnt,p);
}

void sp_maxima(char *p, int ptype)
{
    fprintf(outf,"%st_=!replace internal \\( by ( in %s\n\
%stmp%d=!exec maxima $t_\n\n",setpre,p,setpre,prepcnt);
}

void sp_yacas(char *p, int ptype)
{
    fprintf(outf,"%st_=!replace internal \\( by ( in %s\n\
%stmp%d=!exec yacas $t_\n\n",setpre,p,setpre,prepcnt);
}

void sp_pari(char *p, int ptype)
{
    fprintf(outf,"%st_=!replace internal \\( by ( in %s\n\
%stmp%d=!exec pari $t_\n\n",setpre,p,setpre,prepcnt);
}

void sp_simplify(char *p, int ptype)
{
    fprintf(outf,"%stmp=!translate \";': to $     $ in %s\n\n\
%stmp=!lower $tmp\n\
%stmp%d=!exec maxima fullratsimp($tmp);\n",
          setpre,p,setpre,setpre,prepcnt);
}

void sp_slib(char *p, int ptype)
{
    char *p2;
    p=find_word_start(p);
    for(p2=p;*p2!=0 && !isspace(*p2) && *p2!=',' && *p2!=';';p2++);
    if(*p2!=0 && !isspace(*p2)) *p2=' ';
    fprintf(outf,"!readproc slib/%s \n\
%stmp%d=$slib_out\n",p,setpre,prepcnt);
}

void sp_shuffle(char *p, int ptype)
{
    fprintf(outf,"%stmp%d=!shuffle %s\n\n",setpre,prepcnt,p);
}

void sp_positionof(char *p, int ptype)
{
    char *p1;
    p1=strparchr(p,','); if(p1==NULL) {
      fprintf(outf,"%stmp%d=%s\n\n",setpre,prepcnt,p); return;
    }
    *p1++=0;
    fprintf(outf,"%stmp%d=!positionof item %s in %s\n\n",setpre,prepcnt,p, p1);
}

void sp_random(char *p, int ptype)
{
    char *pr, *p2, buf[MAX_LINELEN+1];
    snprintf(buf,sizeof(buf),"%s",p);
    for(p2=buf; *p2 && p2-buf<MAX_LINELEN; p2++) {
      if(*p2=='(') {
          p2=find_matching(p2+1,')'); continue;
      }
      if(*p2==',' || (*p2=='.' && *(p2+1)=='.')) break;
    }
    if(*p2==',') pr="randitem";
    else {
      if(*p2=='.') {
          *p2=','; *(p2+1)=' ';
      }
      if(ptype==pt_int) pr="randint"; else pr="random";
    }
    fprintf(outf,"%stmp%d=!%s %s\n\n",setpre,prepcnt,pr,buf);
}

void sp_pickone(char *p, int ptype)
{
    sp_random(p,pt_int);
}

void sp_item(char *p, int ptype)
{
    char *pp, *p2, buf[MAX_LINELEN+1];
    pp=strparchr(p,',');
    if(pp==NULL) pp=""; else *pp++=0;
    strncpy(buf,p,MAX_LINELEN);buf[MAX_LINELEN]=0;
    strip_enclosing_par(buf);
    if((p2=strstr(buf,".."))!=NULL) string_modify(buf,p2,p2+2," to ");
    fprintf(outf,"%stmp%d=!item %s of %s\n\n",setpre,prepcnt,buf,pp);
}

void sp_items(char *p, int ptype)
{
    fprintf(outf,"%stmp%d=!itemcnt %s\n\n",setpre,prepcnt,p);
}

void sp_randitem(char *p, int ptype)
{
    fprintf(outf,"%stmp=!nonempty items %s\n\n\
%stmp%d=!randitem $tmp\n",setpre,p,setpre,prepcnt);
}

void sp_column(char *p, int ptype)
{
    char *pp, *p2, buf[MAX_LINELEN+1];
    pp=strparchr(p,',');
    if(pp==NULL) pp=""; else *pp++=0;
    strncpy(buf,p,MAX_LINELEN);buf[MAX_LINELEN]=0;
    strip_enclosing_par(buf);
    if((p2=strstr(buf,".."))!=NULL) string_modify(buf,p2,p2+2," to ");
    fprintf(outf,"%stmp=!translate internal $   $ to ; in %s\n\n\
%stmp=!column %s of $tmp\n\
%stmp%d=!translate internal $\\\n$ to ; in $tmp\n",
          setpre,pp,setpre, buf, setpre, prepcnt);
}

void sp_row(char *p, int ptype)
{
    char *pp, *p2, buf[MAX_LINELEN+1];
    pp=strparchr(p,',');
    if(pp==NULL) pp=""; else *pp++=0;
    strncpy(buf,p,MAX_LINELEN);buf[MAX_LINELEN]=0;
    strip_enclosing_par(buf);
    fprintf(outf,"%stmp=!translate internal $   $ to ; in %s\n\n",
          setpre,pp);
    if(strstr(buf,"column")!=NULL) {
      fprintf(outf,"%stmp%d=!select $tmp where %s\n\n",setpre,prepcnt,buf);
      return;
    }
    while((p2=strstr(buf,".."))!=NULL) 
      string_modify(buf,p2,p2+2," to ");
    fprintf(outf,"%stmp=!row %s of $tmp\n\
%stmp%d=!translate internal $\\\n$ to ; in $tmp\n",
          setpre, buf, setpre, prepcnt);
}

void sp_rows(char *p, int ptype)
{
    fprintf(outf,"%stmp=!translate internal $   $ to ; in %s\n\n\
%stmp%d=!rowcnt $tmp\n",setpre,p,setpre,prepcnt);
}

void sp_randrow(char *p, int ptype)
{
    fprintf(outf,"%stmp=!translate internal $   $ to ; in %s\n\n\
%stmp=!nonempty rows $tmp\n\
%stmp=!randrow $tmp\n\
%stmp%d=!translate internal $\\\n$ to ; in $tmp\n",
          setpre,p,setpre,setpre,setpre,prepcnt);
}

void sp_mathexp_cut(char *p, int ptype)
{
    char *p2;
    p2=find_word_end(find_word_start(p)); if(isspace(*p2)) *p2++=0;
    p2=find_word_start(p2);
    fprintf(outf,"%stmp%d=!exec mathexp cut %s\\\n%s\n\n",
          setpre,prepcnt,p,p2);
}

void sp_wims(char *p, int ptype)
{
    p=find_word_start(p);
    if(!isalpha(*p) || strncasecmp(p,"ins",3)==0)
      fprintf(outf,"%stmp%d=%s\n\n",setpre,prepcnt,p);
    else
      fprintf(outf,"%stmp%d=!%s\n\n",setpre,prepcnt,p);
}

struct {
    char *name;
    void (*processor)(char *p, int ptype);
} specialfn[]={
      {"column",  sp_column},
      {"deriv",         sp_diff},
      {"derivative",    sp_diff},
      {"det",           sp_det},
      {"determinant",   sp_det},
      {"diff",          sp_diff},
      {"evaluate",      sp_evalue},
      {"evalue",  sp_evalue},
      {"htmlmath",      sp_htmlmath},
      {"int",           sp_int},
      {"integral",      sp_int},
      {"integrate",     sp_int},
      {"item",          sp_item},
      {"items",         sp_items},
      {"mathexp_cut",   sp_mathexp_cut},
      {"maxima",  sp_maxima},
      {"pari",          sp_pari},
      {"pickone", sp_pickone},
      {"position",      sp_positionof},
      {"positionof",    sp_positionof},
      {"randint", sp_pickone},
      {"randitem",      sp_randitem},
      {"random",  sp_random},
      {"randomitem",    sp_randitem},
      {"randomrow",     sp_randrow},
      {"randrow", sp_randrow},
      {"row",           sp_row},
      {"rows",          sp_rows},
      {"shuffle", sp_shuffle},
      {"simplify",      sp_simplify},
      {"slib",          sp_slib},
      {"solve",         sp_solve},
      {"texmath", sp_texmath},
      {"wims",          sp_wims},
      {"yacas",         sp_yacas}
};
#define specialfn_no (sizeof(specialfn)/sizeof(specialfn[0]))

      /* This routine treats special functions */
void parmprep(char *p,int ptype)
{
    char *pp, *p2, *pn, namebuf[32], buf[MAX_LINELEN+1];
    int i;
    
    for(pp=p;*pp && pp-p<MAX_LINELEN;pp++) {
      /* function names */
      if(isalpha(*pp)) {
          for(i=0;i<30 && (isalnum(pp[i]) || pp[i]=='_');i++) namebuf[i]=pp[i];
          namebuf[i]=0; p2=find_word_start(pp+i);
          if((pp>p && isalnum(*(pp-1))) || *p2!='(') {
            /* if(*p2=='\\' && *(p2+1)=='(') strcpy(p2,p2+1); */
            pp=p2-1; continue;
          }
          pn=pp; pp=p2+1; p2=find_matching(pp,')');
          if(p2==NULL) {
            error("unmatched_parentheses");
            pp=p2; continue;
          }
          i=search_list(specialfn,specialfn_no,sizeof(specialfn[0]),namebuf);
          if(i<0) {
            pp--; continue;
          }
          *p2=0;
          snprintf(buf,sizeof(buf),"%s",pp);
          parmprep(buf,ptype);
          specialfn[i].processor(buf,ptype);
          string_modify(p, pn, p2+1, "$(tmp%d)",prepcnt); prepcnt++;
          pp=pn+6;
      }
    }
}


Generated by  Doxygen 1.6.0   Back to index