Program harmadik_beadando;
{Pontosabban: 1 evf., 2.felev, egyetlen beadando}
{Irta: Szamoskozi Peter,
gyak.vez.: H-ne Bakonyi Viktoria}

uses crt;
type TlistaelemMut=^Tlistaelem;
     telem=real;
     TlistaElem=record
         ertek:telem;
         oszlop,sor:integer;
         sorkov, oszlopkov:TlistaElemMut;
         end;
     Tlista=object
         fej:TlistaelemMut;
         akt:TlistaelemMut;
         hiba:boolean;
         procedure ures;
         function ures_e:boolean;
         function eleje_e:boolean;
         procedure elejere;
         procedure kovetkezore;
         procedure elemodosit(e:telem);
         function elemertek:telem;
         function vege_e:boolean;
         function hibas_e:boolean; end;

const nmax=100;
var lista:tlista; {A "fo" lista}
f:text;  {file-olvas}
f2:text; {file-ir}
f3:text; {screen-ir}
i,j:integer;
q:real; {A Leslie-hez kell, ez lesz a "minta"}
elem:Telem;
n:integer; {A matrix meretehez kell majd}
ok:integer; be:string; {A matrix meretenek beolvasasahoz, hogy "szam" legyen}
{------- Itt kezdodnek a lista muveletei -------}
procedure tlista.ures;
begin
fej:=nil; akt:=nil; hiba:=false;
end;

function tlista.ures_e:boolean;
begin
ures_e:=(fej=nil);
end;

function tlista.eleje_e:boolean;
begin
eleje_e:=( (not(ures_e)) and ((akt^.oszlop=1) and (akt^.sor=1)) );
end;

procedure tlista.elejere;
begin
akt:=fej;
end;

function tlista.vege_e:boolean;
begin
if ures_e then hiba:=true
else vege_e:=(akt^.sorkov=nil);
end;

procedure tlista.elemodosit(e:telem);
begin
if ures_e then hiba:=true
else akt^.ertek:=e;
end;

Function Tlista.elemertek:telem;
Begin
 if ures_e then hiba:=true
 else elemertek:=akt^.ertek;
End;

function tlista.hibas_e:boolean;
begin
hibas_e:=hiba;
hiba:=false;
end;

procedure tlista.kovetkezore;
begin
if ures_e then hiba:=true
     else if vege_e then hiba:=true else akt:=akt^.sorkov;
end;
{Lista muveleteinek vege}
{Matematikai fuggvenyek eleje}
function hatvany(alap:real; kitevo:integer):real;
var seged: real;
    i:integer;
begin
  seged:=1;
  If kitevo<>0 then for i:=1 to kitevo do seged:=seged*alap;
  hatvany:=seged;
end;

function gyok(a:real; k:integer):real;
const pontossag=1E-8;
var x0,x1 : real; jel: char;
begin
  { kiirjuk a(z)  kûa = }  {Az "û" a gyokkitevo eleje lenne...}
  {GotoXY(10,7); Write(k:2,' ____________');
   GotoXY(10,8); Write('  û',a:13:10,' = '); }
  x0:=1; x1:=a;
  { ismetlunk amig el nem erjuk a kivant pontossagot }
  while Abs(x0-x1)>pontossag do
    begin
      x0:=x1;  {Az "a" ertekere allitja}
      x1:=(k-1)*x0+a / (hatvany(x0,k-1)*k);
    end;
{  Writeln(x1:2:10); - az k-adik gy”k ki¡r sa }
  { v rakoz s }
  gyok:=x1
end;
{------- A matematikai fuggvenyek vege -------}

{------- File-muveletek eleje -------}
Function Letezik_e(FileName: string): Boolean;
Var
  f: file;
Begin
  {$I-}
  Assign(f, FileName);
  Reset(f);
  Close(f);
  {$I+}
  Letezik_e:= (IOResult = 0) and (FileName <> '');
End;

Procedure megnyit(var f:text; fn:string; melyik:boolean);
Begin
 {$I-}
 If melyik then begin
                 assign(f,fn);
                 reset(f);
                end
           else begin
                 assignCrt(f);
                 reset(f);
                end;
End;

Procedure megnyitir(var f:text; fn:string; melyik:boolean);
Begin
 {$I-}
 If melyik then begin
                 assign(f,fn);
                 rewrite(f);
                end
           else begin
                 assignCrt(f);
                 rewrite(f);
                end;
End;
{------- File-muveletek vege -------}
Function mibol_olvas:boolean;
var ch:char; melyik:boolean;
begin
Write('(F) jlbol, vagy (B)illentyûzetr‹l k¡v n olvasni/¡rni? ');
repeat ch:=readkey;
{$I-}
until ch in['B','b','F','f'];
writeln(ch);
if (ch='f') or (ch='F') then Begin
                               repeat
                                melyik:=true;
                                write('Filen‚v? ');
                                readln(be);
                               until ((letezik_e(be)) and (length(be)<=12));
                               megnyit(f,be,melyik);
                               repeat
                                 write('Kimeno filenev? ');
                                 readln(be);
                               until (length(be)<=12);
                               megnyitir(f2,be,melyik);
                             End
                        else Begin
                               melyik:=false;
                               be:='out.txt';
                               megnyit(f,be,melyik);
                               megnyitir(f2,be,melyik);
                             End;
megnyitir(f3,be,false);
end;

{--------Matrix feltoltese-----------}

Procedure matrixlista(n:integer);
Var oszlop:array [1..nmax] of TlistaElemMut;
    uj:TlistaElemmut;
    e:telem; {Ezt olvassa be}
    osszeg:telem; {A matrix soroszege}
    i,j:integer;
    joe:boolean;
  Procedure beolvas(i,j:integer; var e:telem);
  Begin
    Write(f2,'Be:',i,'.sor ',j,'.oszlop erteket (max: ',1-osszeg,' ): ');
    Readln(f,e);
  End;
Begin
 writeln(f2,'A matrix sorosszegenek 1-nek kell lennie'); writeln;
 For i:=1 to n do
  Begin
  osszeg:=0;
   For j:=1 to n+1 do
    Begin
      If osszeg<1 then begin
        repeat
         joe:=true;
         Beolvas(i,j,e);
         If osszeg+e<=1 then osszeg:=osszeg+e
				else joe:=false;
        until joe;
        If e<>0 then begin
          new(uj);
          uj^.sor:=i;
          uj^.oszlop:=j;
          uj^.ertek:=e;
          If lista.fej=nil then begin lista.fej:=uj;
                                      q:=uj^.ertek; end
                           else lista.akt^.sorkov:=uj;
          If oszlop[j]=nil then oszlop[j]:=uj
                           else Begin
                              oszlop[j]^.oszlopkov:=uj;
                              oszlop[j]:=uj;
                           end;
          lista.akt:=uj;
         End;
      End;
    End;
    If osszeg<1 then lista.akt^.ertek:=1-(osszeg+lista.elemertek);
  End;
  lista.akt^.sorkov:=nil;
  lista.akt^.oszlopkov:=nil;
  For i:=1 to n+1 do oszlop[i]^.oszlopkov:=nil;
writeln(f2);
writeln(f2,'A matrixnak megfelelo uzenet:');
End;
{------- Matrix feltoltesenek vege -------}
{------- A Leslie-s fuggveny kezdete -------}
Function leslie(const i,j:integer; q:real):real;
var kif:integer;
begin
  kif:=( (i+1) mod 2 );
  if (j=1) then leslie:=hatvany(q,kif)
    else if (j=i+1) then leslie:=gyok( 1-hatvany(q,(i mod 2)), (i mod 2) )
      else leslie:=0;
end;
{------- A Leslie-s fuggveny vege -------}

{------- Ellenorzo eljarasok eleje -------}
Function osszehasonlit(const a,b:Telem):boolean;
begin
  if (a=b) then osszehasonlit:=true
  else osszehasonlit:=false;
end;

Function ellenorzes(lista:Tlista):boolean;
begin
  lista.elejere;
  While
( osszehasonlit (lista.akt^.ertek,leslie(lista.akt^.sor,lista.akt^.oszlop,q) )
   or not(lista.vege_e)) do begin
     lista.kovetkezore; end;
end;
{------- Ellenorzo eljarasok vege -------}
{------- A "cim" eljaras -------}
Procedure cim;
begin
clrscr;
gotoxy(20,1); writeln(f2,'Leslie-e matrix-vizsgalo program');
gotoxy(18,3); writeln(f2,'Irta: Szamoskozi Peter - 2000. aprlis');
writeln(f2); writeln(f2);
writeln(f2,'Mj.: Ha Leslie -> "Leslie-matrix"');
writeln(f2,'     Ha nem ----> "Runtime error 200 at 0000:0259"');
writeln(f2);
end;
{------- A "cim" eljaras vege -------}
{------- A foprogram kezdete -------}
begin
clrscr;
 mibol_olvas;
  cim;
 repeat
   write(f2,'Mekkora lesz a matrix (n) --> (n*(n+1))? '); readln(f,be);
   val(be,n,ok);
 until (ok=0);
matrixlista(n);
if ellenorzes(lista) then writeln(f2,'Leslie-matrix')
else writeln(f2,'Nem Leslie');
write(#07);
end.