unit Unit2; {$mode objfpc}{$H+} interface uses Classes, SysUtils; type tExtendedLongint = record x: extended; i: longint; end; tMyExtendedArray = class private function rInhalt(i: longint): extended; public zahlen: array of extended; anzahlen: array of longint; constructor create; overload; constructor create(ori: tMyExtendedArray); overload; destructor destroy; override; function count: longint; procedure add(x: extended; cnt: longint); overload; procedure add(x: string; cnt: longint); overload; procedure dump(sl: tStrings); property inhalt[i: longint]: extended read rInhalt; default; function findeWenigstens(x: extended): longint; function verbrauche(var x: tExtendedLongint): boolean; // gabs das? function verbrauche(var x1,x2: tExtendedLongint): boolean; // gabs das? end; tLongintArray = array of longint; tExtendedLongintArray = array of tExtendedLongint; tFilter = class private _gegenstueck: tFilter; _ordnung: longint; _frequenz: extended; procedure wGegenstueck(gs: tFilter); procedure wOrdnung(o: longint); procedure wFrequenz(f: extended); public acs,ars: tMyExtendedArray; Cs: tLongintArray; // index des Cs Rs: tExtendedLongintArray; // x = real, y = Index des maximalen constructor create(c,r: tMyExtendedArray); overload; constructor create(ori: tFilter); overload; destructor destroy; override; property gegenstueck: tFilter read _gegenstueck write wGegenstueck; property ordnung: longint read _ordnung write wOrdnung; property frequenz: extended read _frequenz write wFrequenz; function ordnungNichtDirektEinstellen: boolean; inline; procedure anzeigen(sl: tStrings); function dump: string; function weite: longint; function cWaehlen(idx: longint; var nutzen: extended): boolean; // Erfolg? function rsWaehlen(idx: longint): boolean; dynamic; abstract; // Erfolg? end; tHochpass = class(tFilter) function rsWaehlen(idx: longint): boolean; override; end; tTiefpass = class(tFilter) function rsWaehlen(idx: longint): boolean; override; end; tLoesung = class private _sollOrdnung: longint; procedure naechsteVollGenutzteOrdnungsverteilung; public cs,rs: tMyExtendedArray; filter: array of tFilter; nutzen: extended; constructor create(c,r: tMyExtendedArray); overload; constructor create(ori: tLoesung); overload; destructor destroy; override; procedure initFilter(tps,hps,thps: tMyExtendedArray); function ordnung: longint; function ordnungsSchritt: boolean; function auswahlSchritt(minNutzen: extended; callBack: tNotifyEvent): boolean; procedure anzeigen(sl: tStrings); function dump: string; function dumpWeite: string; end; tLoesungArray = class inhalt: array of tLoesung; constructor create; destructor destroy; override; procedure add(lsg: tLoesung); procedure indexVeroeffentlichen(sl: tStrings); procedure indexVeroeffentlichen(sl: tStrings; bis: longint); procedure cutItOff(cutoff: longint); procedure einfuegen(la: tLoesungArray); function minNutzen(cnt: longint): extended; end; function liesExtendedArray(sl: tStrings): tMyExtendedArray; overload; function liesExtendedArray(sl: tStrings; suf: string): tMyExtendedArray; overload; procedure liesExtendedArray(sl: tStrings; suf: string; var arr: tMyExtendedArray); overload; function dumpArray(arr: tLongintArray): string; overload; function dumpArray(arr: tLongintArray; werte: tMyExtendedArray): string; overload; function dumpArray(arr: tExtendedLongintArray; werte: tMyExtendedArray): string; overload; function bruteForcen(tps,hps,thps,rs,cs: tMyExtendedArray; cutoff: longint; iterationsCallBack,loesungsCallBack: tNotifyEvent): tLoesungArray; implementation uses strutils, math, dialogs; const minOrdnung = 4; // tMyExtendedArray ************************************************************ constructor tMyExtendedArray.create; begin inherited create; fillchar(zahlen,sizeof(zahlen),0); setlength(zahlen,0); fillchar(anzahlen,sizeof(anzahlen),0); setlength(anzahlen,0); end; constructor tMyExtendedArray.create(ori: tMyExtendedArray); var i: longint; begin create; setlength(zahlen,length(ori.zahlen)); setlength(anzahlen,length(ori.anzahlen)); for i:=0 to length(zahlen)-1 do begin zahlen[i]:=ori.zahlen[i]; anzahlen[i]:=ori.anzahlen[i]; end; end; destructor tMyExtendedArray.destroy; begin setlength(zahlen,0); setlength(anzahlen,0); inherited destroy; end; function tMyExtendedArray.rInhalt(i: longint): extended; var j: longint; begin if (i<0) or (i>=count) then begin messagedlg('Index ('+inttostr(i)+') liegt außerhalb der gültigen Grenzen (0..'+inttostr(count-1)+')!',mtError,[mbOk],0); exit; end; for j:=0 to length(zahlen)-1 do begin i:=i-anzahlen[j]; if i<0 then begin result:=zahlen[j]; exit; end; end; end; function tMyExtendedArray.count: longint; var i: longint; begin result:=0; for i:=0 to length(anzahlen)-1 do result:=result+anzahlen[i]; end; procedure tMyExtendedArray.add(x: extended; cnt: longint); var i,j: longint; begin for i:=0 to length(zahlen)-1 do begin if zahlen[i]=x then begin anzahlen[i]:=anzahlen[i]+cnt; exit; end; if zahlen[i]>x then begin setlength(zahlen,length(zahlen)+1); setlength(anzahlen,length(anzahlen)+1); for j:=length(zahlen)-1 downto i+1 do begin zahlen[j]:=zahlen[j-1]; anzahlen[j]:=anzahlen[j-1]; end; zahlen[i]:=x; anzahlen[i]:=cnt; exit; end; end; setlength(zahlen,length(zahlen)+1); setlength(anzahlen,length(anzahlen)+1); zahlen[length(anzahlen)-1]:=x; anzahlen[length(anzahlen)-1]:=cnt; end; procedure tMyExtendedArray.add(x: string; cnt: longint); const edg: array[0..13] of string = ('k','M','G','T','P','E','m','µ','n','p','f','a','y','z'); fak: array[0..13] of extended = (1e3,1e6,1e9,1e12,1e15,1e18,1e-3,1e-6,1e-9,1e-12,1e-15,1e-18,1e-21,1e-24); var i: longint; c: char; begin if decimalseparator='.' then c:=',' else c:='.'; while pos(c,x)>0 do x[pos(c,x)]:=decimalseparator; for i:=0 to length(edg)-1 do if pos(edg[i],x)>0 then begin add(strtofloat(trim(leftStr(x,pos(edg[i],x)-1)))*fak[i],cnt); exit; end; add(strtofloat(trim(x)),cnt); end; procedure tMyExtendedArray.dump(sl: tStrings); var i: longint; begin for i:=0 to length(zahlen)-1 do if anzahlen[i]<>0 then sl.add(inttostr(anzahlen[i])+'x '+floattostr(zahlen[i])); end; function tMyExtendedArray.findeWenigstens(x: extended): longint; var l,r,m: longint; begin l:=0; r:=length(zahlen); while lo then begin for i:=0 to length(Rs)-1 do if Rs[i].i>=0 then begin inc(ars.anzahlen[Rs[i].i]); Rs[i].i:=-1; end; for i:=0 to length(Cs)-1 do if Cs[i]>=0 then begin inc(acs.anzahlen[Cs[i]]); Cs[i]:=-1; end; _ordnung:=o; if assigned(gegenstueck) then gegenstueck.ordnung:=o; setlength(Cs,ordnung); setlength(Rs,ordnung); for i:=0 to ordnung-1 do begin Cs[i]:=-1; Rs[i].i:=-1; Rs[i].x:=-1; end; end; end; procedure tFilter.wFrequenz(f: extended); begin if _frequenz<>f then begin _frequenz:=f; if assigned(gegenstueck) then gegenstueck.frequenz:=f; end; end; function tFilter.ordnungNichtDirektEinstellen: boolean; begin result:=assigned(gegenstueck) and (self is tHochpass); end; procedure tFilter.anzeigen(sl: tStrings); var s: string; i: longint; begin if self is tHochpass then s:='Hochpass' else s:='Tiefpass'; if assigned(gegenstueck) then s:=s+''''; sl.add(s+' '+inttostr(ordnung)+'. Ordnung ('+floattostr(frequenz)+' Hz)'); for i:=0 to ordnung-1 do begin s:=' R'+inttostr(i+1)+' = '+floattostr(Rs[i].x)+' Ω von '; if (Rs[i].i>=0) and (Rs[i].i=0) do inc(result); end; function tFilter.cWaehlen(idx: longint; var nutzen: extended): boolean; begin if odd(idx) and (Rs[idx-1].i>=0) and (Rs[idx].i>=0) then nutzen:=nutzen / exp(-sqr(sqr(Rs[idx-1].x/ars.zahlen[Rs[idx-1].i]-0.9)) -sqr(sqr(Rs[idx].x / ars.zahlen[Rs[idx].i] - 0.9))); if Cs[idx]>=0 then // Kondensator "zurück legen" inc(aCs.anzahlen[Cs[idx]]); if (self is tHochpass) and // bei einem Hochpass odd(idx) and // ist C_n+1 (Cs[idx]<0) then // nicht kleiner C_n Cs[idx]:=Cs[idx-1]-1; // (sonst sind jede Menge redundanter Lösungen vorhanden) repeat inc(Cs[idx]); if Cs[idx]>=length(aCs.anzahlen) then begin // keine Kondensatoren mehr übrig Cs[idx]:=-1; result:=false; if Rs[idx].i>=0 then begin // zugehörigen Widerstand auch zurück legen inc(ars.anzahlen[Rs[idx].i]); Rs[idx].i:=-1; end; exit; end; until (aCs.anzahlen[Cs[idx]]>0) and ((not odd(idx)) or rsWaehlen(idx div 2)); dec(aCs.anzahlen[Cs[idx]]); // Kondensator nehmen if odd(idx) then nutzen:=nutzen * exp(-sqr(sqr(Rs[idx-1].x/ars.zahlen[Rs[idx-1].i]-0.9)) -sqr(sqr(Rs[idx].x / ars.zahlen[Rs[idx].i] - 0.9))); result:=true; end; // tHochpass ******************************************************************* function tHochpass.rsWaehlen(idx: longint): boolean; begin // Widerstände "zurück legen" if Rs[2*idx].i>=0 then begin inc(ars.anzahlen[Rs[2*idx].i]); Rs[2*idx].i:=-1; end; if Rs[2*idx+1].i>=0 then begin inc(ars.anzahlen[Rs[2*idx+1].i]); Rs[2*idx+1].i:=-1; end; // w^2 c1 c2 r1 r2 = 1 // w r2 (c1 + c2) = -2 cos( (2k + n - 1)/(2n) pi ) // vorsicht, obiges n zählt ab 1, hiesige Indizes (z.B. idx) dagegen ab 0 rs[2*idx+1].x:= -2*cos( (2*idx + ordnung + 1)/(2*ordnung)*pi ) / (2*pi*frequenz) / (acs.zahlen[cs[2*idx]]+acs.zahlen[cs[2*idx+1]]); rs[2*idx].x:= 1/sqr(2*pi*frequenz)/acs.zahlen[cs[2*idx]]/acs.zahlen[cs[2*idx+1]]/rs[2*idx+1].x; result:=ars.verbrauche(rs[2*idx],rs[2*idx+1]); end; // tTiefpass ******************************************************************* function tTiefpass.rsWaehlen(idx: longint): boolean; var prod,sum: extended; // r1*r2 und r1+r2 begin // Widerstände "zurück legen" if Rs[2*idx].i>=0 then begin inc(ars.anzahlen[Rs[2*idx].i]); Rs[2*idx].i:=-1; end; if Rs[2*idx+1].i>=0 then begin inc(ars.anzahlen[Rs[2*idx+1].i]); Rs[2*idx+1].i:=-1; end; // w^2 c1 c2 r1 r2 = 1 // w c2 (r1 + r2) = -2 cos( (2k + n - 1)/(2n) pi ) // vorsicht, obiges n zählt ab 1, hiesige Indizes (z.B. idx) dagegen ab 0 prod:=1/sqr(2*pi*frequenz)/acs.zahlen[cs[2*idx]]/acs.zahlen[cs[2*idx+1]]; sum:=-2*cos( (2*idx + ordnung + 1)/(2*ordnung)*pi ) / (2*pi*frequenz) / acs.zahlen[cs[2*idx+1]]; prod:=sqr(sum)-4*prod; if prod<0 then begin // Diskriminante negativ result:=false; exit; end; rs[2*idx].x:= (sum + sqrt(prod))/2; rs[2*idx+1].x:=(sum - sqrt(prod))/2; if rs[2*idx+1].x<0 then exit; // nur positivie Widerstände sind erlaubt result:=ars.verbrauche(rs[2*idx],rs[2*idx+1]); end; // tLoesung ******************************************************************** constructor tLoesung.create(c,r: tMyExtendedArray); begin inherited create; fillchar(filter,sizeof(filter),0); setlength(filter,0); fillchar(cs,sizeof(cs),0); cs:=c; fillchar(rs,sizeof(rs),0); rs:=r; _sollOrdnung:=cs.count; if cs.count<>rs.count then begin messagedlg('tLoesung.create: Unterschiedlich viele Widerstände ('+inttostr(rs.count)+') und Kondensatoren ('+inttostr(cs.count)+')!',mtError,[mbOk],0); exit; end; nutzen:=1; end; constructor tLoesung.create(ori: tLoesung); var i,j: longint; begin create(ori.cs,ori.rs); _sollOrdnung:=ori._sollOrdnung; setlength(filter,length(ori.filter)); for i:=0 to length(filter)-1 do if ori.filter[i] is tHochpass then filter[i]:=tHochpass.create(ori.filter[i]) else filter[i]:=tTiefpass.create(ori.filter[i]); for i:=0 to length(filter)-1 do for j:=i+1 to length(filter)-1 do if ori.filter[i].gegenstueck=ori.filter[j] then begin filter[i].gegenstueck:=filter[j]; break; end; nutzen:=ori.nutzen; end; destructor tLoesung.destroy; var i: longint; begin cs:=nil; rs:=nil; for i:=0 to length(filter)-1 do filter[i].free; setlength(filter,0); inherited destroy; end; procedure tLoesung.naechsteVollGenutzteOrdnungsverteilung; var i: longint; begin if ordnung>=_sollordnung then exit; i:=0; repeat if i>0 then filter[i-1].ordnung:=filter[i-1].ordnung-2; while ordnung<_sollordnung do filter[i].ordnung:=filter[i].ordnung+2; inc(i); until (ordnung=_sollordnung) or (i=length(filter)); end; procedure tLoesung.initFilter(tps,hps,thps: tMyExtendedArray); var i: longint; begin setlength(filter,tps.count + hps.count + 2*thps.count); for i:=0 to tps.count-1 do begin filter[i]:=tTiefpass.create(Cs,Rs); filter[i].Ordnung:=minOrdnung; filter[i].Frequenz:=tps[i]; end; for i:=0 to hps.count-1 do begin filter[tps.count+i]:=tHochpass.create(Cs,Rs); filter[tps.count+i].Ordnung:=minOrdnung; filter[tps.count+i].Frequenz:=hps[i]; end; for i:=0 to thps.count-1 do begin filter[tps.count+hps.count+2*i]:=tTiefpass.create(Cs,Rs); filter[tps.count+hps.count+2*i+1]:=tHochpass.create(Cs,Rs); filter[tps.count+hps.count+2*i].Gegenstueck:=filter[tps.count+hps.count+2*i+1]; filter[tps.count+hps.count+2*i].Ordnung:=minOrdnung; filter[tps.count+hps.count+2*i].Frequenz:=thps[i]; end; naechsteVollGenutzteOrdnungsverteilung; end; function tLoesung.ordnung: longint; var i: longint; begin result:=0; for i:=0 to length(filter)-1 do result:=result+filter[i].ordnung; end; function tLoesung.ordnungsSchritt: boolean; var i,j: longint; begin i:=-1; result:=false; repeat inc(i); while (i=length(filter) then exit; // Übertrag fällt hinten heraus, also sind wir fertig for j:=0 to i-1 do if not filter[j].ordnungNichtDirektEinstellen then filter[j].ordnung:=minOrdnung; filter[i].ordnung:=filter[i].ordnung+2; naechsteVollGenutzteOrdnungsverteilung; until ordnung=_sollOrdnung; result:=true; end; function tLoesung.auswahlSchritt(minNutzen: extended; callback: tNotifyEvent): boolean; var fnum,cnum: longint; begin result:=false; if (length(filter[0].Cs)=0) or (filter[0].Cs[0]<0) then begin // Initialisierung erforderlich => wir fangen von vorne an fnum:=0; cnum:=0; end else begin // keine Initialisierung erforderlich => wir fangen von hinten an fnum:=length(filter)-1; cnum:=length(filter[fnum].Cs)-1; end; repeat repeat while not filter[fnum].cWaehlen(cnum,nutzen) do begin // entsprechender Kondensator kann nicht gewählt werden, // also gehen wir eins zurück dec(cnum); if cnum<0 then begin // am Ende des Filters dec(fnum); if fnum<0 then exit; // wir sind am Ende aller Filter cnum:=length(filter[fnum].Cs)-1; end; if assigned(callback) then callback(self); end; until nutzen>minNutzen; inc(cnum); // nächsten Kondensator anschauen if cnum>=length(filter[fnum].Cs) then begin // nächster Filter cnum:=0; inc(fnum); end; until fnum>=length(filter); result:=true; end; procedure tLoesung.anzeigen(sl: tStrings); var i: longint; begin sl.clear; for i:=0 to length(filter)-1 do filter[i].anzeigen(sl); end; function tLoesung.dump: string; var i: longint; begin result:=''; for i:=0 to length(filter)-1 do result:=result+' '+filter[i].dump; delete(result,1,1); end; function tLoesung.dumpWeite: string; var i: longint; begin result:=''; for i:=0 to length(filter)-1 do if filter[i].weite>0 then result:=result+' '+inttostr(filter[i].weite); delete(result,1,1); end; // tLoesungArray *************************************************************** constructor tLoesungArray.create; begin inherited create; fillchar(inhalt,sizeof(inhalt),0); setlength(inhalt,0); end; destructor tLoesungArray.destroy; var i: longint; begin for i:=0 to length(inhalt)-1 do inhalt[i].free; setlength(inhalt,0); inherited destroy; end; procedure tLoesungArray.add(lsg: tLoesung); var i,j: longint; begin for i:=0 to length(inhalt)-1 do if inhalt[i].nutzencutoff then begin for i:=cutoff to length(inhalt)-1 do inhalt[i].free; setlength(inhalt,cutoff); end; end; procedure tLoesungArray.einfuegen(la: tLoesungArray); var i: longint; begin for i:=0 to length(la.inhalt)-1 do add(la.inhalt[i]); setlength(la.inhalt,0); end; function tLoesungArray.minNutzen(cnt: longint): extended; begin if cnt>length(inhalt) then result:=-1 else result:=inhalt[cnt-1].nutzen; end; // allgemeine Funktionen ******************************************************* function liesExtendedArray(sl: tStrings): tMyExtendedArray; begin result:=liesExtendedArray(sl,''); end; function liesExtendedArray(sl: tStrings; suf: string): tMyExtendedArray; begin result:=tMyExtendedArray.create; liesExtendedArray(sl,suf,result); end; procedure liesExtendedArray(sl: tStrings; suf: string; var arr: tMyExtendedArray); var i,cnt: longint; s: string; begin if (suf<>'') and (leftstr(suf,1)<>' ') then suf:=' '+suf; for i:=0 to sl.count-1 do if rightstr(sl[i],length(suf))=suf then begin s:=trim(leftStr(sl[i],length(sl[i])-length(suf))); if pos('x',s)>0 then begin cnt:=strtoint(trim(leftstr(s,pos('x',s)-1))); delete(s,1,pos('x',s)); s:=trim(s); end else cnt:=1; arr.add(s,cnt); end; end; function dumpArray(arr: tLongintArray): string; var i: longint; begin result:=''; for i:=0 to length(arr)-1 do result:=result+', '+inttostr(arr[i]); delete(result,1,2); end; function dumpArray(arr: tLongintArray; werte: tMyExtendedArray): string; var i: longint; begin result:=''; for i:=0 to length(arr)-1 do result:=result+', '+floattostr(werte.zahlen[arr[i]]); delete(result,1,2); end; function dumpArray(arr: tExtendedLongintArray; werte: tMyExtendedArray): string; var i: longint; begin result:=''; for i:=0 to length(arr)-1 do result:=result+', ('+floattostr(arr[i].x)+';'+floattostr(werte.zahlen[arr[i].i])+')'; delete(result,1,2); end; function bruteForcen(tps,hps,thps,rs,cs: tMyExtendedArray; cutoff: longint; iterationsCallBack,loesungsCallBack: tNotifyEvent): tLoesungArray; var cLsg: tLoesung; cLsgn: tLoesungArray; begin result:=tLoesungArray.create; if rs.count<>cs.count then begin messagedlg('bruteForcen: Unterschiedlich viele Widerstände ('+inttostr(rs.count)+') und Kondensatoren ('+inttostr(cs.count)+')!',mtError,[mbOk],0); exit; end; if odd(rs.count) then begin messagedlg('Ungerade Filterordnung kann ich nicht!',mtError,[mbOk],0); exit; end; cLsg:=tLoesung.create(rs,cs); cLsg.initFilter(tps,hps,thps); repeat cLsgn:=tLoesungArray.create; while cLsg.auswahlSchritt(cLsgn.minNutzen(cutoff),iterationsCallBack) do begin cLsgn.add(cLsg); cLsg:=tLoesung.create(cLsg); cLsgn.cutItOff(cutoff); if assigned(loesungsCallBack) then loesungsCallBack(nil); end; result.einfuegen(cLsgn); cLsgn.free; until not cLsg.ordnungsSchritt; cLsg.free; end; end.