neue Dateien: matheunit.pas, mlockunit.pas, mystringlistunit.pas,

pseudohadamard.pas, randomunit.pas, systemunit.pas

6 files changed, 694 insertions, 0 deletions

diff --git a/matheunit.pas b/matheunit.pas
new file mode 100644
index 0000000..93d99d5
--- /dev/null
+++ b/matheunit.pas
@@ -0,0 +1,222 @@
+unit matheunit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Gmp, Math;
+
+type
+  tExtPoint = record
+    x,y: extended;
+  end;
+  tExtPointArray = array of tExtPoint;
+  pTExtPointArray = ^tExtPointArray;
+  tLongintArray = array of longint;
+  pTLongintArray = ^tLongintArray;
+  tExtendedArray = array of extended;
+
+function plus(a,b: tExtPoint): tExtPoint;
+function durch(a: tExtPoint; b: extended): tExtPoint;
+function myFrac(x: extended): extended;
+function mpfToStr(f: mpf_t): string;
+function signSqr(x: extended): extended; inline;
+function mpfMyRoot(rad: mpf_t; wzlExp: int64): extended;
+function myTimeToStr(t: extended): string;
+function cmpStr(s1,s2: string): longint;
+function mitte(s1,s2: string): string;
+function myFloatToStr(x: extended): string;
+function myStrToFloat(s: string): extended;
+
+implementation
+
+function plus(a,b: tExtPoint): tExtPoint;
+begin
+  result.x:=a.x+b.x;
+  result.y:=a.y+b.y;
+end;
+
+function durch(a: tExtPoint; b: extended): tExtPoint;
+begin
+  result.x:=a.x/b;
+  result.y:=a.y/b;
+end;
+
+function myFrac(x: extended): extended;
+begin
+  result:=frac(x);
+  while result<0 do
+    result:=result+1;
+end;
+
+function mpfToStr(f: mpf_t): string;
+var
+  ex:  int64;
+  off: byte;
+begin
+ result:=mpf_get_str(nil,ex,10,0,f);
+ off:=1+byte(pos('-',result)=1);
+ if result='' then
+   result:='0'
+ else if ex=1 then
+   result:=copy(result,1,off)+','+copy(result,off+1,length(result)-off)
+ else
+   result:=copy(result,1,off)+','+copy(result,off+1,length(result)-off)+' * 10^'+inttostr(ex-1);
+end;
+
+function signSqr(x: extended): extended;
+begin
+ result:=sign(x)*sqr(x);
+end;
+
+function mpfMyRoot(rad: mpf_t; wzlExp: int64): extended;
+var
+  ex: int64;
+begin
+  result:=power(mpf_get_d_2exp(ex,rad),1/wzlExp);
+  result:=result*power(2,ex/wzlExp);
+end;
+
+function myTimeToStr(t: extended): string;
+var
+  tim: int64;
+begin
+ tim:=floor(t*24*60*60);
+ result:=inttostr(tim mod 10)+'s';
+ tim:=tim div 10;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 6)+result;
+ tim:=tim div 6;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 10)+'min '+result;
+ tim:=tim div 10;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 6)+result;
+ tim:=tim div 6;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 24)+'h '+result;
+ tim:=tim div 24;
+ if tim=0 then exit;
+ result:=' '+result;
+ if (tim mod 7)<>1 then
+   result:='e'+result;
+ result:=inttostr(tim mod 7)+'Tag'+result;
+ tim:=tim div 7;
+ if tim=0 then exit;
+ result:=' '+result;
+ if tim<>1 then
+   result:='n'+result;
+ result:=inttostr(tim)+'Woche'+result;
+end;
+
+function cmpStr(s1,s2: string): longint;
+var
+  i: longint;
+begin
+ for i:=1 to min(length(s1),length(s2)) do
+   if s1[i]<>s2[i] then begin
+     result:=2*byte(s1[i]>s2[i])-1;
+     exit;
+   end;
+ if length(s1)<>length(s2) then begin
+   result:=2*byte(length(s1)>length(s2))-1;
+   exit;
+ end;
+ result:=0;
+end;
+
+function mitte(s1,s2: string): string;
+var
+  i:    longint;
+  w,nw: word;
+begin
+ setlength(result,max(length(s1),length(s2)));
+ w:=0;
+ for i:=length(result) downto 1 do begin // result:= "s1+s2";
+   if i<=length(s1) then
+     w:=w+byte(s1[i]);
+   if i<=length(s2) then
+     w:=w+byte(s2[i]);
+   result[i]:=char(w and $ff);
+   w:=w shr 8;
+ end;
+ result:=char(w)+result;
+ w:=0;
+ for i:=1 to length(result) do begin
+   nw:=byte(odd(byte(result[i])+w));
+   result[i]:=char((byte(result[i])+w) div 2);
+   w:=nw shl 8;
+ end;
+ if w<>0 then
+   result:=result+char(w div 2);
+ if result[1]<>#0 then begin
+   writeln('Fehler bei der Mittenfindeung!');
+   halt;
+ end;
+ delete(result,1,1);
+end;
+
+function myFloatToStr(x: extended): string;
+var
+  i,e: longint;
+begin
+ e:=0;
+ if x<0 then begin
+   result:='-';
+   x:=-x;
+ end
+ else
+   result:='';
+ if x=0 then begin
+   result:='0';
+   exit;
+ end;
+ while x<1 do begin
+   dec(e);
+   x:=x*10;
+ end;
+ while x>=10 do begin
+   inc(e);
+   x:=x/10;
+ end;
+ result:=result+char(ord('0')+floor(x))+'.';
+ for i:=0 to 20 do begin
+   x:=(x-floor(x))*10;
+   result:=result+char(ord('0')+floor(x));
+ end;
+ if e<>0 then
+   result:=result+'E'+inttostr(e);
+end;
+
+function myStrToFloat(s: string): extended;
+var
+  i,e: longint;
+  neg: boolean;
+begin
+ if pos('E',s)>0 then begin
+   e:=strtoint(rightStr(s,length(s)-pos('E',s)));
+   delete(s,pos('E',s),length(s));
+ end
+ else e:=0;
+ if pos('.',s)=0 then begin
+   result:=strtoint(s)*power(10,e);
+   exit;
+ end;
+ neg:=leftStr(s,1)='-';
+ if neg then
+   delete(s,1,1);
+ if pos('.',s)=2 then begin
+   result:=0;
+   for i:=length(s) downto 3 do
+     result:=result/10 + ord(s[i])-ord('0');
+   result:=result/10 + ord(s[1])-ord('0');
+ end
+ else result:=strtofloat(s);
+ result:=result*power(10,e);
+ if neg then
+   result:=-result;
+end;
+
+end.
+
diff --git a/mlockunit.pas b/mlockunit.pas
new file mode 100644
index 0000000..16598d6
--- /dev/null
+++ b/mlockunit.pas
@@ -0,0 +1,18 @@
+unit mlockunit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses ctypes;
+
+const _SC_PAGESIZE = 30;
+
+function mlock(const addr: pointer; len: cint): cint; external 'libc';
+function munlock(const addr: pointer; len: cint): cint; external 'libc';
+function sysconf(name: cint): clong; external 'libc';
+
+implementation
+
+end.
+
diff --git a/mystringlistunit.pas b/mystringlistunit.pas
new file mode 100644
index 0000000..d3fe052
--- /dev/null
+++ b/mystringlistunit.pas
@@ -0,0 +1,192 @@
+unit mystringlistunit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, RegExpr, Process, Math;
+
+type
+  tMyStringlist = class;
+
+  tInputThread = class (tThread)
+    fertig: boolean;
+    inhalt: tMyStringList;
+    proc:   tProcess;
+    constructor create(p: tProcess; sl: tMyStringList);
+    destructor destroy; override;
+    procedure execute; override;
+  end;
+
+  tMyStringlist = class (tStringlist)
+  private
+    line:  longint;
+  public
+    constructor create;
+    procedure loadFromFile(const s: ansiString); override;
+    procedure loadFromGz(const s: ansiString);
+    procedure saveToGz(const s: ansiString);
+    function readln(out s: string): boolean;
+    procedure grep(expr: string);
+    function eof: boolean;
+  end;
+
+implementation
+
+// tInputThread ****************************************************************
+
+constructor tInputThread.create(p: tProcess; sl: tMyStringList);
+begin
+ inherited create(true);
+ fertig:=false;
+ inhalt:=sl;
+ proc:=p;
+ suspended:=false;
+end;
+
+destructor tInputThread.destroy;
+begin
+ inhalt:=nil;
+ proc:=nil;
+ inherited destroy;
+end;
+
+procedure tInputThread.execute;
+var
+  wb,cwb: longint;
+begin
+ wb:=0;
+ while wb<length(inhalt.text) do begin
+   cwb:=proc.input.write(inhalt.text[wb+1],length(inhalt.text)-wb);
+   if cwb=0 then
+     sleep(1)
+   else
+     wb:=wb+cwb;
+ end;
+ proc.CloseInput;
+ fertig:=true;
+end;
+
+// tMyStringlist ***************************************************************
+
+constructor tMyStringlist.create;
+begin
+ inherited create;
+ line:=0;
+end;
+
+procedure tMyStringlist.loadFromFile(const s: ansiString);
+var i: longint;
+begin
+ inherited loadFromFile(s);
+ for i:=0 to count-1 do
+   self[i]:=trim(self[i]);
+ line:=0;
+ writeln(inttostr(count)+' Zeilen eingelesen');
+end;
+
+procedure tMyStringlist.loadFromGz(const s: ansiString);
+var p:     tProcess;
+    buf:   ansiString;
+    rb,br: longint;
+begin
+ p:=tProcess.create(nil);
+ p.executable:='/usr/bin/zcat';
+ p.parameters.add(s);
+ p.options:=p.options + [poUsePipes];
+ setlength(buf,0);
+ br:=0;
+ p.execute;
+ while p.running do begin
+   rb:=p.output.numBytesAvailable;
+   if rb>0 then begin
+     if length(buf)<br+rb then
+       setlength(buf,br+rb+1048576);
+     rb:=p.output.read(buf[br+1],rb);
+     br:=br+rb;
+   end
+   else sleep(1);
+ end;
+ setlength(buf,br);
+ rb:=p.output.numBytesAvailable;
+ while rb>0 do begin
+   setlength(buf,br+rb);
+   rb:=p.output.read(buf[br+1],rb);
+   br:=br+rb;
+   rb:=p.output.numBytesAvailable;
+ end;
+ text:=buf;
+ setlength(buf,0);
+ p.free;
+ for rb:=0 to count-1 do
+   self[rb]:=trim(self[rb]);
+ line:=0;
+ writeln(inttostr(count)+' Zeilen eingelesen');
+end;
+
+procedure tMyStringlist.saveToGz(const s: ansiString);
+var
+  p:     tProcess;
+  buf:   array of byte;
+  f:     file;
+  rb:    longint;
+  it:    tInputThread;
+const
+  outBufLen = 1024*1024;
+begin
+ p:=tProcess.create(nil);
+ p.executable:='/usr/bin/gzip';
+ p.parameters.add('--best');
+ p.parameters.add('-c');
+ p.options:=p.options + [poUsePipes];
+ p.execute;
+ setlength(buf,outBufLen);
+ fillchar(buf[0],length(buf)*sizeof(buf[0]),$0);
+ it:=tInputThread.create(p,self);
+ assignfile(f,s);
+ rewrite(f,1);
+ while p.running or (not it.fertig) or (p.output.numBytesAvailable>0) do begin
+   rb:=min(length(buf),p.output.numBytesAvailable);
+   if rb>0 then begin
+     rb:=p.output.read(buf[0],rb);
+     blockwrite(f,buf[0],rb);
+   end
+   else
+     sleep(1); // nix zu Schreiben, nix zu Lesen, also warten wir
+ end;
+ it.free;
+ closefile(f);
+end;
+
+function tMyStringlist.readln(out s: string): boolean;
+begin
+ result:=not eof;
+ if not result then begin
+   s:='';
+   exit;
+ end;
+ s:=self[line];
+ inc(line);
+end;
+
+procedure tMyStringlist.grep(expr: string);
+var
+  re: tRegExpr;
+  i:  longint;
+begin
+  re:=tRegExpr.create;
+  re.Expression:=expr;
+  for i:=count-1 downto 0 do
+    if not re.Exec(self[i]) then
+      delete(i);
+  re.free;
+end;
+
+function tMyStringlist.eof: boolean;
+begin
+ result:=line>=count;
+end;
+
+end.
+
diff --git a/pseudohadamard.pas b/pseudohadamard.pas
new file mode 100644
index 0000000..654dc0e
--- /dev/null
+++ b/pseudohadamard.pas
@@ -0,0 +1,59 @@
+unit pseudohadamard;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Gmp, Math;
+
+procedure pseudoHadamardTransformation(var daten: array of mpz_t; modul: mpz_t; invers: boolean); overload;
+procedure pseudoHadamardTransformation(var daten: array of mpz_t; Ordnung, Verschiebung: longint; modul: mpz_t; var buff: mpz_t; invers: boolean); overload;
+
+implementation
+
+procedure pseudoHadamardTransformation(var daten: array of mpz_t; modul: mpz_t; invers: boolean);
+var
+  buff: mpz_t;
+begin
+  if length(daten)<>round(power(2,round(ln(length(daten))/ln(2)))) then
+    raise Exception.create('Die Länge der Daten für eine Pseudohadamardtransformation muss eine Zweierpotenz sein! (und nicht '+inttostr(length(daten))+'!)');
+  mpz_init(buff);
+  pseudoHadamardTransformation(daten,length(daten),0,modul,buff,invers);
+  mpz_clear(buff);
+end;
+
+procedure pseudoHadamardTransformation(var daten: array of mpz_t; Ordnung, Verschiebung: longint; modul: mpz_t; var buff: mpz_t; invers: boolean);
+var
+  i: longint;
+begin
+  Ordnung:=Ordnung div 2;
+  if Ordnung>1 then
+    for i:=0 to 1 do
+      pseudoHadamardTransformation(daten,Ordnung,Verschiebung + i*Ordnung,modul,buff,invers);
+
+  if invers then begin
+    for i:=0 to Ordnung-1 do begin
+      mpz_set(buff,daten[Verschiebung+i]);
+      mpz_sub(daten[Verschiebung+i],daten[Verschiebung+i],daten[Verschiebung+i+Ordnung]);         // a = a' - b
+      mpz_mod(daten[Verschiebung+i],daten[Verschiebung+i],modul);
+
+      mpz_mul_ui(daten[Verschiebung+i+Ordnung],daten[Verschiebung+i+Ordnung],2);                  // b = 2*b'
+      mpz_sub(daten[Verschiebung+i+Ordnung],daten[Verschiebung+i+Ordnung],buff);                  // - a'
+      mpz_mod(daten[Verschiebung+i+Ordnung],daten[Verschiebung+i+Ordnung],modul);
+    end;
+  end
+  else
+    for i:=0 to Ordnung-1 do begin
+      mpz_set(buff,daten[Verschiebung+i]);
+      mpz_mul_ui(daten[Verschiebung+i],daten[Verschiebung+i],2);                                  // a' = 2 * a
+      mpz_add(daten[Verschiebung+i],daten[Verschiebung+i],daten[Verschiebung+i+Ordnung]);         // + b
+      mpz_mod(daten[Verschiebung+i],daten[Verschiebung+i],modul);
+
+      mpz_add(daten[Verschiebung+i+Ordnung],daten[Verschiebung+i+Ordnung],buff);                  // b' = a + b
+      mpz_mod(daten[Verschiebung+i+Ordnung],daten[Verschiebung+i+Ordnung],modul);
+    end;
+end;
+
+end.
+
diff --git a/randomunit.pas b/randomunit.pas
new file mode 100644
index 0000000..2b665f0
--- /dev/null
+++ b/randomunit.pas
@@ -0,0 +1,80 @@
+unit randomunit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+  tMersenneTwister = class
+  private
+    state: array[0..623] of longword;
+    index: longint;
+  public
+    procedure init(seed: longword);
+    function extract_number: longword;
+    function random(ma: longword): longword; overload;
+    function random: extended; overload;
+    procedure generate_numbers;
+  end;
+
+implementation
+
+// tMersenneTwister ************************************************************
+
+procedure tMersenneTwister.init(seed: longword);
+var
+  i: longint;
+begin
+ index:=0;
+ state[0]:=seed;
+ for i:=1 to 623 do
+   state[i]:=longword($ffffffff and (qword(1812433253) * qword(state[i-1] xor state[i-1] shr 30) + i)); // 0x6c078965
+end;
+
+function tMersenneTwister.extract_number: longword;
+begin
+ if index=0 then
+   generate_numbers;
+
+ result:=state[index];
+ result:=result xor (result shr 11);
+ result:=result xor longword(qword(result shl 7) and 2636928640);  // 0x9d2c5680
+ result:=result xor longword(qword(result shl 15) and 4022730752); // 0xefc60000
+ result:=result xor (result shr 18);
+
+ index := (index + 1) mod 624;
+end;
+
+function tMersenneTwister.random(ma: longword): longword;
+var
+  i: longword;
+begin
+ repeat
+   i:=extract_number;
+ until i<((high(longword)+1) div qword(ma))*ma;
+ result:=i mod ma;
+end;
+
+function tMersenneTwister.random: extended;
+begin
+ result:=(extract_number/(high(longword)+1) + extract_number)/(high(longword)+1);
+end;
+
+procedure tMersenneTwister.generate_numbers;
+var
+  i,y: longint;
+begin
+ for i:=0 to 623 do begin
+   y:=longint((state[i] and $80000000) or            // bit 31 (32nd bit) of MT[i]
+              (state[(i+1) mod 624] and $7fffffff)); // bits 0-30 (first 31 bits) of MT[...]
+   state[i]:=state[(i + 397) mod 624] xor (y shr 1);
+   if odd(y) then
+     state[i]:=longword(state[i] xor 2567483615); // 0x9908b0df
+ end;
+end;
+
+end.
+
diff --git a/systemunit.pas b/systemunit.pas
new file mode 100644
index 0000000..645f09e
--- /dev/null
+++ b/systemunit.pas
@@ -0,0 +1,123 @@
+unit systemunit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Math;
+
+function cpuUtilization: extended;
+function numCpus: int64;
+function momentanFreieCpus: int64;
+function belegterSpeicher: int64;
+function minCache: int64;
+
+implementation
+
+var _cpuLastUsed,_cpuLastIdle: int64;
+
+function cpuUtilization: extended;
+var
+  procstat:  textfile;
+  s:         string;
+  used,idle: int64;
+  i:         integer;
+begin
+  result:=0;
+  s:='';
+  assignfile(procstat,'/proc/stat');
+  reset(procstat);
+  while not eof(procstat) do begin
+    readln(procstat,s);
+    if pos('cpu ',s)=1 then break;
+  end;
+  closefile(procstat);
+  if pos('cpu ',s)<>1 then exit;
+  delete(s,1,pos(' ',s));
+  s:=trim(s);
+  used:=0;
+  idle:=0;
+  for i:=0 to 3 do begin
+    used:=used+idle;
+    idle:=strtoint(copy(s,1,pos(' ',s)-1));
+    delete(s,1,pos(' ',s));
+    s:=trim(s);
+  end;
+  result:=(used-_cpuLastUsed)/max(1,used-_cpuLastUsed + idle-_cpuLastIdle);
+  _cpuLastUsed:=used;
+  _cpuLastIdle:=idle;
+end;
+
+function numCpus: int64;
+var
+  procstat:  textfile;
+  s:         string;
+begin
+  result:=0;
+  s:='';
+  assignfile(procstat,'/proc/stat');
+  reset(procstat);
+  while not eof(procstat) do begin
+    readln(procstat,s);
+    if (pos('cpu',s)=1) and
+       (pos('cpu ',s)<>1) then
+      inc(result);
+  end;
+  closefile(procstat);
+end;
+
+function momentanFreieCpus: int64;
+begin
+  result:=floor(numCpus*(1-cpuUtilization));
+end;
+
+function belegterSpeicher: int64;
+var f:    textFile;
+    s:    string;
+begin
+ s:='/proc/'+inttostr(getProcessId)+'/smaps';
+ result:=0;
+ if not fileexists(s) then exit;
+ assignfile(f,s);
+ reset(f);
+ while not eof(f) do begin
+   readln(f,s);
+   if (leftStr(s,4)='Rss:') and (rightStr(s,3)=' kB') then begin
+     delete(s,1,4);
+     delete(s,length(s)-2,3);
+     s:=trim(s);
+     result:=result+strtoint(s);
+   end;
+ end;
+ closefile(f);
+end;
+
+function minCache: int64;
+var f:    textFile;
+    s:    string;
+begin
+ s:='/proc/cpuinfo';
+ result:=0;
+ if not fileexists(s) then exit;
+ assignfile(f,s);
+ reset(f);
+ while not eof(f) do begin
+   readln(f,s);
+   if (leftStr(s,10)='cache size') and (rightStr(s,3)=' kB') then begin
+     delete(s,1,pos(':',s));
+     delete(s,length(s)-2,3);
+     s:=trim(s);
+     if result=0 then result:=strtoint(s)
+     else result:=min(result,strtoint(s));
+   end;
+ end;
+ closefile(f);
+end;
+
+begin
+  _cpuLastUsed:=0;
+  _cpuLastIdle:=0;
+  cpuUtilization;
+end.
+