Please give me some tests? on which my program is wrong! PROBLEM 1002
Only don's tell me about arrays size, because mistakes is not here...
This is my program:
Program t1002;
Const alp:array ['a'..'z'] of char=
('2','2','2','3','3','3','4','4','1',
'1','5','5','6','6','0','7','0'
,'7',
'7','8','8','8','9','9','9','0'
);
Var t :string[100];
s :string[50];
c,ans :array [1..100,1..2] of longint;
b :array [1..10{0},1..50] of string[50];
ok :boolean;
MaxLength :byte;
n,i,j,q,count,k:longint;
Procedure Entry;
Begin
For j:=1 to (Length(t)-Length(s)+1) Do
If (s[1]=t[j]) or (alp[s[1]]=t[j]) Then
Begin
ok:=true;
For q:=1 to Length(s) Do
If (s[q]<>t[j-1+q]) and (alp[s[q]]<>t[j-1+q]) Then
Begin
ok:=false;
Break;
End;
If ok Then
b[j,Length(s)]:=s;
End;
End;
Procedure Solve(u:byte);
Var w:byte;
Begin
If k<count Then
Begin
If u>Length(t) Then
Begin
If k<count Then
Begin
count:=k;
For i:=1 to count Do
Begin
ans[i,1]:=c[i,1];
ans[i,2]:=c[i,2];
End;
End;
End
Else
Begin
For w:=MaxLength downto 1 Do
If b[u,w]<>'' Then
Begin
Inc(k);
c[k,1]:=u;
c[k,2]:=w;
Solve(u+w);
Dec(k);
End;
End;
End;
End;
Procedure Out;
Begin
If count=54321 Then
WriteLn('No solution.')
Else
Begin
For i:=1 to (count-1) Do
Write(b[ans[i,1],ans[i,2]],' ');
WriteLn(b[ans[count,1],ans[count,2]]);
End;
End;
Procedure Input;
Begin
While true Do
Begin
ReadLn(t); If t='-1' Then Halt;
ReadLn(n);
maxLength:=0;
For i:=1 to Length(t) Do
For j:=1 to 50 Do
b[i,j]:='';
While n>0 Do
Begin
Dec(n);
ReadLn(s);
If Length(s)>MaxLength Then
MaxLength:=Length(s);
Entry;
End;
count:=54321;
k:=0;
Solve(1);
Out;
End;
End;
Begin
Input;
End.