From 011fcb5c589090a68df026128afc93b20364d510 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Fri, 22 Jan 2016 19:46:49 +0100 Subject: Initial commit --- .gitignore | 10 + filterBruteForce.ico | Bin 0 -> 137040 bytes filterBruteForce.lpi | 94 ++++++ filterBruteForce.lpr | 21 ++ filterBruteForce.res | Bin 0 -> 138128 bytes unit1.lfm | 108 +++++++ unit1.pas | 124 +++++++ unit2.pas | 900 +++++++++++++++++++++++++++++++++++++++++++++++++++ 8 files changed, 1257 insertions(+) create mode 100644 .gitignore create mode 100644 filterBruteForce.ico create mode 100644 filterBruteForce.lpi create mode 100644 filterBruteForce.lpr create mode 100644 filterBruteForce.res create mode 100644 unit1.lfm create mode 100644 unit1.pas create mode 100644 unit2.pas diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d777e05 --- /dev/null +++ b/.gitignore @@ -0,0 +1,10 @@ +*~ +*.backup +*.bak +*.bak* +filterBruteForce +lib +*.lps +*.[oa] +*.out +*.ppu diff --git a/filterBruteForce.ico b/filterBruteForce.ico new file mode 100644 index 0000000..0341321 Binary files /dev/null and b/filterBruteForce.ico differ diff --git a/filterBruteForce.lpi b/filterBruteForce.lpi new file mode 100644 index 0000000..177d4c1 --- /dev/null +++ b/filterBruteForce.lpi @@ -0,0 +1,94 @@ + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="3"> + <Unit0> + <Filename Value="filterBruteForce.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="filterBruteForce"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + </Unit1> + <Unit2> + <Filename Value="unit2.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="Unit2"/> + </Unit2> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="filterBruteForce"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CompilerMessages> + <MsgFileName Value=""/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/filterBruteForce.lpr b/filterBruteForce.lpr new file mode 100644 index 0000000..b8191a2 --- /dev/null +++ b/filterBruteForce.lpr @@ -0,0 +1,21 @@ +program filterBruteForce; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Unit1, Unit2 + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/filterBruteForce.res b/filterBruteForce.res new file mode 100644 index 0000000..7c6cf3e Binary files /dev/null and b/filterBruteForce.res differ diff --git a/unit1.lfm b/unit1.lfm new file mode 100644 index 0000000..8f28e14 --- /dev/null +++ b/unit1.lfm @@ -0,0 +1,108 @@ +object Form1: TForm1 + Left = 222 + Height = 544 + Top = 140 + Width = 1018 + Caption = 'Form1' + ClientHeight = 544 + ClientWidth = 1018 + OnClick = FormClick + OnCreate = FormCreate + OnDestroy = FormDestroy + OnResize = FormResize + LCLVersion = '1.2.2.0' + object Memo1: TMemo + Left = 0 + Height = 528 + Top = 16 + Width = 150 + Lines.Strings = ( + '5x 3,3n' + '5x 4,7n' + '4x 6,8n' + '2x 10n' + '2x 22n' + '1x 33n' + '3x 150n' + '3x 220n' + '1x 1µ' + ) + TabOrder = 0 + end + object Label1: TLabel + Left = 0 + Height = 13 + Top = 0 + Width = 77 + Caption = 'Kondensatoren:' + ParentColor = False + end + object Memo2: TMemo + Left = 152 + Height = 528 + Top = 16 + Width = 150 + Lines.Strings = ( + '1x 1k' + '1x 2k' + '6x 5k' + '6x 10k' + '9x 20k' + '3x 50k' + ) + TabOrder = 1 + end + object Label2: TLabel + Left = 152 + Height = 13 + Top = 0 + Width = 72 + Caption = 'Potentiometer:' + ParentColor = False + end + object Memo3: TMemo + Left = 304 + Height = 528 + Top = 16 + Width = 150 + Lines.Strings = ( + '80 hp' + '3500 thp' + ) + TabOrder = 2 + end + object Label3: TLabel + Left = 303 + Height = 13 + Top = 0 + Width = 61 + Caption = 'Frequenzen:' + ParentColor = False + end + object Button1: TButton + Left = 456 + Height = 25 + Top = 0 + Width = 75 + Caption = 'Brute Force!' + OnClick = Button1Click + TabOrder = 3 + end + object ListBox1: TListBox + Left = 456 + Height = 516 + Top = 28 + Width = 76 + ItemHeight = 0 + OnClick = ListBox1Click + TabOrder = 4 + end + object ListBox2: TListBox + Left = 534 + Height = 544 + Top = 0 + Width = 484 + ItemHeight = 0 + TabOrder = 5 + end +end diff --git a/unit1.pas b/unit1.pas new file mode 100644 index 0000000..86792d7 --- /dev/null +++ b/unit1.pas @@ -0,0 +1,124 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, + Unit2; + +type + + { TForm1 } + + TForm1 = class(TForm) + Button1: TButton; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + ListBox1: TListBox; + ListBox2: TListBox; + Memo1: TMemo; + Memo2: TMemo; + Memo3: TMemo; + procedure Button1Click(Sender: TObject); + procedure FormClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormResize(Sender: TObject); + procedure ListBox1Click(Sender: TObject); + private + { private declarations } + public + { public declarations } + loesungen: tLoesungArray; + Rs,Cs: tMyExtendedArray; + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +{ TForm1 } + +procedure TForm1.FormResize(Sender: TObject); +begin + Memo1.Height:=Form1.ClientHeight-Memo1.Top; + Memo2.Height:=Form1.ClientHeight-Memo2.Top; + Memo3.Height:=Form1.ClientHeight-Memo3.Top; + ListBox1.Height:=Form1.ClientHeight-ListBox1.Top; + ListBox2.Height:=Form1.ClientHeight-ListBox2.Top; +end; + +procedure TForm1.ListBox1Click(Sender: TObject); +begin + if (Listbox1.Itemindex>=0) and + (Listbox1.Itemindex<length(loesungen.inhalt)) then + loesungen.inhalt[Listbox1.Itemindex].anzeigen(Listbox2.Items); +end; + +procedure TForm1.Button1Click(Sender: TObject); +var + hps,tps,thps: tMyExtendedArray; +begin + Rs.free; + Rs:=liesExtendedArray(Memo2.Lines); + Cs.free; + Cs:=liesExtendedArray(Memo1.Lines); + tps:=liesExtendedArray(Memo3.Lines,'tp'); + hps:=liesExtendedArray(Memo3.Lines,'hp'); + thps:=liesExtendedArray(Memo3.Lines,'thp'); + ListBox1.Items.Clear; + ListBox2.Items.Clear; + + loesungen:=bruteForcen(tps,hps,thps,Cs,Rs,20,@FormClick); + loesungen.indexVeroeffentlichen(Listbox1.Items); + + hps.free; + tps.free; + thps.free; +end; + +const + c1: longint = 0; + c2: longint = 0; + +procedure TForm1.FormClick(Sender: TObject); +begin + if assigned(sender) and + (sender is tLoesung) then begin + inc(c1); + if c1>=1000000 then begin + c1:=0; + Form1.Caption:=inttostr(c2)+' '+(sender as tLoesung).dumpWeite; + Application.ProcessMessages; + end; + end + else begin + inc(c2); + if c2 mod 100 = 0 then begin + Form1.Color:=random($1000000); + Form1.Caption:=inttostr(c2)+' '+rightstr(Form1.Caption,length(Form1.Caption)-pos(' ',Form1.Caption)); + Application.ProcessMessages; + end; + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + Rs:=nil; + Cs:=nil; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + Rs.free; + Cs.free; +end; + +end. + diff --git a/unit2.pas b/unit2.pas new file mode 100644 index 0000000..c88b14b --- /dev/null +++ b/unit2.pas @@ -0,0 +1,900 @@ +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; callback: 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; +begin + 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 l<r do begin + m:=(l+r) div 2; + if zahlen[m]<x then + l:=m+1 + else + r:=m; + end; + + while (l<length(anzahlen)) and (anzahlen[l]=0) do + inc(l); + + result:=l; +end; + +function tMyExtendedArray.verbrauche(var x: tExtendedLongint): boolean; +begin + x.i:=findeWenigstens(x.x); + result:=x.i<length(anzahlen); + if result then + dec(anzahlen[x.i]) + else + x.i:=-1; +end; + +function tMyExtendedArray.verbrauche(var x1,x2: tExtendedLongint): boolean; +begin + result:=verbrauche(x1); + if result then + if not verbrauche(x2) then begin + result:=false; + inc(anzahlen[x1.i]); + x1.i:=-1; + end; +end; + +// tFilter ********************************************************************* + +constructor tFilter.create(c,r: tMyExtendedArray); +begin + inherited create; + Ordnung:=0; + acs:=c; + ars:=r; + fillchar(Cs,sizeof(Cs),0); + setlength(Cs,0); + fillchar(Rs,sizeof(Rs),0); + setlength(Rs,0); + _frequenz:=0; + _gegenstueck:=nil; +end; + +constructor tFilter.create(ori: tFilter); +var + i: longint; +begin + inherited create; + Ordnung:=ori.Ordnung; + acs:=ori.acs; + ars:=ori.ars; + setlength(Cs,length(ori.Cs)); + for i:=0 to length(Cs)-1 do + Cs[i]:=ori.Cs[i]; + setlength(Rs,length(ori.Rs)); + for i:=0 to length(Rs)-1 do begin + Rs[i].x:=ori.Rs[i].x; + Rs[i].i:=ori.Rs[i].i; + end; + _frequenz:=ori.frequenz; + _gegenstueck:=nil; +end; + +destructor tFilter.destroy; +begin + gegenstueck:=nil; + setlength(Cs,0); + setlength(Rs,0); + inherited destroy; +end; + +procedure tFilter.wGegenstueck(gs: tFilter); +begin + if assigned(_gegenstueck) then + _gegenstueck._gegenstueck:=nil; + _gegenstueck:=gs; + if assigned(_gegenstueck) then begin + if _gegenstueck is tHochpass = self is tHochpass then begin + messagedlg('Zusammengehörige Filter müssen je ein Hoch- und ein Tiefpass sein!',mtError,[mbOk],0); + halt; + end; + _gegenstueck._gegenstueck:=self; + end; +end; + +procedure tFilter.wOrdnung(o: longint); +var + i: longint; +begin + if _ordnung<>o 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<length(ars.zahlen)) then + s:=s+floattostr(ars.zahlen[Rs[i].i]) + else + s:=s+'nan('+inttostr(Rs[i].i)+')'; + s:=s+' Ω, C'+inttostr(i+1)+' = '; + if (Cs[i]>=0) and + (Cs[i]<length(acs.zahlen)) then + s:=s+floattostr(acs.zahlen[Cs[i]]) + else + s:=s+'nan('+inttostr(Cs[i])+')'; + s:=s+' F'; + sl.add(s); + end; +end; + +function tFilter.dump: string; +begin + result:=inttostr(ordnung)+' '; + if self is tHochpass then result:=result+'hp' + else result:=result+'tp'; + if assigned(gegenstueck) then result:=result+'!'; + result:=result+' ('+floattostr(frequenz)+')'; + result:=result+' '+inttostr(ordnung)+' ('+dumpArray(Cs,acs)+') ('+dumpArray(Rs,ars)+')'; +end; + +function tFilter.weite: longint; +begin + result:=0; + while (result<length(Cs)) and + (Cs[result]>=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)) and filter[i].ordnungNichtDirektEinstellen do + inc(i); + + if 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].nutzen<lsg.nutzen then begin + setlength(inhalt,length(inhalt)+1); + for j:=length(inhalt)-1 downto i+1 do + inhalt[j]:=inhalt[j-1]; + inhalt[i]:=lsg; + exit; + end; + setlength(inhalt,length(inhalt)+1); + inhalt[length(inhalt)-1]:=lsg; +end; + +procedure tLoesungArray.indexVeroeffentlichen(sl: tStrings); +begin + indexVeroeffentlichen(sl,-1); +end; + +procedure tLoesungArray.indexVeroeffentlichen(sl: tStrings; bis: longint); +var + i: longint; +begin + if bis<0 then bis:=length(inhalt); + sl.clear; + for i:=0 to min(bis,length(inhalt))-1 do + sl.add(inttostr(i+1)+'.: '+floattostr(inhalt[i].nutzen)+' '+inhalt[i].dump); +end; + +procedure tLoesungArray.cutItOff(cutoff: longint); +var + i: longint; +begin + if length(inhalt)>cutoff 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; callback: 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),callBack) do begin + cLsgn.add(cLsg); + cLsg:=tLoesung.create(cLsg); + cLsgn.cutItOff(cutoff); + if assigned(callBack) then + callBack(nil); + end; + result.einfuegen(cLsgn); + cLsgn.free; + until not cLsg.ordnungsSchritt; + + cLsg.free; +end; + +end. + -- cgit v1.2.3-54-g00ecf