program hm3 (input,output); {$I TYPES.PAS} {$P1} function smaller_int(x,y:integer):integer;forward; function larger_int (x,y:integer):integer;forward; const (* status codes -- even are BAD status, odd are good status *) ss_normal=1; (* good status return value *) ss_missing_var=2 ; ss_bad_variable=4; ss_zero_coef_start=6; line_size=80; number_of_polys =2; numofcol =59; col2 =513; col3 =512; col4 =475; col5 =190; col6 =106; col7 =70; col8 =52; col9 =42; col10 =35; col11 =30; col12 =27; col13 =24; col14 =22; col15 =21; col16 =19; col17 =18; col18 =17; col19 =17; col20 =16; col21 =15; col22 =15; col23 =14; col24 =14; col25 =14; col26 =13; col27 =13; col28 =13; col29 =12; col34 =11; col40 =11; col41 =10; col50 =10; col51 =9; col59 =9; total =2635; type expvtype = array [1..60] of integer; longinteger =integer; seqnumbers =longinteger; st =string[line_size]; sst =string[60]; coeftype =record enum :integer; deno :integer; end; s_vector = array [1..59] of longinteger; ptr_poly_type =^polytype; polytype = record coef : coeftype; seqn : longinteger; next : ptr_poly_type; back : ptr_poly_type; end; ptr_matrix_node =^matrix_node; matrix_node = record next :ptr_matrix_node; back :ptr_matrix_node; poly_head:ptr_poly_type; poly_tail:ptr_poly_type; end; header_type =array [1..number_of_polys] of ptr_poly_type; bictype =array [1..total] of longinteger; coltype =array [1..numofcol] of integer; convertype =array [1..numofcol] of integer; proc_name =string[20]; procedure simplify(var coef:coeftype);forward; procedure init_node (p:ptr_poly_type);forward; procedure make_result_node (VAR node :ptr_poly_type);forward; (*------------- G L O B A L S V A R I A B L E S --------------*) var confirm :boolean; debug: boolean; bicoef:bictype; convert:convertype; choice:char; (*********************************************************************) procedure error_handel( error_code:integer ;proc:proc_name ); begin writeln ('program TERMINATING due to the following error :'); case (error_code) of 1: writeln ('illegal coef encountered in proc:',proc); ss_missing_var: writeln ('illegal variables or missing in proc:',proc); end; HALT; (* oh dear.. *) end; (*******************************************************************) procedure fillcol(var col:coltype); var i:integer; begin col[1]:=0; col[2]:=col2; col[3]:=col3; col[4]:=col4; col[5]:=col5; col[6]:=col6; col[7]:=col7; col[8]:=col8; col[9]:=col9; col[10]:=col10; col[11]:=col11; col[12]:=col12; col[13]:=col13; col[14]:=col14; col[15]:=col15; col[16]:=col16; col[17]:=col17; for i:=18 to 19 do col[i]:=col18; col[20]:=col20; for i:=21 to 22 do col[i]:=col21; for i:=23 to 25 do col[i]:=col23; for i:=26 to 28 do col[i]:=col26; for i:=29 to 33 do col[i]:=col29; for i:=34 to 40 do col[i]:=col34; for i:=41 to 50 do col[i]:=col41; for i:=51 to 59 do col[i]:=col51; end; (*******************************************************************) procedure fillconvert( var col:coltype ); var i:integer; begin convert[1]:=0; for i:=2 to numofcol do convert[i]:=convert[i-1]+col[i]; end; (*******************************************************************) function onedim( i,j:integer ):integer; begin onedim:= i+convert[j-1]; end; (******************************************************************) procedure fillbicoef; var col:coltype; il :longinteger; j,k :integer; begin fillcol(col); fillconvert(col); bicoef[1]:=0; for il:=2 to col[2] do bicoef[il]:=bicoef[il-1]+il-1; for j:=3 to numofcol do begin k:=onedim( 1 ,j ); bicoef[k]:=0; for il:=2 to col[j] do begin k:=onedim( il ,j ); bicoef[k]:=bicoef[k-1]+bicoef[onedim( il ,j-1 ) ]; end; end; end; (********************************************************************) procedure init(var str:st); var i:integer; begin if debug then writeln ('enter init'); for i:=1 to line_size do str[i]:=' '; if debug then writeln ('levae init'); end; (********************************************************************) function power(num,i :integer):integer; var k:integer; result: integer; begin if debug then writeln('enter power num is=',num,'power to rais=',i); if (i=0) then result:=1 else begin result:=1; for k:=1 to i do result := result* num; end; IF DEBUG THEN WRITELN ('in power result=',result); power:=result; if debug then writeln('leave power'); end; (********************************************************************) function switch(st1:char):integer; begin switch :=ord(st1)-ord('0'); end; (********************************************************************) procedure substr(var str1 :st (* function returns portion of string*) ;len:integer ;from :integer ;num :integer ); var k,i:integer; str2: st; dbg:integer; begin if debug then writeln('enter substr'); init(str2); if debug then writeln (' in substr str2=',str2); if debug then writeln (' length of str1=',len); if debug then begin for i:=1 to len do write(str1[i]); end; k:=1; if debug then writeln (' in sunbsrt new is---'); for i:=from to (from+num-1) do begin str2[k]:=str1[i]; if debug then write(str2[k]); k:=k+1; end; k:=k-1; if debug then writeln ('length of final str is--=',k); init (str1); for i:=1 to k do str1[i]:=str2[i]; if debug then writeln('leave substr'); if debug then writeln (' in substr befoe leav str1='); if debug then begin writeln (' k=',k); for dbg:=1 to k do write (str1[dbg]); end; end; (********************************************************************) function char_to_num (var st1:st ;len:integer ):integer; var i,num,diff,r1,r2,wight: integer; ch: char; dbg :integer; begin if debug then begin writeln(' enter char_to_num str='); for dbg:=1 to len do write(st1[dbg]); end; if debug then writeln ('in char to num the len=',len); num:=0; i:=0; r1:=ord('0'); while (i 1 do begin result :=bicoef[onedim(i-j+2,j)]; if debug then writeln ('result=',result); while result < seqn do begin i:=i+1; result :=bicoef[onedim(i-j+2,j)]; if debug then writeln ('result so far=',result); end; i:=i-1; result:=bicoef[onedim(i-j+2,j)]; s[j]:=i; if debug then writeln ('j so far=',j,' s[j]=',s[j]); if debug then writeln ('result so far=',result); seqn:=seqn-result; if debug then writeln ('seqn so far=',seqn); j:=j-1; i:=j-1; end; s[1]:=seqn-1; if debug then writeln ('s[1]=',s[1]); if debug then writeln ('in expovector after while j>0 '); expv[1]:=s[1]; for j:=2 to varnum do expv[j]:=s[j]-(s[j-1]+1); if debug then writeln (' befor levaing expovecotr expv[] is='); if debug then begin for dbg:=1 to varnum do write(expv[dbg]); writeln; end; end; (********************************************************************) procedure getmono(poly :st (* the poly to extract from *) ;var lenpoly :integer ;var lenmono: integer (* fill in length of extracted mono*) ;var pos :integer (* starting from this char *) ;var more_mono:boolean (* indicates if need to call again *) ;var mono:st ;var negative:boolean ); var counter,monox,polyx:integer; first_mono: boolean; dbg1:integer; adjusting:boolean; begin adjusting:=false; if debug then writeln ('enter getmono'); monox:=1; if (pos>1) then begin if debug then writeln ('looking for NEGATIVE ',poly[pos-1]); if poly[pos-1]='-' then negative:=true else if poly[pos-1]='+' then negative:=false; if debug then writeln('not first monimal'); counter:=pos-1; (* if this not first time around*) (* save pos befor scaning this mono*) (* take one off since adjusting *) first_mono:=false; end else begin if poly[1]='-' then begin negative:=true; pos:=pos+1; adjusting:=true; end else begin if poly[1]='+' then begin negative:=false; pos:=pos+1; adjusting:=true; end else negative:=false end; first_mono:=true; end; if debug then writeln('pos so far beforr while loop in get mon=',pos); while (pos <= lenpoly) and (poly[pos]<>'+') and (poly[pos]<>'-') do begin mono[monox]:=poly[pos]; (* make a monomial *) monox:=monox+1; pos:=pos+1; if debug then writeln ('pos so far inside loop=',pos); end; pos:=pos-1; if (first_mono=false) then lenmono:=pos-counter else begin if (adjusting=true) then lenmono:=pos-1 else lenmono:=pos; end; monox:=monox-1; if (pos=lenpoly) then more_mono:=false else pos:=pos+2; (* skip over + or - *) if debug then writeln ('leave mono JUST BEFOR**'); If debug then writeln ('lenmono =',lenmono); if debug then begin for dbg1:=1 to lenmono do write(mono[dbg1]); end; if debug then begin if (negative=true) then writeln('in getmono it was negative coef') else writeln(' in getmono it was found positive coef'); end; end; (****************************************************************) function extract_coeff (node :ptr_poly_type ;var mono :st ;var lenmono :integer ;from_here:integer ):integer; var saved_mono :st; cut,i,j :integer; temp:st; deb:integer; dbg:integer; status:integer; label 1; begin status := ss_normal; if debug then writeln ('enter extract coef '); if debug then writeln ('length mono initialy=',lenmono); if debug then begin writeln (' the MONOIMAL BEFOR STARTIN TO WORK AT IS'); for deb:=from_here to lenmono do write(mono[deb]); end; init(saved_mono); init(temp); for deb:=from_here to lenmono do saved_mono[deb]:=mono[deb]; if debug then writeln (' in extrac saved mono THIS HAS TO SHOW='); if debug then begin for deb:=1 to lenmono do write (saved_mono[deb]); end; i:=from_here; while saved_mono[i] in ['0'..'9'] do begin temp[i]:=saved_mono[i]; i:=i+1; end ; i:=i-1; cut:=i; if debug then writeln ('i so far =',i); node^.coef.enum :=char_to_num(temp,i); if (saved_mono[i+1] ='/') then begin if debug then writeln ('just seen / in extrac coef'); i:=i+2; (* skip over / *) cut:=cut+2; j:=1; WHILE saved_mono[i] in ['0'..'9'] do begin temp[j]:=saved_mono[i]; j:=j+1; i:=i+1; END; j:=j-1; i:=i-1; cut:=cut+j-1; node^.coef.deno := char_to_num(temp,j) END else node^.coef.deno :=1; if debug then writeln (' in extrac coef befor calling substr'); if debug then writeln ('i=',i); if debug then writeln ('befor calling subtr mono='); if debug then begin for deb:=1 to lenmono do write (saved_mono[deb]); end ; if debug then writeln (' in extract saved mono is '); if debug then begin for deb:=1 to lenmono do write (saved_mono[deb]); end; substr(saved_mono ,lenmono ,i+1 ,lenmono-i ); if debug then writeln ('original length of mono=',lenmono); lenmono:=lenmono-cut; if debug then writeln('after cut it is=',lenmono); if debug then writeln('length mon finaly SEE THIS=',lenmono); if debug then begin writeln('new mono='); for deb:=1 to lenmono do write (saved_mono[deb]); writeln; end; init(mono); for dbg:=1 to lenmono do mono[dbg]:=saved_mono[dbg]; if debug then writeln ('leave extract coef '); 1:extract_coeff:=status; end; (***************************************************************) function gcd(x,y: integer):integer; var reminder,t:integer; begin if debug then writeln ('in gcd x=',x,' y=',y); t:=smaller_int (x,y); x:=larger_int (x,y); y:=t; if debug then writeln ('befor remider x=',x,'y',y); reminder:=x mod y; WHILE reminder <>0 do begin x:=y; y:=reminder; reminder:=x mod y; end; gcd:=y; if debug then writeln ('in gcd=',y); end; (********************************************************************) function make_exp_vector (node:ptr_poly_type ;var mono :st ;lenmono :integer ;var variables:sst ;n_variables:integer ;var exp:expvtype ;negative :boolean ):integer; var monox,j,k,t,polyx,expo_st_index,counter: integer; ch: char; temp: st; p,i:integer; dbg : integer; status:integer; label 1; begin status:=ss_normal; i:=1; if debug then writeln ('enter make_exp_vector'); IF mono[i]='0' then begin status:=ss_zero_coef_start; goto 1; END; IF mono[i] in ['1'..'9'] then begin status:=extract_coeff (node (* after this call mono contains*) ,mono (* terms with coeff out *) ,lenmono ,i ); IF status <> ss_normal then goto 1; END ELSE begin node^.coef.enum:=1; node^.coef.deno:=1; END; if debug then writeln('befor tetsing for lenmono in make_exp_ve'); IF lenmono=0 then begin status:=ss_missing_var; goto 1; END; IF negative=true then node^.coef.enum:=-1*node^.coef.enum; if debug then begin writeln('after extract_coeff the mono='); for p:=1 to lenmono do write(mono[p]); writeln; writeln('new len=',lenmono); end; j:=1; WHILE j<= lenmono do begin (* scan the monomial *) IF debug then writeln('scanning monial j=',j); k:=1; WHILE (variables[k]<>mono[j]) and (k <= n_variables) do k:=k+1; if debug then writeln('position in expo vector is=',k); if debug then writeln('after while loop j======',j); IF k>n_variables then begin status:=ss_bad_variable; goto 1; END ELSE begin if debug then writeln (' in make exp vect lenmono=',lenmono) ; if debug then writeln (' j so far=',j); IF (j=lenmono) then begin if debug then writeln ('j=lenmono j is =',j); exp[k]:=1; j:=j+1; END ELSE begin if debug then writeln (' befor if not mono[j+1] j=',j); IF not (mono[j+1] in ['1'..'9']) then begin exp[k] :=1 ; j:=j+1; if debug then writeln('scannib mon j=',j); END ELSE begin (* ie variable has is raised *) (*get the power of the variable*) if debug then writeln ('it is raised------j=',j); t:=j+1; counter:=1; init(temp); if debug then writeln ('in make exp vector t=',t,'mono[j]= ',mono[t-1]); WHILE (mono[t] in ['0'..'9']) and (t <= lenmono) do begin if debug then writeln ('i just found mor power it is mono[t]',mono[t]); temp[counter]:=mono[t]; counter:=counter+1; t :=t+1; END; counter:=counter-1; t:=t-1; if debug then writeln ('counter=',counter,'t=',t); if debug then writeln ('in make exp vactor befor calling char to num'); if debug then begin writeln ('the power string temp is counter=',counter) ;for dbg:=1 to counter do write(temp[dbg]) ; writeln; END; if debug then writeln ('counter=',counter); exp[k]:= char_to_num(temp,counter); j:=t+1; (* jump over to new position*) if debug then writeln('scanning j=',j); END; END; END; END; (* while *) if debug then writeln ('leave make_exp_vector'); 1: make_exp_vector:=status; end; (********************************************************************) procedure insert_befor(mark,newnode:ptr_poly_type); begin if debug then writeln (' in insert_befor'); mark^.back^.next:=newnode; mark^.back^.next^.next:= mark; mark^.back^.next^.back:= mark^.back; mark^.back:= mark^.back^.next; end; (*********************************************************************) procedure insert_at_end (newnode:ptr_poly_type ;var mark :ptr_poly_type ); begin if debug then writeln (' in insert_at end '); mark^.next:=newnode; mark^.next^.back:=mark; end; (********************************************************************) procedure allign_node( current_node:ptr_poly_type ;var head:ptr_poly_type ;var tail:ptr_poly_type ); var mark:ptr_poly_type; procedure insert_at_head; begin if debug then writeln (' in insert at head'); head:=current_node; head^.next:=mark; mark^.back:=head; end; begin if debug then writeln (' in allign'); mark:=head; IF mark=nil then head:=current_node ELSE BEGIN (* start scanning *) WHILE (mark^.next <> nil) AND (mark^.seqn >= current_node^.seqn) DO mark:=mark^.next; IF mark^.next=nil THEN if mark^.seqn >= current_node^.seqn then insert_at_end (current_node,mark) else if mark=head then insert_at_head else insert_befor(mark,current_node) else if mark=head then insert_at_head else insert_befor (mark,current_node) END; end; (********************************************************************) function get_poly ( var head: ptr_poly_type ; var tail: ptr_poly_type ;n_variables :integer ;variables :sst ):integer; var poly :st; mono :st; pos : integer; more_monomials : boolean; counter : integer; lenmono,lenpoly :integer; temp :integer; current_node: ptr_poly_type; negative:boolean; exp:expvtype; status:integer; label 1; (* common exit from procedure -- one good use of GOTO ! *) begin status:=ss_normal; if debug then writeln ('enter process poly'); pos :=1; head:=nil; tail:=head; readln (poly); lenpoly:=length(poly); if debug then writeln ('LENGTH of poly=',lenpoly); IF (lenpoly >= 1) then begin (* ie we have an input *) more_monomials :=true; WHILE more_monomials do begin getmono(poly ,lenpoly ,lenmono ,pos ,more_monomials ,mono ,negative ); if debug then begin writeln('after back from getmono'); writeln('length of mono=',lenmono); writeln('length of poly=',lenpoly); writeln('the poly is='); for temp:=1 to lenpoly do write(poly[temp]); writeln; writeln('extracted mono='); for temp:=1 to lenmono do write (mono[temp]); writeln; writeln('pos=',pos); end; FOR counter:=1 to 60 do exp[counter]:=0; new(current_node); (* get storage for monomial *) current_node^.next:=nil; current_node^.back:=nil; status := make_exp_vector(current_node ,mono ,lenmono ,variables ,n_variables ,exp ,negative ); IF status <> ss_normal then goto 1; if debug then writeln('befor calling sequence num'); current_node^.seqn:=sequence_num(exp ,n_variables ); if debug then writeln('after senumber=',current_node^.seqn); allign_node(current_node ,head ,tail ); (* insert in increasing order*) END; (* while *) END (* if *) ELSE begin head:=nil; tail:=nil; END; if debug then writeln ('leave process poly'); 1: get_poly:=status; end; (**************************************************************) procedure multiply_coef(var coef1,coef2,result_coef :coeftype); begin simplify(coef1); simplify(coef2); result_coef.enum:=coef1.enum * coef2.enum; result_coef.deno:=coef1.deno * coef2.deno; simplify(result_coef); end; (*******************************************************************) procedure add_vectors (var vector1,vector2,result_vector:expvtype ;n_variables :integer ); var i:integer; begin for i:=1 to n_variables do result_vector[i]:=vector1[i]+vector2[i]; end; (*****************************************************************) procedure add_expo (seqn1,seqn2:longinteger ;var result_seqn :longinteger ;n_variables :integer ); var s1,s2,s_result: expvtype; begin expvector (seqn1 ,n_variables ,s1 ); expvector (seqn2 ,n_variables ,s2 ); add_vectors(s1 ,s2 ,s_result ,n_variables ); result_seqn:=sequence_num(s_result ,n_variables ); end; (*****************************************************) procedure mulpoly(heads1,heads2: ptr_poly_type ;var result:ptr_poly_type ;n_variables :integer ); var mark1,mark2,result_mark :ptr_poly_type; begin mark1:=heads1; mark2:=heads2; new(result); result_mark:=result; init_node(result); while (mark1<>nil) do begin while (mark2<>nil) do begin multiply_coef(mark1^.coef ,mark2^.coef ,result_mark^.coef ); add_expo(mark1^.seqn ,mark2^.seqn ,result_mark^.seqn ,n_variables ); make_result_node(result_mark); mark2:=mark2^.next; end; mark2:=heads2; (* rewind *) mark1:=mark1^.next; end; result_mark^.back^.next:=nil; dispose(result_mark); end; (***************************************************************) procedure display_expv(seqn:longinteger ;n_variables:integer ;variables:sst ); var s:expvtype; j:integer; dbg:integer; begin if debug then writeln (' in display expv seqn befor caling expve =',seqn); if debug then begin writeln ('n_variables befor calling expvecot =',n_variables); end; expvector(seqn ,n_variables ,s ); if debug then writeln ('in display_expv after calling expvecotr'); if debug then writeln ('in display_expv n_variables=',n_variables); if debug then begin writeln ('kludge display of variables'); for dbg:=1 to n_variables do write (s[dbg]); end; if debug then writeln ('finished kludge'); j:=1; while j <= n_variables do begin if s[j]<>0 then begin write(variables[j]); (* the variable *) if s[j]<>1 then write(s[j]); (* type other than exponent 1 *) end; j:=j+1; end; if debug then writeln (' leaving display expv'); end; (******************************************************************) function abs(n:integer):integer; begin if n<0 then abs:=-1*n else abs:=n; end; (***************************************************************) procedure simplify; (* (var coef:coeftype); *) var common:integer; deno_,enum_:integer ; temp:integer; begin if (coef.deno=0) then error_handel(1,'simplify'); deno_ :=abs(coef.deno); enum_ :=abs(coef.enum); IF deno_=enum_ then begin coef.deno:=1; if (coef.enum<1) then coef.enum:=-1 else coef.enum:=1; END ELSE begin temp:=abs(coef.deno); if debug then writeln (' in simplify'); if debug then writeln('befor calling gcd coef.enum=',coef.enum); if debug then writeln('befor calling gcd coef.deno=',coef.deno); IF temp <> 1 then begin common:= gcd(coef.enum,coef.deno); if debug then writeln ('after coef.enum=',coef.enum); if debug then writeln ('after coef.deno=',coef.deno); if debug then writeln ('common =dc=gcd is ',common); if common <>1 then begin coef.enum:=coef.enum div common; coef.deno:=coef.deno div common; END; END; END; end; (*****************************************************************) procedure print_node (node:ptr_poly_type ;n_variables:integer ;var variables:sst ); var temp:integer; begin temp:=abs(node^.coef.deno); if temp<>1 then begin write('('); write(abs(node^.coef.enum)); write('/'); write(abs(node^.coef.deno)); write(')'); end else begin temp:=abs(node^.coef.enum); if temp<>1 then write(abs(node^.coef.enum)); end; display_expv(node^.seqn ,n_variables ,variables ); (* display the monomial from seqn *) end; (****************************************************************) procedure display (RESULT : ptr_poly_type ;n_variables:integer ;var variables :sst ); var dbg :integer; result_mark :ptr_poly_type; no_terms :boolean; begin no_terms:=true; result_mark:=result; dbg:=0; if debug then writeln (' in display'); WHILE result_mark^.coef.enum=0 do result_mark:=result_mark^.next; IF result_mark <>nil then begin no_terms:=false; if(result_mark^.coef.enum > 0) then if (result_mark^.coef.deno<0) then write(' - '); if (result_mark^.coef.enum <0) then write(' - '); print_node(result_mark,n_variables,variables); result_mark:=result_mark^.next; END; WHILE result_mark<> nil do begin IF result_mark^.coef.enum=0 then write('0') ELSE begin if(result_mark^.coef.enum > 0) then if (result_mark^.coef.deno<0) then write(' - ') else write(' + ') else if (result_mark^.coef.enum <0) then write(' - '); print_node(result_mark,n_variables,variables); END; result_mark:=result_mark^.next; END; (* while *) IF no_terms=true then write('0'); writeln; end; (*****************************************************************) procedure addcoef (var c1,c2:coeftype ; var result:coeftype ); var common_deno:integer; (* common denomuator *) begin if debug then writeln (' in addcoef'); if debug then writeln (' in addcoef c1.enum=',c1.enum,' c2.enum=',c2.enum); simplify(c1); simplify(c2); result.deno:=c1.deno*c2.deno; result.enum:= ((result.deno div c1.deno)*c1.enum) +((result.deno div c2.deno)*c2.enum); if debug then writeln('result.deno=',result.deno); if debug then writeln ('result.enum=',result.enum); if debug then writeln ('in addcoef befor calling simplify'); IF result.enum <>0 then simplify(result); if debug then writeln ('in addcpef after simplify result.enum=',result.enum); if debug then writeln (' same as above butr result.deno=',result.deno); end; (*****************************************************************) function same(seqn1,seqn2 :longinteger):boolean; begin if seqn1=seqn2 then same:=true else same:=false; if debug then writeln(' in same seqn1=',seqn1,' seqn2=',seqn2); end; (**************************************************************) procedure add_to_end(tail,dumy:ptr_poly_type); begin if debug then writeln (' in add to end'); tail^.next:=dumy ; tail^.next^.next:=nil; end; (***************************************************************) procedure init_node ; (* (p:ptr_poly_type); *) begin if debug then writeln ('in init node'); p^.next:=nil; p^.back:=nil; p^.seqn:=0; p^.coef.enum:=0; p^.coef.deno:=0; end; (**************************************************************) function smaller(seqn1,seqn2 :longinteger): boolean; begin if seqn1seqn2 then greater:=true else greater:=false; if debug then writeln (' seqn1=',seqn1,' seqn2=',seqn2); end; (***************************************************************) function smaller_int ; (* (x,y:integer):integer; *) begin if debug then writeln ('in smaller_int'); if x nil do begin if debug then writeln (' after loop in addpoly mark2 finsihed first'); result_mark^:=mark1^; simplify(result_mark^.coef); mark1:=mark1^.next; make_result_node(result_mark); end; end ELSE begin WHILE mark2<> nil do begin if debug then writeln ('after loop in addpoly mark1 finished first'); result_mark^:=mark2^; simplify(result_mark^.coef); mark2:= mark2^.next; make_result_node(result_mark); end; end; result_mark^.back^.next:=nil; dispose(result_mark); if debug then writeln(' leaving addpoly'); end; (**************************************************************) procedure get_info(var n_variables:integer ;var variables:sst ); var ch:char; i:integer; k:integer; bad:boolean; begin n_variables:=0; REPEAT write ('number of variables ='); readln (n_variables); UNTIL n_variables <>0; REPEAT bad:=false; REPEAT write ('your variables please ='); readln(variables); if (length(variables) <> n_variables) then begin writeln('number of variables inputed dont match that you indicated'); writeln('please Ecorrect . starting input again'); end; UNTIL (length(variables) = n_variables); k:=1; i:=length(variables); WHILE (k<=i) and (bad=false) do begin ch:=variables[k]; if not ((ch in ['a'..'z']) or (ch in ['A'..'Z'])) then begin writeln('not allowed char inputed as variable input again'); bad:=true; END; k:=k+1; END; UNTIL bad=false; end; (***************************************************************) procedure simplify_list (node:ptr_poly_type); var mark1_node,mark2_node :ptr_poly_type; temp:ptr_poly_type; BEGIN mark1_node:=node; mark2_node:=node^.next; WHILE mark1_node<> nil do begin WHILE mark2_node <> nil do begin IF mark1_node^.seqn=mark2_node^.seqn then begin addcoef(mark1_node^.coef , mark2_node^.coef , mark1_node^.coef ); mark2_node^.back^.next:=mark2_node^.next; IF mark2_node^.next <> nil then mark2_node^.next^.back:=mark2_node^.back; temp:=mark2_node; mark2_node:=mark2_node^.next; dispose(temp) END ELSE mark2_node:=mark2_node^.next; END; mark1_node:=mark1_node^.next; mark2_node:=mark1_node^.next; (* very important REWIND it *) END; end; (***************************************************************) procedure free_poly(node:ptr_poly_type); var t:ptr_poly_type; begin t:=node; WHILE node<>nil do begin node:=node^.next; DISPOSE(t); (* watch this area later *) t:=node; END; end; (******************************************************) procedure addp; var choice : char; i:integer; heads,tails : header_type; more:boolean; dbg1,dbg2:integer; result_poly_add : ptr_poly_type; dbg3:ptr_poly_type; n_variables:integer; variables:sst; status:integer; label 30; begin more:=true; get_info(n_variables,variables); i:=0; REPEAT REPEAT i:= i+1; 30: heads[i]:=nil; write('Poly ',i,' ?> '); status:=get_poly ( heads[i] ,tails[i] ,n_variables ,variables ); IF status<>ss_normal then begin writeln('Bad input Poly was not parsed please try again'); goto 30; END; IF heads[i]=nil then begin writeln('you have inputed no polynomial'); i:=i-1; END ELSE begin simplify_list(heads[i]); IF (confirm=true) then begin write('Confirm > '); display(heads[i] ,n_variables ,variables ); END; END; UNTIL i=2; result_poly_add:=nil; addpoly(heads[1] ,heads[2] ,result_poly_add ); IF result_poly_add <> nil then begin simplify_list(result_poly_add); write('Result > '); display(result_poly_add ,n_variables ,variables ); END; write('Do you want to ADD to this result [y/n] ? > '); readln(choice); IF (choice='n') or (choice='n') then begin write('do you like to add 2 new polys [y/n] ? > '); readln (choice) ; IF (choice='y') or (choice='Y') then i:=0 ELSE more:=false; END ELSE begin i:=1; free_poly(heads[i]); heads[i]:=result_poly_add; END; UNTIL (morE=false); FOR i:=1 to 2 do free_poly(heads[i]); end; (*******************************************************************) procedure mulp; var i:integer; heads,tails : header_type; more:boolean; dbg1,dbg2:integer; result_poly_mul : ptr_poly_type; dbg3:ptr_poly_type; n_variables:integer; variables:sst; status:integer; choice:char; label 10; begin status:=ss_normal; more:=true; get_info(n_variables,variables); i:=0; REPEAT REPEAT i:= i+1; 10: write('Poly ',i,' ?> '); heads[i]:=nil; tails[i]:=nil; status:=get_poly ( heads[i] ,tails[i] ,n_variables ,variables ); IF status<>ss_normal then begin writeln('Bad input Poly was not parsed please try again'); goto 10; END; IF heads[i]=nil then begin writeln('you have inputed no polynomial'); i:=i-1; END ELSE begin simplify_list(heads[i]); IF (confirm=true) then begin write('Confirm > '); display(heads[i] ,n_variables ,variables ); END; END; UNTIL i=2; mulpoly(heads[1] ,heads[2] ,result_poly_mul ,n_variables ); if result_poly_mul <> nil then begin simplify_list(result_poly_mul); write('Result > '); display(result_poly_mul ,n_variables ,variables ); END; write('Do you want to MULTIPLY this result [y/n] ? > '); readln(choice); IF (choice='n') or (choice='n') then begin write('do you like to multilpy 2 new polys [y/n] ? > '); readln (choice) ; IF (choice='y') or (choice='Y') then i:=0 ELSE more:=false; END ELSE begin i:=1; free_poly(heads[i]); heads[i]:=result_poly_mul; END; UNTIL (more=false); FOR i:=1 to 2 do free_poly(heads[i]); end; (********************************************************************) procedure free_matrix(VAR node:ptr_matrix_node); (* used to release memory *) var mark,m1:ptr_matrix_node; mark1,t1:ptr_poly_type; begin mark:=node; WHILE mark<> nil do begin mark1:=mark^.poly_head; free_poly(mark1); m1:=mark; mark:=mark^.next; DISPOSE(m1); END; end; (*********************************************************************) {$I mulmatric.pas} (**********************************************************************) procedure addmatric; VAR nrow,ncol:integer; matrix_ :ptr_matrix_node; i,k:integer; nmatrix:integer; matrix_heads :array [1..2] of ptr_matrix_node; matrix_marker:ptr_matrix_node; n_variables:integer; variables :sst; result,result_marker:ptr_matrix_node; mark1,mark2: ptr_matrix_node; choice:char; more: boolean; status: integer; label 10; begin status:=ss_normal; more:=true; get_info(n_variables,variables); nmatrix:=0; nrow:=0; ncol:=0; REPEAT write('number of rows ? > '); readln(nrow); UNTIL nrow<>0; REPEAT write('number of coloums ? > '); readln(ncol); UNTIL ncol <>0; REPEAT REPEAT nmatrix:=nmatrix+1; new(matrix_heads[nmatrix]); matrix_marker:=matrix_heads[nmatrix]; FOR i:=1 to nrow do begin FOR k:=1 to ncol do begin 10: write('marix',nmatrix,' (',i,',',k,') ? >'); if debug then writeln('befor get_poly in add marti'); STATUS:=get_poly (matrix_marker^.poly_head ,matrix_marker^.poly_tail ,n_variables ,variables ); IF status<>ss_normal then begin writeln('Bad input Poly was not parsed please try again'); goto 10; END; if debug then writeln('befor simplify call in add mat'); simplify_list(matrix_marker^.poly_head); IF (confirm=true) then begin write('Confirm > '); display(matrix_marker^.poly_head ,n_variables ,variables ); END; NEW(matrix_marker^.next); matrix_marker^.next^.back:=matrix_marker; matrix_marker:=matrix_marker^.next; matrix_marker^.next:=nil; END; END; matrix_marker^.back^.next:=nil; dispose(matrix_marker); (* get rid of last node *) UNTIL nmatrix=2; NEW(result); result_marker:=result; mark1:=matrix_heads[1]; mark2:=matrix_heads[2]; FOR i:=1 to nrow do begin FOR k:=1 to ncol do begin write('Result matrix (',i,',',k,') > '); IF not((mark1^.poly_head=nil) and (mark2^.poly_head=nil)) then begin addpoly(mark1^.poly_head ,mark2^.poly_head , result_marker^.poly_head ); display(result_marker^.poly_head ,n_variables ,variables ); END ELSE begin result_marker^.poly_head:=nil; writeln('0'); END; mark1:=mark1^.next; mark2:=mark2^.next; NEW(result_marker^.next); result_marker^.next^.back:=result_marker; result_marker:=result_marker^.next; result_marker^.next:=nil; END; END; write('Do you want to ADD to this matrix [y/n] ? > '); readln(choice); IF (choice='n') or (choice='n') then begin write('do you like to ADD 2 new MATRIX [y/n] ? > '); readln (choice) ; IF (choice='y') or (choice='Y') then begin FOR i:=1 to 2 do free_matrix(matrix_heads[i]); nmatrix:=0 END ELSE more:=false; END ELSE begin nmatrix:=1; free_matrix(matrix_heads[nmatrix]); matrix_heads[nmatrix]:=result; END; UNTIL (more=false); FOR i:=1 to 2 do free_matrix(matrix_heads[i]); end; (*********************************************************************) procedure determinant; begin writeln('in determinant'); end; (********************************************************************) procedure set_up; var choice:char; begin write('Would you like computer to confirm your input [y/n] ? >'); readln(choice); if (choice='y') or (choice='Y') then confirm:=true; end; (*******************************************************************) begin debug:=false; confirm:=false; writeln(' -- Project for CSE 542 Data Structure '); writeln(' -- Author naser abbasi '); writeln(' -- OAKLAND University ,MI '); writeln('this program performs algebric manipulations '); writeln('on Multivariant polynomials up to 59 variables'); writeln; fillbicoef; (* the bicoef to fill *) (* convert is filled too *) writeln('please choose from menue'); writeln('A. Addition of two polynomials'); writeln('B. Multiplications of two polynomials'); writeln('C. Addition of two matrices of polynomials'); writeln('D. Multiplications of two matrices of polynomials'); writeln('E. Determinant of a polynomiale matrix'); writeln('F. Set up parameters'); writeln('Q. Quit'); writeln; write('Menue Choice ?> '); readln(choice); WHILE (choice <>'q') and (choice<>'Q') DO BEGIN CASE (choice) of 'A','a' : addp; 'B','b' : mulp; 'C','c' : addmatric; 'D','d' : mulmatric; 'E','e' : determinant; 'F','f' : set_up; END; writeln; write('Menue Choice ?> '); readln(choice); END; write('Logging Off...'); end.