program hermit(input,output); {Prak5.pas} { Berechnung der Hermitschen Polynome , von Rene' Scholz } uses crt; type Zeichen = set of char; var erg,polynom,st1 : string; Grad : integer; Numbers,Produkts,trset : Zeichen; {--------------------------------------------------------------------------} function rekstr(n:integer) :string; function rs(n:integer):string; var s :string; begin if (n>1) then begin str(2*n-2,s); rs:= '(' + '2*x' + '*' + rs(n-1) + '-' + s + '*' + rs(n-2) + ')' ; end else if (n=0) or (n=1) then begin if n=0 then rs:='1' ; if n=1 then rs:='2*x'; end; if (n<0) then rs:='' end; { of rs ,unterfunction } var hs: string; begin { of Rekstr } hs:=rs(n); if (n=0) or (n=1) then hs:= '(' + hs + ')'; rekstr:=hs; end; { of rekstr } procedure del_spaces( var e:string); { loeschen aller Leerzeichen in e bis '!' erreicht ist } var i: integer; begin i:=1; repeat if e[i]=' ' then begin delete(e,i,1); i:=i-1; end; i:=i+1; until e[i]='!'; end; function lies_zahl( e:string ; Zahl_anfang:integer ):string; { liest ab Zahl_anfang alle folgenden Ziffern in einen String ein } var i :integer; begin i:=Zahl_anfang; while e[i] in Numbers do i:=i+1; lies_zahl:=copy( e , Zahl_anfang , i - Zahl_anfang); end; procedure loesch_zahl( var e:string ;beginn,ende :integer); { loescht alle Ziffern von beginn bis ende mit Spaces } var i :integer; begin for i:=beginn to ende do e[i]:=' '; end; {----------------- soweit alles o.k. --------------------} function kuerze_produkt(var e:string ;pa:integer) :integer; { verkuerzt string e ab pa=produktanfang ; gibt position des naechsten moeglichen produkts zurÜck, das aber schon zum naechsten Ausdruck gehoeren kann , z.B. ')' '-' '+' '(' } var i,pe,az,zahl :integer; {pe: Potenz_ende} power,error,kp :integer; hz,xpot :string; mal :boolean; begin i :=pa; Zahl :=1; hz :=''; xpot :=''; power :=0; mal :=false; while e[i] in Produkts do i:=i+1; pe:=i-1; { Ermittlung des Endes des produkts } if e[pe]='*' then begin pe:=pe-1; { Malzeichen vor Klammer soll bleiben } mal:=true; end; for i:=pa to pe do if e[i]='x' then begin power:=power+1; e[i]:=' '; e[i-1]:=' '; { Loeschen von '*x' } end; { Ermittlung Anzahl von x --> Potenz von x } i:=pa; repeat { Ermittlung des Faktors im Produkt der durch '*' getrennten Zahlen} hz:=lies_zahl(e,i); loesch_zahl(e,i,i+length(hz) - 1 ); {die Zahl hz loeschen } val(hz,az,error); Zahl:=Zahl*az; { Hier Aufrechnen des Faktors } i:=i+length(hz) ; while (not (e[i] in Numbers)) and (i<=pe) do i:=i+1; {naechste zahl in Produkt suchen} if (e[i]='*') and (i<=pe) then i:=i+1; if e[i-1]='*' then loesch_zahl(e,i-1,1); until (not(e[i] in Numbers)) or (i>pe); str(Zahl,hz); {hz wird der string von Zahl} if (power>0) then for i:=1 to power { auf der VAX : Pad ! } do xpot:=xpot + 'x'; {x^n --> x...x (n-mal) } delete(e,pa,pe-pa+1); {ganzes Produkt loeschen} if (xpot<>'') then insert(hz + '*' + xpot,e,pa) else insert (hz,e,pa); {und neues einsetzen} kp:=pa+length(hz + xpot) ; if (xpot<>'') then kp:=kp+1; if mal=true then kp:=kp+1; kuerze_produkt:=kp; end; { of function kuerze_produkt } function begin_of_produkt( e:string ; i:integer):integer; {suche in e ab position i naechstes Produkt } begin while e[i] in trset do i:=i+1; begin_of_produkt:=i; end; procedure kuerze_polynom( var e:string); var i,pa,pe :integer; begin i:=1; pa:=i; repeat pa:=begin_of_produkt(e,pa); pa:=kuerze_produkt(e,pa); while (e[pa]= ')' ) do pa:=pa+1; until e[pa]='!'; { e[pa]:=' '; } { make_potenz braucht '!' ebenfalls } end; {--------------------------------------------------------------------------} procedure make_potenz( var e:string); var potenz,i,potanfang :integer; ps :string; begin i:=1; repeat while (e[i]<>'x') and (i<length(e)) do i:=i+1; potanfang:=i; while (e[i]='x') do i:=i+1; potenz:=i-potanfang; delete(e,potanfang,potenz); str(potenz,ps); if (ps<>'0') then if ps='1' then insert('x' , e , potanfang) else insert('x^' + ps ,e,potanfang); until (e[i]='!'); e[i]:=' '; end; {--------------------------------------------------------------------------} { This is the Main Program } begin Numbers:=['0'..'9']; produkts:=Numbers + [ '*' , 'x' ]; trset:=[ '(' , ')' , '+' , '-' ]; clrscr; for Grad:=0 to 4 do begin polynom:=rekstr(Grad) + '!'; writeln(polynom); kuerze_polynom(polynom); writeln(polynom); make_potenz(polynom); writeln(polynom); writeln; end; writeln; st1:='(2*x*x*4*x*x-4*x*x-12*x*3*x*x+2*2*x*x*3)!'; writeln(st1); kuerze_polynom(st1); writeln(st1); make_potenz(st1); writeln(st1); end.