Zadatak 1.

type
  TMat = array[1..100,1..100] of integer;

const
  ip : array[1..8] of integer = ( 0, 1, 1, 1, 0,-1,-1,-1);
  jp : array[1..8] of integer = ( 1, 1, 0,-1,-1,-1, 0, 1);

var
  a : TMat;
  n, m : integer;
  rez : real;

procedure Ucitaj;
var
  i, j : integer;
  f : Text;
begin
  Assign(f,'zad1.in');
  Reset(f);
  ReadLn(f,n,m);
  for i := 1 to n do
    for j := 1 to m do
      Read(f,a[i,j]);
  Close(f);
end;

procedure Stampaj;
var
  f : Text;
begin
  Assign(f, 'zad1.out'); Rewrite(f);
  WriteLn(f,rez:8:2);
  Close(f);
end;

function moze(i, j : integer) : boolean;
begin
  moze := (1 <= i) and (i <= n) and (1 <= j) and (j <= m);
end;

procedure odredi(x,i,j : integer;var p,q : integer);
begin
  p := 0; q := 0;
  if moze(i,j) then
    begin
      p := 1;
      if (x > a[i,j]) then q := 1;
    end;
end;

procedure Resi;
var
  i, j, k, p, q, s, b : integer;
  suma, br : integer;
begin
  suma := 0; br := 0;
  for i := 1 to n do
    for j := 1 to m do
      begin
        s := 0; b := 0;
        for k := 1 to 8 do
          begin
            odredi(a[i,j],i+ip[k],j+jp[k],p,q);
            s := s + p;
            b := b + q;
          end;
        if (b/s >= 0.5) then
          begin
            suma := suma + a[i,j];
            br := br + 1;
          end;
      end;
  if br > 0 then rez := suma / br
  else rez := 0;
end;

begin
  Ucitaj;
  Resi;
  Stampaj;
end.

Zadatak 2.

type
  TNizS = array[1..1000] of string;

var
  rec : TNizS;
  s : string;
  n, i, j, br : integer;
  f, g : Text;

function Palindrom(s : string) : boolean;
var
  i, d : integer;
  p : boolean;
begin
  p := True;
  d := Length(s);
  i := 1;
  while p and (i <= d div 2) do
    if (s[i] <> s[d+1-i]) then p := False
    else i := i+1;
  Palindrom := p;
end;

function BezBlanko(s : string) : string;
var
  i : integer;
  r : string;
begin
  r := '';
  for i := 1 to Length(s) do
    if s[i]<>' ' then r := r + s[i];
  BezBlanko := r;
end;

begin
  Assign(f,'zad2.in'); Reset(f);
  Assign(g,'zad2.out'); Rewrite(g);
  ReadLn(f,n);
  br := 0;
  for i := 1 to n do
    begin
      ReadLn(f,s);
      if Palindrom(BezBlanko(s)) then
        begin
          br := br + 1;
          rec[br] := s;
        end;
    end;
  for i := 1 to br - 1 do
    for j := i + 1 to br do
      if (length(rec[i]) > length(rec[j])) or ((length(rec[i])=length(rec[j]))and(rec[i]>rec[j])) then
        begin
          s := rec[i]; rec[i] := rec[j]; rec[j] := s;
        end;
  for i := 1 to br do
    WriteLn(g,rec[i]);
  Close(f); Close(g);
end.

Zadatak 3.

type
  PSlog = ^TSlog;
  TSlog = record
            info : longint;
            sled : PSlog;
          end;

var
  koren, pom : PSlog;
  f : file of longint;
  g : Text;
  n, i, x, brojac: longint;

procedure Dodaj(x : longint; var koren : PSlog);
var
  pom, pret, novi : PSlog;
begin
  brojac := 0;
  new(novi); novi^.info := x; novi^.sled := nil;
  if (koren = nil) or (x <= koren^.info) then
    begin
      novi^.sled := koren;
      koren := novi;
    end
  else
    begin
      pom := koren;
      pret := nil;
      while (brojac <= n) and (pom <> nil) and (x > pom^.info) do
        begin
          brojac := brojac+1;
          pret := pom;
          pom := pom^.sled;
        end;
      if (brojac <= n) then
        begin
          novi^.sled := pom;
          pret^.sled := novi;
        end;
    end;
end;

begin
  Assign(f,'zad3.in'); Reset(f);
  Assign(g,'zad3.out'); Rewrite(g);

  Read(f,n);
  koren := nil;

  while (not eof(f)) do
    begin
      Read(f,x);
      Dodaj(x, koren);
    end;
  i := 1;
  pom := koren;
  while i < n do
    begin
      pom := pom^.sled;
      i := i+1;
    end;
  WriteLn(g,pom^.info);
  Close(f); Close(g);
end.