smif.c

强大的数学工具包

   }
   else if (argc == 7) { /* GET LIST or GET POL */
	  if (option == SMif_GETLIST) {
		 if (strcmp (argv[5],"ITEM") == 0)
			getinfoptr->subtype = ITEMNEXT;
		 else
			getinfoptr->subtype = LINENEXT;
	  } else
		 getinfoptr->subtype = LINENEXT;
		 
	  tempint = strlen(argv[4]);
	  for (mm = 0; mm < tempint; mm++)
		 if (!isdigit(argv[4][mm])) {
			isdigit = 0;
			break;
		 }
	  if (!isdigit) {
		 Tcl_AppendResult (interp, "GET LIST or POL: error: expected positiv integer ",
						   "but got \"", argv[1], "\"\n",(char*) NULL);
		 return TCL_ERROR;
	  }
	  getinfoptr->count = atoi (argv[4]);
   }   
   
   /* Get: Start.... */
     
   if (option == SMif_GETLIST) {
	  if (islevel0) {
		 (void) Tcl_DStringAppend (&(smifptr->result),"\n[LIST]\n",-1);
		 (void)Tcl_DStringAppend (&(smifptr->result),"(",1);
	  }
	  else
		 (void)Tcl_DStringAppend (&(smifptr->result)," (",2);
   }
   
   /* run subscript */
   if (Tcl_Eval (interp,argv[argc-1]) == TCL_ERROR) {
	  if (getinfoptr->err == SUBTYPEERR) 
		 Tcl_AppendResult (interp, "Error: \"GET LIST\" should not run under a",
						   "\"GET LIST FOR NEXT ...\" command",(char*)NULL);
	  if (getinfoptr->err == TYPEERR && option == SMif_GETLIST) 
		 Tcl_AppendResult (interp, "Error: GET SINGLE(INT,POL) commands should not run under a GET ",
						   "LIST command",(char*)NULL);
	  if (getinfoptr->err == TYPEERR && option != SMif_GETLIST)
		 Tcl_AppendResult (interp, "Error: GET commands should not run under a GET SINGLE(INT,POL) ",
						   "comand", (char*)NULL);
	  if (getinfoptr->err == SKIPERR)
		 Tcl_AppendResult (interp, "Error: SKIP commands should not run under a GET comand with",
						   " option \"FOR NEXT (n) LINE\"\n", (char*)NULL);
	  if (getinfoptr->err == ITEMERR)
		 Tcl_AppendResult (interp, "Error: SETITEM commands should not run under a GET POL command",
						   (char*)NULL);
	  return TCL_ERROR;
   }
  
   /* Get */   
   
   switch (option) {
	  case SMif_GETLIST : 
		   while (!endwhile) {
			  if ( GetItemWord(smifptr,&endwhile,DIGITONLY) == TCL_ERROR)
				 return TCL_ERROR;
			  if (strcmp (interp->result, "")!=0)
				 (void)Tcl_DStringAppendElement (&(smifptr->result), interp->result);
		   }
		   (void)Tcl_DStringAppend (&(smifptr->result)," )",2);
		   break;
		   
	  case SMif_GETINT :
	  case SMif_GETSINGLE:
		   if ( GetItemWord(smifptr,(int*)NULL, DIGITONLY) == TCL_ERROR)
			  return TCL_ERROR;
		   if (strcmp (interp->result, "")!= 0) {
			  if (option == SMif_GETINT)
				 (void)Tcl_DStringAppend (&(smifptr->result),"\n[INT]\n", -1); 
			  else
				 (void)Tcl_DStringAppend (&(smifptr->result),"\n[SINGLE]\n", -1); 
			  (void)Tcl_DStringAppend (&(smifptr->result),interp->result,-1);
		   }
		   break;
		   
	  case SMif_GETPOL:

		   endwhile = 0;
		   polptr = (Tcl_DString*) malloc (sizeof (Tcl_DString));
		   Tcl_DStringInit (polptr);
		   while (!endwhile) {
			  if (GetItemWord(smifptr,&endwhile,ALLCHAR) == TCL_ERROR)
				 return TCL_ERROR;
			  (void)Tcl_DStringAppend (polptr, interp->result, -1);
		   }
		   poltemp = (char*) malloc(sizeof(char)*(Tcl_DStringLength(polptr)+1));
		   strcpy (poltemp, Tcl_DStringValue(polptr));
		   Tcl_DStringFree (polptr);

		   if (strcmp(poltemp,"") != 0) { /* not empty */
			  (void)Tcl_DStringAppend (&(smifptr->result),"\n[POL]\n", -1); 		   
			  if (MakeSMPol (poltemp, &(smifptr->result)) == TCL_ERROR) {
				 Tcl_AppendResult (interp, "Error: invalid polynomial",(char*)NULL);	
				 return TCL_ERROR;
			  }
			  (void)Tcl_DStringAppend (&(smifptr->result)," #",2);
		   }
   }
   
   if (polptr!=NULL) free (polptr);
   if (poltemp != NULL) free (poltemp);
   
   /* Abbau des Kellers */
   smifptr->envinfo = envinfonew->next;
   delchartable (&(envinfonew->ignotable.chartable));
   delchartable (&(envinfonew->npnltable.chartable));
   delchartable (&(envinfonew->stoptable.chartable));
   delchartable (&(envinfonew->repeattable.chartable));
   delwordtable (&(envinfonew->ignotable.wordtable));
   delwordtable (&(envinfonew->stoptable.wordtable));
   delwordtable (&(envinfonew->npnltable.wordtable));
   delwordtable (&(envinfonew->repeattable.wordtable));
   free (envinfonew->iteminfo.pattern);
   free (envinfonew);
   
   return TCL_OK;
         	 
}


/* beliebiges Polnomstring -> SIMATH POL */
int MakeSMPol (const char* pol, Tcl_DString* finalresult) 
{
   Tcl_DString *polptr = NULL; 
   Tcl_DString *result = NULL;
   int   templevel = 0, templen= 0, mm, nn, tempint;
   long  koeff = 1, koeff2;
   char  koeff_char[20];
   long  templong = 0;
   int   bodybegin, bodyend;
   char  *poltemp = NULL;
   char  *tempstr = NULL, *head = NULL, *tail = NULL;
   char  *bodyitem = NULL;
   struct SMif_polstruct polstruct = {0, NULL};
   struct SMif_polinfoitem *polinfoptr = NULL;
   SMif_chartable defaulttable = NULL;
   SMif_wordtable vartable = NULL;
   char ** varname = NULL;
   long *expolist=NULL;
   int result_first = 1, pol_first = 1;
   int withstar;
   char * tempvar = NULL;
   int varcount;
   int varbegin;
   struct SMif_wordlistitem *worditemptr=NULL;

   addchar (' ',&defaulttable);
   polptr = (Tcl_DString*) malloc (sizeof(Tcl_DString));
   result = (Tcl_DString*) malloc (sizeof(Tcl_DString));
   Tcl_DStringInit (result);
   poltemp = SMif_strtran (pol, "**", "^");

   /* check the pol string mult. with *? */
   /* '**' wird schon durch '^' ersetzt! */
   templen = strlen(poltemp);
   withstar = 0;
   for (mm = 0; mm < templen; mm++)
	  if (poltemp[mm] == '*') {
		 withstar = 1;
		 break;
	  }
   
   /* make variable-list */
   varbegin = -1;
   for (mm = 0; mm <= templen; mm++) {
	  if (varbegin != -1) 
		 if (withstar && !isalnum(poltemp[mm]) ||
			 !withstar && !isdigit(poltemp[mm]) ) {
			if (tempvar == NULL) free(tempvar);
			tempvar = SMif_substr(poltemp,varbegin,mm-varbegin);
			addword (tempvar, &vartable);
			varbegin = -1;
		 }
	  if (isalpha(poltemp[mm]) && varbegin == -1) 
		 varbegin = mm;
   }
   varcount = wordcount(vartable);
   varname = (char**) malloc (sizeof(char*)*varcount);
   expolist = (long*)malloc (sizeof(long)*varcount);
   for (mm=0; mm<varcount; mm++) expolist[mm] = 0;
   for (mm=0, worditemptr=vartable; worditemptr!=NULL ; 
			 worditemptr=worditemptr->next, mm++) {
	  varname[mm] = (char*)malloc(sizeof(char)*(strlen(worditemptr->SMifword)+1));
	  strcpy (varname[mm],worditemptr->SMifword);
   }

   
   SMif_getpolstruct (poltemp, &polstruct);
   if (polstruct.maxlevel < 0) 	return TCL_ERROR;

   while (polstruct.maxlevel > 0) {
	  for (polinfoptr = polstruct.polinfo; polinfoptr!=NULL &&
		   polinfoptr->locmaxlevel == 0; polinfoptr=polinfoptr->next) {
		 if (polinfoptr->to >= polinfoptr->from) {
			if (tempstr != NULL) free(tempstr);
			tempstr = SMif_substr(poltemp,polinfoptr->from,polinfoptr->to -
								   polinfoptr->from + 1);
			if (tempstr != NULL) {
			   if (!result_first && polinfoptr->negorpos == POSITIV)
				  (void)Tcl_DStringAppend (result,"+",1);
			   else if (polinfoptr->negorpos == NEGATIV)
				  (void)Tcl_DStringAppend (result,"-",1);
			   if (result_first) result_first = 0;
			   SMif_alltrim(tempstr,defaulttable);
			   (void)Tcl_DStringAppend (result,tempstr,-1);
			}
		 }
	  }
	  Tcl_DStringInit (polptr);
	  pol_first = 1;				 
	  for (; polinfoptr!=NULL; polinfoptr = polinfoptr->next) {
		 if (polinfoptr->to >= polinfoptr->from) {
			if (tempstr != NULL) free(tempstr);
			tempstr = SMif_substr(poltemp,polinfoptr->from,polinfoptr->to -
								  polinfoptr->from + 1);
			SMif_alltrim(tempstr,defaulttable);
			if (polinfoptr->locmaxlevel == 0 && strcmp(tempstr,"")!=0) {
			   if (polinfoptr->negorpos == POSITIV)
				  (void)Tcl_DStringAppend (polptr,"+",1);
			   else 
				  (void)Tcl_DStringAppend (polptr,"-",1);
			   Tcl_DStringAppend (polptr, tempstr, -1);
			}
			else {
			   templevel = 0;
			   if (polinfoptr->negorpos == NEGATIV)
				  koeff = -1;
			   else koeff = 1; 
			   templen = strlen(tempstr);
			   bodybegin = bodyend = 0;
			   for (mm = 0; mm < templen; mm++) {
				  if (tempstr[mm] == '(') {
					 templevel++;
					 if (templevel == 1) {
						if (head != NULL) free (head);
						head = SMif_substr(tempstr,0,mm);
						templong = atol (head);
						if (templong!=0)
						   koeff *= templong;
						else if (head[0] == '-')
						   koeff = 0 - koeff;
						for (nn = 0; nn == 0 && (head[nn] == '+' ||
							 head[nn] == '-') || nn < strlen(head) &&
							 isdigit(head[nn]); nn++)
						   head[nn] = ' ';
						SMif_alltrim(head,defaulttable);
						bodybegin = mm+1;
					 }
				  }
				  if (tempstr[mm] == ')') {
					 templevel --;
					 if (templevel == 0) {
						if (tail != NULL) free (tail);
						tail = SMif_substr(tempstr,mm+1,templen-mm-1);
						templong = atol(tail);
						if (templong!=0)
						   koeff *= templong;
						else if (tail[0] == '-')
						   koeff = 0 - koeff;
						for (nn = 0; nn == 0 && ( tail[nn] == '+' ||
							 tail[nn] == '-') || nn < strlen(tail) &&
							 isdigit(tail[nn]); nn++)
						   tail[nn] = ' ';
						SMif_alltrim(tail,defaulttable);
						bodyend = mm;
						break;
					 }                      
				  }                    
			   }              
			   tempint = bodybegin;
			   templevel = 0;
			   for (mm = bodybegin; mm <= bodyend; mm++) {
				  if (tempstr[mm] == '(') templevel++;
				  if (tempstr[mm] == ')') templevel--;
				  if ((tempstr[mm] == '+' || tempstr[mm] == '-') && templevel == 0 
					  && mm != bodybegin || mm == bodyend) {
					 if (bodyitem != NULL) free(bodyitem);
					 bodyitem = SMif_substr(tempstr,tempint,mm-tempint);
					 templong = atol(bodyitem);
					 if (templong!=0)
						koeff2 = templong * koeff;
					 else if (bodyitem[0] == '-')
						koeff2 = 0 - koeff;
					 else
						koeff2 = koeff;
					 for (nn = 0; nn == 0 && ( bodyitem[nn] == '+' ||
						  bodyitem[nn] == '-') || nn < strlen(bodyitem) &&
						  isdigit(bodyitem[nn]); nn++)
						bodyitem[nn] = ' ';
					 SMif_alltrim(bodyitem,defaulttable);
					 if (koeff2 > 0 && !pol_first)
						Tcl_DStringAppend(polptr,"+",1);
					 else if (koeff2 == -1)
						Tcl_DStringAppend(polptr,"-",1);
					 if (pol_first) pol_first = 0;
					 if (koeff2 != 1 && koeff2 != -1) {
						sprintf (koeff_char,"%ld",koeff2);
						SMif_alltrim(koeff_char,defaulttable);
						Tcl_DStringAppend(polptr,koeff_char,-1);
					 }
					 Tcl_DStringAppend(polptr,head,-1);
					 if (withstar && strcmp(head,"")!=0 && 
						 strcmp(bodyitem,"")!=0)
						Tcl_DStringAppend(polptr,"*",1);
					 Tcl_DStringAppend(polptr,bodyitem,-1);
					 if (withstar && strcmp(tail,"")!=0 &&
						 (strcmp(bodyitem,"")!=0 || strcmp(head,"")!=0))
						Tcl_DStringAppend(polptr,"*",1);
					 Tcl_DStringAppend(polptr,tail,-1);
					 tempint = mm;
				  }
			   }
			}   /* locmaxlevel = 1 , else */
		 } /* if ... */
	  } /* for (; ... */
	  if (poltemp != NULL) free (poltemp);
	  poltemp = (char*)malloc(sizeof(char)*(Tcl_DStringLength(polptr)+1));
	  strcpy (poltemp, Tcl_DStringValue(polptr));
	  Tcl_DStringFree (polptr);
	  SMif_getpolstruct (poltemp, &polstruct);
   }/* while */
		  
   if (!result_first && poltemp[0]!='-')
	  (void)Tcl_DStringAppend (result,"+",1);
   (void)Tcl_DStringAppend (result,poltemp,-1);
   if (poltemp != NULL) free (poltemp);
   poltemp = (char*)malloc(sizeof(char)*(Tcl_DStringLength(result)+1));
   strcpy (poltemp, Tcl_DStringValue(result)); /* sum of monomails */  
   Tcl_DStringFree (result);    
   SMif_getpolstruct (poltemp, &polstruct);
      
   /* final output */
   for (polinfoptr = polstruct.polinfo; polinfoptr!=NULL;
		polinfoptr=polinfoptr->next) {
	  if (tempstr!=NULL) free(tempstr);
	  tempstr = SMif_substr(poltemp,polinfoptr->from,
							polinfoptr->to-polinfoptr->from+1);
	  koeff = atol(tempstr);
	  if (koeff == 0) koeff = 1;
	  sprintf (koeff_char,"%ld",koeff);
	  SMif_alltrim(koeff_char,defaulttable);
	  if (polinfoptr == polstruct.polinfo) {
		 if (polinfoptr->negorpos == NEGATIV)
			Tcl_DStringAppend(finalresult,"-",1);
	  }
	  else {
		 if (polinfoptr->negorpos == NEGATIV)
			Tcl_DStringAppend(finalresult," - ",3);
		 else
			Tcl_DStringAppend(finalresult," + ",3);
	  }
	  Tcl_DStringAppend(finalresult,koeff_char,-1);
	  templen = strlen(tempstr);
	  templong = 0;
	  varbegin = 0;
	  for (mm=0; mm<varcount;mm++) expolist[mm] = 0;
	  mm = 0;
	  while ( mm < templen) {
		 for (;mm < templen && !isalpha(tempstr[mm]); mm++);
		 if ( mm >= templen) break;
		 varbegin = mm;
		 if (withstar) 
			for(;mm+1 < templen && isalnum(tempstr[mm+1]);mm++);
		 else
			for(;mm+1 < templen && isdigit(tempstr[mm+1]);mm++);
		 if (tempvar != NULL) free(tempvar);
		 tempvar = SMif_substr(tempstr,varbegin,mm-varbegin+1);
		 mm++;
		 if (tempstr[mm]!='^') templong = 1;
		 else {
			mm ++;
			templong = atol(tempstr+mm);
			if (templong == 0) templong = 1;
		 }
		 for(nn=0, worditemptr=vartable; worditemptr!=NULL ; 
			 worditemptr=worditemptr->next, nn++)
			if (strcmp(tempvar,worditemptr->SMifword)==0) {
			   expolist[nn] += templong;
			   break;
			}
	  }
	  /* output */
	  for (mm = 0; mm < varcount; mm++) {
		 Tcl_DStringAppend(finalresult,"*",1);
		 Tcl_DStringAppend(finalresult,varname[mm],-1);
		 Tcl_DStringAppend(finalresult,"^",1);
		 sprintf (koeff_char, "%ld",expolist[mm]);
		 SMif_alltrim(koeff_char,defaulttable);
		 Tcl_DStringAppend(finalresult,koeff_char,-1);
	  }
   }
   	
   if (poltemp != NULL) free (poltemp);
   poltemp = (char*)malloc(sizeof(char)*(Tcl_DStringLength(result)+1));
   strcpy (poltemp, Tcl_DStringValue(result)); /* sum of monomails */