TAKMIČENJA IZ PROGRAMIRANJA


Sva pitanja, predloge ili primedbe u vezi sa takmičenjima iz programiranja možete slati na e-mail:

tak.prog@gmail.com

U toku perioda za žalbe, sve žalbe možete slati na ovaj isti e-mail.

kartice_hash.pas    2,376 b      izvorni kod rešenja
kartice_binary_search.pas    3,193 b      izvorni kod rešenja
kartice.checker.pas    615 b      program za testiranje
kartice.tests.rar    60,365 b      test primeri

zadatak: Bušene kartice

Profesor Đurić veoma voli da programira. Međutim, kako je uvek veoma zauzet, nije stigao da nauči ni jedan moderan programski jezik već još uvek programira bušeći kartice. To radi tako što uzme jednu praznu karticu (bez rupa) i potom buši jednu po jednu rupu, pri tome praveći sigurnosne provere nakon svake probušene rupe. Svaku sigurnosnu proveru profesor izvodi na sledeći način: Najpre načini identičnu kopiju kartice na kojoj radi. Potom tu kopiju stavi iznad originalne kartice tako da im se sve rupe poklope, a onda počne da je pomera, pri čemu pazi da je ne zarotira. Provera traje dok ne isproba sve moguće položaje gornje kartice u odnosu na donju. Rezultat provere je najveći broj rupa koje su se istovremeno poklopile (ne računajući početni položaj kada se sve rupe poklapaju). Pošto su sigurnosne provere profesoru dosadne za izvođenje, zamolio je vas da u nekom malo savremenijem programskom jeziku napišete program koji nalazi rezultate svih sigurnosnih provera.

Ulaz:

Ulazni podaci se učitavaju iz tekstualnog fajla kartice.in. U prvoj liniji ulaza nalazi se prirodan broj n, ukupan broj rupa koji profesor treba da probuši (1 ≤ n ≤ 3000). U svakom od narednih n redova nalaze se dva razmakom razdvojena cela broja x i y, koji predstavljaju koordinate rupe (-230 < x, y < 230). Rupe su date redom kojim ih profesor buši. Ne postoje dve rupe sa istim koordinatama.

Izlaz:

U izlazni tekstualni fajl kartice.out treba zapisati rezultate svih n sigurnosnih provera, u svakoj liniji po jedan, redom kojim su se provere izvodile.

Primer:

kartice.in      kartice.out
10	
5 1
4 2
3 1
3 3
2 2
1 1
4 3
5 3
5 4
6 2
        
0
1
1
2
3
3
3
4
5
6

Objašnjenje:

Na slici je prikazan izgled kartice nakon svih deset probušenih rupa i položaj kartica u sigurnosnoj proveri u kome ima najviše poklopljenih rupa.

rešenje


Označimo sve rupe brojevima od 1 do n po redu kojem ih je profesor Đurić bušio, a sa p[i] vektor koordinate i-te tačke.

Pretpostavimo da je profesor upravo izbušio k-tu rupu, i da treba odrediti rezultat sigurnosne provere za prvih k rupa.

Ako se gornja kartica translira za vektor t u odnosu na donju, doći će do poklapanja rupe i sa donje kartice i rupe j sa gornje ako i samo ako je p[i] - p[j] = t. Iz toga sledi da je maksimalan broj preklapanja jednak najvećem broju ponavljanja nekog vektora među svim vektorima iz multiskupa Tk = {p[i] - p[j] : 1 ≤ i, jk}

Ovo možemo brojati na više načina, a najefikasnije je da se multiskup predstavi pomoću heš tabele, i prilikom svake nove probušene rupe proširuje novim vektorima (vektori između nove i već postojećih rupa).

Obratite pažnju da nije potrebno pamtiti sve vektore, jer vektori t i -t uvek dolaze u paru, pe je dovoljno pamtiti samo jedan od njih. Zato uvedimo relaciju totalnog poretka među vektorima takvu da je ab ako i samo ako važi ((a.x < b.x) or ((a.x = b.x) and (a.yb.y))). Tada kada god posmatramo dve tačake p[i] i p[j] ubacićemo onaj od vektora p[i] - p[j] i p[j] -p[i] koji je veći od nula vektora.

Ako se napiše dobra heš funkcija, složenost rešenja je O(n2). Jedino je ovakvo rešenje moglo doneti maksimum bodova.

Zadatak je moguće rešiti i na nekoliko načina u vremenu O(n2 lg n).

Jedan od načina je da vektore koje formiraju sve rupe najpre sortiramo u niz i izbacimo duplikate. Potom idemo po rupama od prve probušene do poslednje, i za svaku nalazimo sve vektore koje ona formira sa do sada probušenim rupama. Sve te vektore binarnom pretragom nađemo u nizu i povećamo njima pridružen brojač za jedan.

fajl: kartice_hash.pas
const
  fin = 'kartice.in';
  fout = 'kartice.out';
  MaxN = 3000;


type
  TVector = record
    x, y : Longint;
  end;

  PHashEntry = ^THashEntry;
  THashEntry = record
    v : TVector;
    count : Integer;
    next : PHashEntry;
  end;


const
  zero : TVector = (x : 0; y : 0);
  hashSize = 19260479;


var
  n : Integer;
  p : array[1..MaxN] of TVector;

  sol : array[1..MaxN] of Integer;
  max : Integer;

  hash : array[0..HashSize-1] of PHashEntry;



  function Compare(const a, b : TVector) : Longint;
  begin
    Compare := a.x - b.x;
    if Compare = 0 then
      Compare := a.y - b.y;
  end;


  function Sub(const a, b : TVector) : TVector;
  begin
    Sub.x := a.x - b.x;
    Sub.y := a.y - b.y;
  end;


  function Rem(a, b : Longint) : Longint;
  begin
    if a > 0 then
      Rem := a mod b
    else
    begin
      Rem := (-a) mod b;
      if Rem > 0 then
        Rem := b - Rem;
    end;
  end;


  procedure Insert(const t : TVector);
  var
    k : Longint;
    p : PHashEntry;
  begin
    k := (7333 * Rem(t.x, 98467) + 9839 * Rem(t.y, 89783)) mod hashSize;

    p := hash[k];
    while (p <> nil) and (Compare(p^.v, t) <> 0) do
      p := p^.next;

    if p = nil then
    begin
      p := New(PHashEntry);
      p^.count := 0;
      p^.v := t;
      p^.next := hash[k];
      hash[k] := p;
    end;

    inc(p^.count);
    if p^.count > max then
      max := p^.count;
  end;


  procedure Solve;
  var
    i, j : Integer;
    t, h : TVector;
    k : Longint;
  begin
    for k := 0 to hashSize - 1 do
      hash[k] := nil;

    max := 0;
    for i := 1 to n do
    begin
      for j := 1 to i-1 do
      begin
        t := Sub(p[i], p[j]);
        if Compare(t, zero) < 0 then
          t := Sub(zero, t);

        Insert(t);
      end;
      sol[i] := max;
    end;
  end;


  procedure ReadInput;
  var
    f : Text;
    i : Integer;
  begin
    Assign(f, fin);
    Reset(f);
    Readln(f, n);
    for i := 1 to n do
      Readln(f, p[i].x, p[i].y);
    Close(f);
  end;


  procedure WriteOutput;
  var
    f : Text;
    i : Integer;
  begin
    Assign(f, fout);
    Rewrite(f);
    for i := 1 to n do
      Writeln(f, sol[i]);
    Close(f);
  end;



begin
  ReadInput;
  Solve;
  WriteOutput;
end.
fajl: kartice_binary_search.pas
const
  fin = 'kartice.in';
  fout = 'kartice.out';
  MaxN = 3000;
  MaxM = (MaxN * (MaxN - 1)) DIV 2;


type
  TVector = record
    x, y : Longint;
  end;

  TListEntry = record
    v : TVector;
    count : Integer;
  end;


const
  zero : TVector = (x : 0; y : 0);


var
  n : Integer;
  p : array[1..MaxN] of TVector;

  max : Integer;
  sol : array[1..MaxN] of Integer;

  m : Longint;
  list : array[1..MaxM] of TListEntry;



  function Compare(const a, b : TVector) : Longint;
  begin
    Compare := a.x - b.x;
    if Compare = 0 then
      Compare := a.y - b.y;
  end;


  function Sub(const a, b : TVector) : TVector;
  begin
    Sub.x := a.x - b.x;
    Sub.y := a.y - b.y;
  end;


  procedure QuickSort;
  var
    p : TVector;
    tmp : TListEntry;

    procedure Sort(l, r : Longint);
    var
      i, j : Longint;
    begin
      i := l;
      j := r;
      p := list[(l + r) DIV 2].v;

      repeat
        while Compare(list[i].v, p) < 0 do inc(i);
        while Compare(list[j].v, p) > 0 do dec(j);
        if i <= j then
        begin
          tmp := list[i];
          list[i] := list[j];
          list[j] := tmp;
          inc(i);
          dec(j);
        end;
      until i > j;

      if (l < j) then Sort(l, j);
      if (i < r) then Sort(i, r);
    end;

  begin
    Sort(1, m);
  end;


  procedure Solve;
  var
    i, j : Integer;
    t : TVector;
    k, l : Longint;
    a, b, mid : Longint;
    c : Longint;
    found : Boolean;
  begin
    m := 0;

    for i := 1 to n - 1 do
      for j := i + 1 to n do
      begin
        t := Sub(p[i], p[j]);
        if Compare(t, zero) < 0 then
          t := Sub(zero, t);

        inc(m);
        list[m].v := t;
        list[m].count := 0;
      end;

    QuickSort;

    l := 1;

    for k := 2 to m do
      if Compare(list[k].v, list[l].v) <> 0 then
      begin
        inc(l);
        list[l] := list[k];
      end;

    max := 0;

    for i := 1 to n do
    begin
      for j := 1 to i-1 do
      begin
        t := Sub(p[i], p[j]);
        if Compare(t, zero) < 0 then
          t := Sub(zero, t);

        a := 1;
        b := l;

        found := false;
        while not found do
        begin
          mid := (a + b) div 2;

          c := Compare(list[mid].v, t);
          if c < 0 then
            a := mid + 1
          else
            if c > 0 then
              b := mid - 1
            else
              found := true;
        end;

        inc(list[mid].count);
        if list[mid].count > max then
          max := list[mid].count;
      end;
      sol[i] := max;
    end;
  end;


  procedure ReadInput;
  var
    f : Text;
    i : Integer;
  begin
    Assign(f, fin);
    Reset(f);
    Readln(f, n);
    for i := 1 to n do
      Readln(f, p[i].x, p[i].y);
    Close(f);
  end;


  procedure WriteOutput;
  var
    f : Text;
    i : Integer;
  begin
    Assign(f, fout);
    Rewrite(f);
    for i := 1 to n do
      Writeln(f, sol[i]);
    Close(f);
  end;



begin
  ReadInput;
  Solve;
  WriteOutput;
end.