[shkola] Reshenie na oshte edna ot wcherashnite zadachi

Eto reshenie na zadachata s rechnika ot wchera!
Otnowo ot Infoman!

Ivo

-- 
Ivaylo Riskov <ivaylo_riskov@xxxxxxx>

"Do not take life too seriously; you will never get out of it alive."

{ This is the input data:
insert the
check than
insert there
insert that
insert tree
insert threw
check three
check that
stop
                                 SHODNI DUMI
                                 -----------

   Kazwame, che dwe dumi sa shodni ako ot ednata ot tqh mozhe da se poluchi dru-
 gata chrez edno ot slednite dejstwiq:
    a) iztriwane na proizwolna bukwa
    b) razmqna na dwe posledowatelni bukwi
    c) zamqna na proizwolna bukwa s druga
 Daden e whoden fajl, kojto sxdxrzha na wseki red po edin operatorite:
    insert <word>
    check <word>
    stop
 Operatorxt insert wmxkwa w rechnika dumata <word> ako q nqma weche; stop prek-
 ratqwa obrabotkata na whodniq fajl i spira programata, a check prowerqwa da-
 li posochenata duma e weche w rechnika ili ako q nqma prowerqwa dali w nego nq-
 ma nqkoq shodna duma. Ako dumata q ima se otpechatwa dmata i 'YES'. Ako q nq-
 ma i w rechnika nqma shodni dumi se otpechatwa dumata i 'NO', a ako w rechnika
 dumatq q nqma, no tam ima shodni na neq dumi, se otpechatwa dumata, 'MAY BE'
 i wsichki shodni na neq dumi.
   REShENIE: Ponezhe mozhem da imame do 15000 dumi, shte gi sxhranqwame 
dinamichno
 i za wsqka duma shte zaemame tolkowa bajta pamet, kolkoto e dxlga tq + 1.  Ko-
 gato dobawqme duma, pretxrswame celiq rechnik i ako q nqma, q dobawqme. Koga-
 to prowerqwame duma, ako q ima, otpechatwame 'YES'.  Ako q nqma, prowerqwame
 za wsqka duma ot rechnika dali ne e shodna na wxprosnata duma. Ako sa namere-
 ni shodni dumi, te se otpechatwat,a inache se otpechatwa 'NO'. Prowerkata dali
 dwe dumi sa shodni se deli na 3 sluchaq:
     1. Ako dumite imat ednakxw broj bukwi, se namira pxrwata razlichna bukwa,
        prowerqwa se dali ako razmenim tekushtata sxs sledwashtata bukwa na 
duma-
        ta, taka poluchenite dwe bukwi shte sxwpadnat i ako sxwpadnat se prodxl-
        zhawa srawnenieto ot tekushtata poziciq+2 /sluchaj b)/.Ako li pxk ne 
sxw-
        padnat, prosto preskachame tekushtata bukwa /sluchaj c)/. Ako do kraq na
        srawnenieto do kraq na dwete dumi nqma drugi razliki, dumite sa shod-
        ni, a inache ne sa.
     2. Ako ednata duma ima edna bukwa poweche ot drugata,namirame pxrwata ne-
        sxwpadashta bukwa, preskachame q i prodxlzhawame srawnenieto.Ako do kraq
        nqma drugi razliki, dumite sa shodni, a inache ne sa.
     3. Ako ednata duma e po-dxlga ot drugata s dwa ili poweche simwola, dumi-
        te ne sa shodni.
 Algoritxma ima slozhnost ot porqdxka na broj_dumi_w_fajla * dxlzhina_na_fajla,
 koqto obache e za naj-loshiq sluchaj i nikoga ne se dostiga. Za sredniq sluchaj
 slozhnostta e mnogo po-malka.Ponezhe operaciite dobawqne na duma preobladawat
 pred operaciite za prowerka na duma, e neobhodimo dobawqneto i txrseneto na
 tochnite dumi da e bxrzo. Zatowa wmesto da sxhranqwame w lineen masiw nizowe-
 te w pametta,  mozhem da gi dxrzhim w dwoichno dxrwo i taka kogato txrsim dali
 edna duma weche q nqma,slozhnostta nqma da e N (do 15000*dxlzhina_na_fajla), a
 logN (do 14*dxlzhina_na_fajla).  Towa e sxshtestweno uskorenie pri mnogo golqm
 broj dumi i malko operacii za prowerka  ili pri operacii za prowerka, koito
 namirat tochnata duma w rechnika.  Realizaciqta na towa dwoichno i pri towa ba-
 lansirano dxrwo e realizirana w modula Objects na Turbo Pascal.  Obektxt se
 kazwa TSortedCollection  i na praktika e sortiran spisxk ot ukazateli, broq
 na koito ne e fiksiran i mozhe da se promenq dinamichno.  Pri dobawqne na ele-
 ment obektxt awtomatichno prawi dwoichno txrsene za da proweri dali elementxt
 weche go nqma i ako go nqma go dobawq s konstantna slozhnost.

}

USES Objects;

TYPE TBinaryStringTree = object(TSortedCollection)
       function Compare(Key1,Key2:pointer): integer; virtual;
     end;

Function TBinaryStringTree.Compare(Key1,Key2:pointer): integer;
Begin
  if string(Key1^) = string(Key2^) then Compare:= 0
  else if string(Key1^) > string(Key2^) then Compare:= 1
  else Compare:= -1;
End;


CONST InFileName = 'input2.6';

VAR W: TBinaryStringTree;
    F: Text;
    S: string;


Function FindExact(const S: string): boolean;
Var i: integer;
Begin
  FindExact:= W.Search(@S,i);
End;

Procedure DoInsert(const S:string);
Var NewS: Pstring;
Begin
  GetMem(NewS,length(S)+1); NewS^:=S;
  W.Insert(NewS);
End;

Function Similar(const S1,S2:string): boolean;
Var L1,L2,Poz: integer;
Begin
  L1:=length(S1); L2:=length(S2);
  if L1 = L2 then
    begin
      Poz:=1;
      while (Poz <= L1) and (S1[Poz] = S2[Poz]) do
        Inc(Poz);
      if Poz < L1 then
        if (S1[Poz] = S2[Poz+1]) and (S1[Poz+1] = S2[Poz]) then
          Inc(Poz);
      Inc(Poz);
      while (Poz <= L1) and (S1[Poz] = S2[Poz]) do
        Inc(Poz);
      Similar:= Poz > L1;
    end
  else if abs(L1-L2) = 1 then
    begin
      Poz:=1;
      while (Poz <= L1) and (S1[Poz] = S2[Poz]) do
        Inc(Poz);
      if L1 > L2 then
        begin
          while (Poz < L1) and (S1[Poz+1] = S2[Poz]) do
            Inc(Poz);
          Similar:= (Poz = L1);
        end
      else
        begin
          while (Poz < L2) and (S1[Poz] = S2[Poz+1]) do
            Inc(Poz);
          Similar:= (Poz = L2);
        end;
    end
  else Similar:=false;
End;

Procedure DoCheck(const S:string);
Var Found: boolean;
    i: integer;
Begin
  if FindExact(S) then
    begin WriteLn(S,' YES'); Exit; end;
  Found:=false;
  for i:= 0 to W.Count-1 do
    if Similar(S,string(W.At(i)^)) then
      begin
        if not Found then
          WriteLn(S,' MAY BE');
        WriteLn('     ',string(W.At(i)^));
        Found:=true;
      end;
  if not Found then
    WriteLn(S,' NO');
End;


BEGIN
  WriteLn;
  W.Init(4092,256);
  Assign(F,InFileName); Reset(F); ReadLn(F);
  repeat
    ReadLn(F,S);
readln(F);
    if S[1] = 's' then Break;
    if S[1] = 'i' then DoInsert(copy(S,8,255));
    if S[1] = 'c' then DoCheck(copy(S,7,255));
  until false;
  Close(F);
END.

Other related posts: