Back to index

wims  3.65+svn20090927
sp.c
Go to the documentation of this file.
00001 /*    Copyright (C) 1998-2003 XIAO, Gang of Universite de Nice - Sophia Antipolis
00002  *
00003  *  This program is free software; you can redistribute it and/or modify
00004  *  it under the terms of the GNU General Public License as published by
00005  *  the Free Software Foundation; either version 2 of the License, or
00006  *  (at your option) any later version.
00007  *
00008  *  This program is distributed in the hope that it will be useful,
00009  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
00010  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00011  *  GNU General Public License for more details.
00012  *
00013  *  You should have received a copy of the GNU General Public License
00014  *  along with this program; if not, write to the Free Software
00015  *  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
00016  */
00017 
00018 char *setpre="";
00019 
00020 void sp_asis(char *p, int ptype)
00021 {
00022     fprintf(outf,"%stmp%d=!nosubst %s\n\n",setpre,prepcnt,p);
00023 }
00024 
00025 void sp_evalue(char *p, int ptype)
00026 {
00027     char *p1, *p2, *pe;
00028     
00029     p1=strparchr(p,',');
00030     if(p1==NULL) {
00031        fprintf(outf,"%stmp%d=%s\n\n",setpre,prepcnt,p);
00032        return;
00033     }
00034     *p1++=0; fprintf(outf,"%sevaltmp=%s\n\n", setpre,p);
00035     for(; p1!=NULL; p1=p2){
00036        p1=find_word_start(p1);
00037        p2=strparchr(p1,',');
00038        if(p2!=NULL) *p2++=0;
00039        pe=strchr(p1,'=');
00040        if(pe==NULL) continue;
00041        *pe++=0; *find_word_end(p1)=0;
00042        if(*p1==0) continue;
00043        fprintf(outf,"%sevaltmp=!mathsubst %s=(%s) in $evaltmp\n",
00044               setpre,p1,pe);
00045     }
00046     fprintf(outf,"%stmp%d=($evaltmp)\n",setpre,prepcnt);
00047 }
00048 
00049        /* simple roots.     */
00050 void sp_solve(char *p, int ptype)
00051 {
00052     fprintf(outf,"%stmp=!replace internal .. by , in %s \n\n\
00053 !distribute items $tmp into tmp1,tmp2,tmp3\n\
00054 %stmp2=!replace internal = by , in $tmp2\n\
00055 !distribute items $tmp2 into tmp4,tmp5\n\
00056 %stmp%d=!solve $tmp1 for $tmp4 = $tmp5 to $tmp3 \n",
00057            setpre,p,setpre,setpre,prepcnt);
00058 }
00059 
00060        /* use maxima to do formal derivation.    */
00061 void sp_diff(char *p, int ptype)
00062 {
00063     fprintf(outf,"%stmp=!translate ;\";': to $     $ in %s\n\n\
00064 %stmp=!lower $tmp\n\
00065 %stmp%d=!exec maxima diff($tmp);\n",
00066            setpre,p,setpre,setpre,prepcnt);
00067 }
00068 
00069        /* user pari to compute matrix determinant. */
00070 void sp_det(char *p, int ptype)
00071 {
00072     fprintf(outf,"%stmp=!translate $      $ to ; in %s\n\n\
00073 %stmp%d=!exec pari matdet([$tmp])\n",
00074            setpre,p,setpre,prepcnt);
00075 }
00076 
00077        /* use maxima to do formal integration,
00078         * but pari for numerical integration. */
00079 void sp_int(char *p, int ptype)
00080 {
00081     char *s;
00082  
00083     if((s=strchr(p,'='))!=NULL) *s=',';
00084     if((s=strstr(p,".."))!=NULL) {*s=','; *(s+1)=' ';}
00085     fprintf(outf,"%stmp=!translate ;\";': to $     $ in %s \n\
00086 %stmp=!lower $tmp\n\
00087 !readproc slib/function/integrate $tmp\n\
00088 %stmp%d=$slib_out\n",
00089            setpre,p,setpre,setpre,prepcnt);
00090 }
00091 
00092 void sp_htmlmath(char *p, int ptype)
00093 {
00094     fprintf(outf,"%stmp%d=!htmlmath %s\n\n",setpre,prepcnt,p);
00095 }
00096 
00097 void sp_texmath(char *p, int ptype)
00098 {
00099     fprintf(outf,"%stmp%d=!texmath %s\n\n",setpre,prepcnt,p);
00100 }
00101 
00102 void sp_maxima(char *p, int ptype)
00103 {
00104     fprintf(outf,"%st_=!replace internal \\( by ( in %s\n\
00105 %stmp%d=!exec maxima $t_\n\n",setpre,p,setpre,prepcnt);
00106 }
00107 
00108 void sp_yacas(char *p, int ptype)
00109 {
00110     fprintf(outf,"%st_=!replace internal \\( by ( in %s\n\
00111 %stmp%d=!exec yacas $t_\n\n",setpre,p,setpre,prepcnt);
00112 }
00113 
00114 void sp_pari(char *p, int ptype)
00115 {
00116     fprintf(outf,"%st_=!replace internal \\( by ( in %s\n\
00117 %stmp%d=!exec pari $t_\n\n",setpre,p,setpre,prepcnt);
00118 }
00119 
00120 void sp_simplify(char *p, int ptype)
00121 {
00122     fprintf(outf,"%stmp=!translate \";': to $     $ in %s\n\n\
00123 %stmp=!lower $tmp\n\
00124 %stmp%d=!exec maxima fullratsimp($tmp);\n",
00125            setpre,p,setpre,setpre,prepcnt);
00126 }
00127 
00128 void sp_slib(char *p, int ptype)
00129 {
00130     char *p2;
00131     p=find_word_start(p);
00132     for(p2=p;*p2!=0 && !isspace(*p2) && *p2!=',' && *p2!=';';p2++);
00133     if(*p2!=0 && !isspace(*p2)) *p2=' ';
00134     fprintf(outf,"!readproc slib/%s \n\
00135 %stmp%d=$slib_out\n",p,setpre,prepcnt);
00136 }
00137 
00138 void sp_draw(char *p, int ptype)
00139 {
00140     char *p2;
00141     p2=strchr(p,'    '); if(p2==NULL) p2=strchr(p,'\n');
00142     if(p2==NULL) return; *p2++=0;
00143     fprintf(outf,"!readproc %s/draw.phtml %s \\\n%s \n\
00144 %stmp%d=$ins_url\n", primitive_dir, p, p2, setpre,prepcnt);
00145 }
00146 
00147 void sp_shuffle(char *p, int ptype)
00148 {
00149     fprintf(outf,"%stmp%d=!shuffle %s\n\n",setpre,prepcnt,p);
00150 }
00151 
00152 void sp_positionof(char *p, int ptype)
00153 {
00154     char *p1;
00155     p1=strparchr(p,','); if(p1==NULL) {
00156        fprintf(outf,"%stmp%d=%s\n\n",setpre,prepcnt,p); return;
00157     }
00158     *p1++=0;
00159     fprintf(outf,"%stmp%d=!positionof item %s in %s\n\n",setpre,prepcnt,p, p1);
00160 }
00161 
00162 void sp_random(char *p, int ptype)
00163 {
00164     char *pr, *p2, buf[MAX_LINELEN+1];
00165     snprintf(buf,sizeof(buf),"%s",p);
00166     for(p2=buf; *p2 && p2-buf<MAX_LINELEN; p2++) {
00167        if(*p2=='(') {
00168            p2=find_matching(p2+1,')'); continue;
00169        }
00170        if(*p2==',' || (*p2=='.' && *(p2+1)=='.')) break;
00171     }
00172     if(*p2==',') pr="randitem";
00173     else {
00174        if(*p2=='.') {
00175            *p2=','; *(p2+1)=' ';
00176        }
00177        if(ptype==pt_int) pr="randint"; else pr="random";
00178     }
00179     fprintf(outf,"%stmp%d=!%s %s\n\n",setpre,prepcnt,pr,buf);
00180 }
00181 
00182 void sp_pickone(char *p, int ptype)
00183 {
00184     sp_random(p,pt_int);
00185 }
00186 
00187 void sp_item(char *p, int ptype)
00188 {
00189     char *pp, *p2, buf[MAX_LINELEN+1];
00190     pp=strparchr(p,',');
00191     if(pp==NULL) pp=""; else *pp++=0;
00192     strncpy(buf,p,MAX_LINELEN);buf[MAX_LINELEN]=0;
00193     strip_enclosing_par(buf);
00194     if((p2=strstr(buf,".."))!=NULL) string_modify(buf,p2,p2+2," to ");
00195     fprintf(outf,"%stmp%d=!item %s of %s\n\n",setpre,prepcnt,buf,pp);
00196 }
00197 
00198 void sp_items(char *p, int ptype)
00199 {
00200     fprintf(outf,"%stmp%d=!itemcnt %s\n\n",setpre,prepcnt,p);
00201 }
00202 
00203 void sp_randitem(char *p, int ptype)
00204 {
00205     fprintf(outf,"%stmp=!nonempty items %s\n\n\
00206 %stmp%d=!randitem $tmp\n",setpre,p,setpre,prepcnt);
00207 }
00208 
00209 void sp_column(char *p, int ptype)
00210 {
00211     char *pp, *p2, buf[MAX_LINELEN+1];
00212     pp=strparchr(p,',');
00213     if(pp==NULL) pp=""; else *pp++=0;
00214     strncpy(buf,p,MAX_LINELEN);buf[MAX_LINELEN]=0;
00215     strip_enclosing_par(buf);
00216     if((p2=strstr(buf,".."))!=NULL) string_modify(buf,p2,p2+2," to ");
00217     fprintf(outf,"%stmp=!translate internal $    $ to ; in %s\n\n\
00218 %stmp=!column %s of $tmp\n\
00219 %stmp%d=!translate internal $\\\n$ to ; in $tmp\n",
00220            setpre,pp,setpre, buf, setpre, prepcnt);
00221 }
00222 
00223 void sp_row(char *p, int ptype)
00224 {
00225     char *pp, *p2, buf[MAX_LINELEN+1];
00226     pp=strparchr(p,',');
00227     if(pp==NULL) pp=""; else *pp++=0;
00228     strncpy(buf,p,MAX_LINELEN);buf[MAX_LINELEN]=0;
00229     strip_enclosing_par(buf);
00230     fprintf(outf,"%stmp=!translate internal $    $ to ; in %s\n\n",
00231            setpre,pp);
00232     if(strstr(buf,"column")!=NULL) {
00233        fprintf(outf,"%stmp%d=!select $tmp where %s\n\n",setpre,prepcnt,buf);
00234        return;
00235     }
00236     while((p2=strstr(buf,".."))!=NULL) 
00237       string_modify(buf,p2,p2+2," to ");
00238     fprintf(outf,"%stmp=!row %s of $tmp\n\
00239 %stmp%d=!translate internal $\\\n$ to ; in $tmp\n",
00240            setpre, buf, setpre, prepcnt);
00241 }
00242 
00243 void sp_rows(char *p, int ptype)
00244 {
00245     fprintf(outf,"%stmp=!translate internal $    $ to ; in %s\n\n\
00246 %stmp%d=!rowcnt $tmp\n",setpre,p,setpre,prepcnt);
00247 }
00248 
00249 void sp_randrow(char *p, int ptype)
00250 {
00251     fprintf(outf,"%stmp=!translate internal $    $ to ; in %s\n\n\
00252 %stmp=!nonempty rows $tmp\n\
00253 %stmp=!randrow $tmp\n\
00254 %stmp%d=!translate internal $\\\n$ to ; in $tmp\n",
00255            setpre,p,setpre,setpre,setpre,prepcnt);
00256 }
00257 
00258 void sp_mathexp_cut(char *p, int ptype)
00259 {
00260     char *p2;
00261     p2=find_word_end(find_word_start(p)); if(isspace(*p2)) *p2++=0;
00262     p2=find_word_start(p2);
00263     fprintf(outf,"%stmp%d=!exec mathexp cut %s\\\n%s\n\n",
00264            setpre,prepcnt,p,p2);
00265 }
00266 
00267 void sp_wims(char *p, int ptype)
00268 {
00269     p=find_word_start(p);
00270     if(!isalpha(*p) || strncasecmp(p,"ins",3)==0)
00271       fprintf(outf,"%stmp%d=%s\n\n",setpre,prepcnt,p);
00272     else
00273       fprintf(outf,"%stmp%d=!%s\n\n",setpre,prepcnt,p);
00274 }
00275 
00276 struct {
00277     char *name;
00278     void (*processor)(char *p, int ptype);
00279 } specialfn[]={
00280       {"asis",              sp_asis},
00281       {"column",     sp_column},
00282       {"deriv",             sp_diff},
00283       {"derivative", sp_diff},
00284       {"det",        sp_det},
00285       {"determinant",       sp_det},
00286       {"diff",              sp_diff},
00287       {"draw",              sp_draw},
00288       {"evaluate",   sp_evalue},
00289       {"evalue",     sp_evalue},
00290       {"htmlmath",   sp_htmlmath},
00291       {"int",        sp_int},
00292       {"integral",   sp_int},
00293       {"integrate",  sp_int},
00294       {"item",              sp_item},
00295       {"items",             sp_items},
00296       {"mathexp_cut",       sp_mathexp_cut},
00297       {"maxima",     sp_maxima},
00298       {"pari",              sp_pari},
00299       {"pickone",    sp_pickone},
00300       {"position",   sp_positionof},
00301       {"positionof", sp_positionof},
00302       {"randint",    sp_pickone},
00303       {"randitem",   sp_randitem},
00304       {"random",     sp_random},
00305       {"randomitem", sp_randitem},
00306       {"randomrow",  sp_randrow},
00307       {"randrow",    sp_randrow},
00308       {"row",        sp_row},
00309       {"rows",              sp_rows},
00310       {"shuffle",    sp_shuffle},
00311       {"simplify",   sp_simplify},
00312       {"slib",              sp_slib},
00313       {"solve",             sp_solve},
00314       {"texmath",    sp_texmath},
00315       {"wims",              sp_wims},
00316       {"yacas",             sp_yacas}
00317 };
00318 #define specialfn_no (sizeof(specialfn)/sizeof(specialfn[0]))
00319 
00320        /* This routine treats special functions */
00321 void parmprep(char *p,int ptype)
00322 {
00323     char *pp, *p2, *pn, namebuf[32], buf[MAX_LINELEN+1];
00324     int i;
00325 
00326     while((pp=strchr(p,'\n'))!=NULL) *pp='       ';
00327     for(pp=p;*pp && pp-p<MAX_LINELEN;pp++) {
00328        /* function names */
00329        if(isalpha(*pp)) {
00330            for(i=0;i<30 && (isalnum(pp[i]) || pp[i]=='_');i++) namebuf[i]=pp[i];
00331            namebuf[i]=0; p2=find_word_start(pp+i);
00332            if((pp>p && isalnum(*(pp-1))) || *p2!='(') {
00333               /* if(*p2=='\\' && *(p2+1)=='(') strcpy(p2,p2+1); */
00334               pp=p2-1; continue;
00335            }
00336            pn=pp; pp=p2+1; p2=find_matching(pp,')');
00337            if(p2==NULL) {
00338               error("unmatched_parentheses");
00339               pp=p2; continue;
00340            }
00341            i=search_list(specialfn,specialfn_no,sizeof(specialfn[0]),namebuf);
00342            if(i<0) {
00343               pp--; continue;
00344            }
00345            *p2=0;
00346            snprintf(buf,sizeof(buf),"%s",pp);
00347            if(specialfn[i].processor!=sp_asis) parmprep(buf,ptype);
00348            specialfn[i].processor(buf,ptype);
00349            string_modify(p, pn, p2+1, "$(tmp%d)",prepcnt); prepcnt++;
00350            pp=pn+6;
00351        }
00352     }
00353 }
00354