unit Unit0;
{
  This software has been designed and is CopyLefted
  by Han de Bruijn:
                          (===)
                         @-O^O-@
                          #/_\#
                           ###

  Least Squares best fit to a Hyperbola y = B/(x-A)
  of the Year/Light-speed data from relevant tables
  in * The Atomic Constants, Light, and Time *
  http://www.setterfield.org/report/report.html
}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Grafisch, tabellen, algemeen;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure Scheppen(Sender: TObject);
    procedure Toetsdruk(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  c0 : double = 299792.458;
  y0 : double = 1983;
var
  keer : integer;

procedure Gegevens(nummer : integer; var jaar,licht : lijst);
{
  Year/Light-speed data
}
begin
  case nummer of
   1: tabel1(jaar,licht);
   2: tabel2(jaar,licht);
   3: tabel4(jaar,licht);
   4: tabel5(jaar,licht);
   5: tabel6(jaar,licht);
   6: tabel7(jaar,licht);
   7: tabel8(jaar,licht);
   {: tabel9(jaar,licht);}
   8: tabel10(jaar,licht);
   9: tabel12(jaar,licht);
  10: tabel13(jaar,licht);
  11: tabel14(jaar,licht);
  12: tabel27(jaar,licht);
  13: tabel29(jaar,licht);
  end;
end;

procedure Plaatje(A : double; kleur : TColor);
var
  B,x,y : double;
  i,j : integer;
begin
  Form1.Image1.Canvas.Pen.Color := kleur;
  B := (y0-A)*c0;
  x := i2x(0);
  y := B/(x-A);
  j := y2j(y);
  Form1.Image1.Canvas.MoveTo(0,j);
  for i := 1 to Wijd-1 do
  begin
    x := i2x(i);
    y := B/(x-A);
    j := y2j(y);
    if x > A
    then Form1.Image1.Canvas.LineTo(i,j);
    if x <= A
    then Form1.Image1.Canvas.MoveTo(i,j);
  end;
  if A < xmin then Exit;
  if A > xmax then Exit;
  Form1.Image1.Canvas.Pen.Color := clBlack;
  Form1.Image1.Canvas.MoveTo(x2i(A),0);
  Form1.Image1.Canvas.LineTo(x2i(A),Hoog-1);
end;

procedure method1(jaar,licht : lijst);
{
  Least Squares best fit
  to hyperbola y=B/(x-A)
}
var
  N,k : integer;
  A,teller,noemer : double;
begin
  N := Length(jaar);
  teller:= 0;
  noemer := 0;
  for k := 0 to N-1 do
  begin
    if licht[k] = 0 then Continue;
  { Writeln(jaar[k],' ',licht[k]); }
    noemer := noemer + sqr(licht[k]/c0-1);
    teller := teller + (licht[k]/c0-1)*(licht[k]/c0*jaar[k]-y0);
  end;
  A := teller/noemer;
  if A < 0 then
    Writeln('Alpha = ',-A:6:0,' B.C.');
  Plaatje(A,clGreen);
end;

procedure method2(jaar,licht : lijst);
{
  Least Squares best fit
  to hyperbola y=B/(x-A)
}
var
  N,k : integer;
  A,waarde : double;
begin
  N := Length(jaar);
  waarde:= 0;
  for k := 0 to N-1 do
  begin
    if licht[k] = 0 then Continue;
  { Writeln(jaar[k],' ',licht[k]); }
    waarde := waarde + (licht[k]/c0*jaar[k]-y0)/(licht[k]/c0-1);
  end;
  A := waarde/N;
  if A < 0 then
    Writeln('Alpha = ',-A:6:0,' B.C.');
  Plaatje(A,clBlue);
end;

procedure method3(jaar,licht : lijst);
{
  Least Squares best fit
  to hyperbola y=B/(x-A)
}
var
  N,k : integer;
  A,x,y : double;
begin
  N := Length(jaar);
  x := 0; y := 0;
  for k := 0 to N-1 do
  begin
    if licht[k] = 0 then Continue;
  { Writeln(jaar[k],' ',licht[k]); }
    x := x + jaar[k]; y := y + licht[k];
  end;
  x := x/N; y := y/N;
  A := (y*x-c0*y0)/(y-c0);
  if A < 0 then
    Writeln('Alpha = ',-A:6:0,' B.C.');
  Plaatje(A,clRed);
end;

procedure Tekenen;
const
  delta : double = 1;
var
  i,j,L,k : integer;
  jaar,licht : lijst;
begin
  SetLength(jaar,0);
  SetLength(licht,0);
  Gegevens(keer,jaar,licht);
  L := Length(jaar);
  Form1.Image1.Canvas.Pen.Color := clBlack;
  Form1.Image1.Canvas.Pen.Width := 2;
{ Display Data }
  for k := 0 to L-1 do
  begin
    if licht[k] = 0 then Continue;
    i := x2i(jaar[k]);
    j := y2j(licht[k]);
    Form1.Image1.Canvas.Ellipse(i-3,j-3,i+3,j+3);
  end;
  method1(jaar,licht);
  method2(jaar,licht);
  method3(jaar,licht);
  Form1.Image1.Picture.SaveToFile('alleen'+Letterlijk(keer)+'.bmp');
end;

procedure TForm1.Scheppen(Sender: TObject);
begin
  ForceCurrentDirectory := true;
  keer := 1;
  TV(Form1.Image1);
  ClearDevice;
  xmin := 1600; xmax := 2000;
  ymin := 290000; ymax := 310000;
{ xmin := -100000; xmax := 2000;
  ymin := 290000; ymax := 3100000; }
  Tekenen; Writeln;
end;

procedure TForm1.Toetsdruk(Sender: TObject; var Key: Char);
begin
  ClearDevice;
  keer := keer + 1;
  if keer = 14 then Halt;
  Tekenen; Writeln;
end;

end.