Sign In
Create Account
Follow Us on Twitter
Subscribe on Youtube
I made a program in pascal for school, and there is a mistake when i'm running it. I can't figure out what and where is the mistake. Please help me in finding it out. Here's the problem:
Quote
More sequences of natural numbers are read. Reading a sequence ends when reading “0” number, and reading all sequences ends with reading the empty sequence. For each sequence print the longest subsequence of consecutive related numbers. Two numbers are related if their writings in basis 10 have at least two distinct digits. E.g., 13678 and 8759 are related, and 123 and 65482 are not). Print all the numbers found in all sequences, without printing a number twice (determine whether two numbers are related, determine the longest sequence, add a number to a given sequence if not already there).
And here is my attempt in resolving this problem. I don't know where is the mistake:
type vector=array[1..30] of string;
var x,z:vector;
n,m,i,max,pmax,ok:integer;
procedure reading(var x:vector; var n:integer);
var i,j:integer;
s:string[10];
begin
writeln('Give the sequence: ');
read(s);
i:=1;
repeat
for j:=1 to length(s) do
if s[j]<>'0' then
x[i]:=x[i]+s[j]
else
i:=i+1;
until x[i-1]='';
n:=i-2
end;
function maxim(a,b:string):string;
begin
if length(a)>length(b) then
maxim:=a
else
maxim:=b
end;
function related(a,b:string):boolean;
var v:array[1..9] of integer;
i,j,c:integer;
aux:string;
begin
c:=0;
for i:=1 to 9 do
v[i]:=0;
related:=false;
if maxim(a,b)=b then
begin
aux:=a;
a:=b;
b:=aux
end;
for i:=1 to length(a) do
begin
if v[ord(a[i])-48]<>1 then
begin
v[ord(a[i])-48]:=1;
for j:=1 to length(b) do
if a[i]=b[j] then
begin
c:=c+1;
break
end;
if c=2 then
begin
related:=true;
break
end
end
end
end;
procedure sequence(x:vector; n:integer; var max,pmax:integer);
var i,j,c,nr1,nr2:integer;
begin
max:=1;
pmax:=1;
j:=1;
for i:=1 to n-1 do
if related(x[i],x[i+1]) then
begin
val(x[i],nr1,c);
val(x[i+1],nr2,c);
if nr2=nr1+1 then
j:=j+1
else
if j>max then
begin
max:=j;
pmax:=i-max+1;
j:=1
end;
end
else
if j>max then
begin
max:=j;
pmax:=i-max+1;
j:=1;
end
end;
procedure add(a:string; var z:vector; var m:integer);
var i:integer;
begin
for i:=1 to m do
if a=z[i] then
break
else
begin
z[m]:=a;
m:=m+1;
end;
end;
procedure printing(x:vector; pmax,max:integer);
var i:integer;
begin
writeln('Longest sequence : ');
for i:=pmax to pmax+max-1 do
begin
write(x[i],' ');
add(x[i],z,m)
end;
readln
end;
procedure final(z:vector;m:integer);
var i:integer;
begin
writeln('All the sequences: ');
for i:=1 to m-1 do
write(z[i],' ');
end;
function execution:integer;
var nr:integer;
begin
writeln('1.Give a sequence: ');
writeln('2.Exit');
read(nr);
execution:=nr;
end;
begin
m:=1;
repeat
ok:=execution;
if ok=1 then
begin
reading(x,n);
sequence(x,n,max,pmax);
printing(x,pmax,max);
end
else
exit
until ok=2;
readln;
end.
Thanks you very much!
Back to top
