ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1002. Телефонные номера

Can anymone tell me why thid piece of code for 1002 gives Memory Limit Error
Послано Alexander Mavrov 15 сен 2001 18:33
{----Here Goes Code----}
Type TWord = record
               Len : Integer;
           Ofs : LongInt;
         End;
Var M : array['a'..'z'] of Char;
    W : array[1..50000] of TWord;
    min : array[1..100] of LongInt;
    prev : array[1..100] of LongInt;
    pData : packed array[0..350000] of Char;
    BP : LongInt;
    Num : String[100];
    LenN : Integer;
    St : String;
    N,i,j : LongInt;

Function Fits(Nu:LongInt;Pos:Integer):Boolean;
Var x1,x2:Integer;
Begin
  If (Pos+W[Nu].Len-1)<=LenN Then
  Begin
    x1:=0;x2:=Pos;
    While x1<W[Nu].Len do
    Begin
      If m[pData[W[Nu].Ofs+x1]]<>Num[x2] Then
      Begin
        Fits:=False;
        Exit;
      End;
      Inc(x1);Inc(x2);
    End;
    Fits:=True;
    Exit;
  End;
End;

Procedure PrintWord(x : LongInt);
Var t :Integer;
Begin
  For t:=1 to W[x].Len do
    Write(pData[W[x].Ofs+t-1]);
End;

Procedure RevWords(z : Integer);
Begin
  If z>0 Then
  Begin
    RevWords(z-W[prev[z]].Len);
    PrintWord(prev[z]);
    If z<LenN Then Write(' ');
  End;
End;

Begin
  m['a']:='2';m['b']:='2';m['c']:='2';
  m['d']:='3';m['e']:='3';m['f']:='3';
  m['g']:='4';m['h']:='4';
  m['i']:='1';m['j']:='1';
  m['k']:='5';m['l']:='5';
  m['m']:='6';m['n']:='6';
  m['o']:='0';
  m['p']:='7';
  m['q']:='0';
  m['r']:='7';m['s']:='7';
  m['t']:='8';m['u']:='8';m['v']:='8';
  m['w']:='9';m['x']:='9';m['y']:='9';
  m['z']:='0';
  Repeat
{---------Zeroing arrays------------------}
    For i:=1 to 100 do min[i]:=1000000;
    FillChar(prev,SizeOf(prev),0);
    BP:=0;
{---------Reading Input-------------------}
    Readln(Num);
    If Num='-1' Then Halt(0);
    LenN:=Length(Num);
    Readln(N);
    For i:=1 to N do
    Begin
      Readln(St);
      W[i].Len:=Length(St);
      W[i].Ofs:=BP;
      For j:=1 to W[i].Len do
        pData[BP+j-1]:=St[j];
      Inc(BP,W[i].Len);
    End;
{--------Doing Something-------------------}
    For i:=1 to N do
      If Fits(i,1) Then
      Begin
        min[W[i].Len]:=1;
    prev[W[i].Len]:=i;
      End;
    For i:=1 to LenN-1 do
      If prev[i]<>0 Then
        For j:=1 to N do
      If Fits(j,i+1) Then
        If min[i]<min[i+W[j].Len] Then
        Begin
          min[i+W[j].Len]:=min[i]+1;
          prev[i+W[j].Len]:=j;
        End;
{--------Checking Result-------------------}
    If prev[LenN]=0 Then Writeln('No solution.')
    Else
    Begin
      RevWords(LenN);
      Writeln;
    End;
  Until False;
End.