diff options
| -rw-r--r-- | .gitignore | 10 | ||||
| -rw-r--r-- | filterBruteForce.ico | bin | 0 -> 137040 bytes | |||
| -rw-r--r-- | filterBruteForce.lpi | 94 | ||||
| -rw-r--r-- | filterBruteForce.lpr | 21 | ||||
| -rw-r--r-- | filterBruteForce.res | bin | 0 -> 138128 bytes | |||
| -rw-r--r-- | unit1.lfm | 108 | ||||
| -rw-r--r-- | unit1.pas | 124 | ||||
| -rw-r--r-- | unit2.pas | 900 |
8 files changed, 1257 insertions, 0 deletions
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 Binary files differnew file mode 100644 index 0000000..0341321 --- /dev/null +++ b/filterBruteForce.ico diff --git a/filterBruteForce.lpi b/filterBruteForce.lpi new file mode 100644 index 0000000..177d4c1 --- /dev/null +++ b/filterBruteForce.lpi @@ -0,0 +1,94 @@ +<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+ <ProjectOptions>
+ <Version Value="9"/>
+ <PathDelim Value="\"/>
+ <General>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <Title Value="filterBruteForce"/>
+ <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 Binary files differnew file mode 100644 index 0000000..7c6cf3e --- /dev/null +++ b/filterBruteForce.res 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.
+
|