Cod sursa(job #409909)

Utilizator jednakostjedss na kost jednakost Data 3 martie 2010 22:11:05
Problema Al k-lea termen Fibonacci Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.32 kb
{FP}
{$M 64000000,0}
{$MODE OBJFPC}
{$IFDEF ANHDQ}
  {$INLINE OFF}
  {$H-,I+,Q+,R+,S+}
{$ELSE}
  {$INLINE ON}
  {$H+,I-,Q-,R-,S-}
{$ENDIF}

// Result:
program kfib_AnhDQ;

const
  FI_NAME = 'kfib.in';
  FO_NAME = 'kfib.out';
  Radix   = 666013;

type
  Matrix = array[0..1, 0..1] of Int64;

var
  k: LongInt;
  M: Matrix;
(*------------------------------*)
  operator * (m1, m2: Matrix) m: Matrix; inline;
  begin
    m[0][0] := (m1[0][0] * m2[0][0] + m1[0][1] * m2[1][0]) mod Radix;
    m[0][1] := (m1[0][0] * m2[0][1] + m1[0][1] * m2[1][1]) mod Radix;
    m[1][0] := (m1[1][0] * m2[0][0] + m1[1][1] * m2[1][0]) mod Radix;
    m[1][1] := (m1[1][0] * m2[0][1] + m1[1][1] * m2[1][1]) mod Radix;
  end;
(*------------------------------*)
  function Pow(x: LongInt): Matrix; inline;
  begin
    if x = 1 then exit(M);
    result := Pow(x shr 1);
    result := result * result;
    if x and 1 = 1 then result := result * M;
  end;
(*------------------------------*)
begin
  Assign(Input, FI_NAME); Reset(Input);
  Assign(Output, FO_NAME); Rewrite(Output);
  read(k);
  case k of
    0: WriteLn(0);
    1: WriteLn(1);
    2: WriteLn(1);
  else begin
         M[0][0] := 0;
         M[0][1] := 1;
         M[1][0] := 1;
         M[1][1] := 1;
         WriteLn(Pow(k - 1)[1][1]);
       end;
  end;
end.