chuongpro1106
06-10-2010, 11:25
Nhờ các bạn test giúp mình với
PROGRAM dong_nuoc;
USES crt;
TYPE contro=^banghi;
banghi=record
lon:integer;
be:integer;
sohieu:integer;
truoc:integer;
link:contro;
end;
var
p,q:contro;
a:banghi;
m,n,k:integer;
procedure nhap;
begin
write('Nhap nuoc ban dau cho binh lon: ');
readln(a.lon);
write('Nhap nuoc ban dau cho binh be: ');
readln(a.be);
write('Nhap the tich binh lon: ');
readln(m);
write('Nhap the tich binh be: ');
readln(n);
write('Nhap luong nuoc can dong: ');
readln(k);
readln;
end;
procedure push(q:contro; a:banghi);
var l,p:contro;
begin
new(p);
p^.lon:=a.lon;
p^.be:=a.be;
p^.link:=nil;
if(q=nil)then q:=p
else begin
l:=q;
while (l^.link<>nil) do l:=l^.link;
l^.link:=p;
end;
end;
procedure pop(q:contro; a:banghi);
var p:contro;
begin
p:=q;
a.lon:=q^.lon;
a.be:=q^.be;
a.sohieu:=q^.sohieu;
a.truoc:=q^.truoc;
q:=q^.link;
dispose(p);
end;
function chuatham(q:contro; a:banghi):boolean;
var p:contro;
begin
p:=q;
while(p<>nil) and ((p^.lon<>a.lon) or (p^.be<>a.be))do
p:=p^.link;
if((p^.lon=a.lon) or (p^.be=a.be))then
chuatham:=false
else chuatham:=true;
end;
procedure inkq(q:contro);
var p:contro;
begin
p:=q;
while(p<>nil) do
begin
write('(',p^.lon,',',p^.be,')->');
p:=p^.link;
end;
end;
procedure dongnuoc(a:banghi; m,n,k:integer);
var p,q:contro;
b:banghi; i,s,w,f,z,v,t,h,g,c,r:integer;
begin
q:=nil; p:=nil;
push(p,a);push(p,a);
{for i:=1 to 6 do
case i of}
while ((a.lon <>k) or (a.be<>k)) do
begin
{1:} begin
write('Do vao lon:');
a.lon:=m;
s:=a.be;
a.be:=a.be;
writeln(m,',',s);
end;
{2:} begin
write('Do vao be: ');
w:=a.lon;
a.be:=n;
writeln(w,',',n);
end;
{3:} begin
write('Do lon ra: ');
a.lon:=0;
f:=a.lon;
a.be:=a.be;
z:=a.be;
writeln(f,',',z);
end;
begin {them vao de thu}
write('Do be sang lon: ');
if (a.lon+a.be<=m) then
begin
a.lon:=m;
c:=a.lon;
a.be:=0;
r:=a.be;
end
else begin
a.lon:=m;
c:=a.lon;
a.be:=a.lon+a.be-m;
r:=a.be;
end;
writeln(m,',',s);
end; {den day}
{4:} begin
write('Do be ra: ');
a.lon:=a.lon;
v:=a.lon;
a.be:=0;
t:=a.be;
writeln(v,',',t);
end;
{5:} begin
write('Do lon sang be: ');
if (a.lon+a.be<=n) then
begin
a.lon:=0;
h:=a.lon;
a.be:=n;
g:=a.be;
end
else begin
a.lon:=a.lon+a.be-n;
h:=a.lon;
a.be:=n;
g:=a.be;
end;
writeln(h,',',g);
end;
{6:}{ begin
write('Do be sang lon: ');
if (a.lon+a.be<=m) then
begin
a.lon:=m;
c:=a.lon;
a.be:=0;
r:=a.be;
end
else begin
a.lon:=m;
c:=a.lon;
a.be:=a.lon+a.be-m;
r:=a.be;
end;
writeln(m,',',s);
end; }
end;
while (q<>nil) do
begin
pop(q,a);
push(p,a);
for i:=1 to 6 do
if(chuatham(q,a)and chuatham(p,a)) then
begin
push(q,a);
if((a.lon=k) or (a.be=k)) then
begin
push(p,a);
inkq(p);
break;
end;
end;
end;
end;
BEGIN
clrscr;
writeln(' ***************DONG NUOC**************');
nhap;
dongnuoc(a,m,n,k);
readln;
END.
PROGRAM dong_nuoc;
USES crt;
TYPE contro=^banghi;
banghi=record
lon:integer;
be:integer;
sohieu:integer;
truoc:integer;
link:contro;
end;
var
p,q:contro;
a:banghi;
m,n,k:integer;
procedure nhap;
begin
write('Nhap nuoc ban dau cho binh lon: ');
readln(a.lon);
write('Nhap nuoc ban dau cho binh be: ');
readln(a.be);
write('Nhap the tich binh lon: ');
readln(m);
write('Nhap the tich binh be: ');
readln(n);
write('Nhap luong nuoc can dong: ');
readln(k);
readln;
end;
procedure push(q:contro; a:banghi);
var l,p:contro;
begin
new(p);
p^.lon:=a.lon;
p^.be:=a.be;
p^.link:=nil;
if(q=nil)then q:=p
else begin
l:=q;
while (l^.link<>nil) do l:=l^.link;
l^.link:=p;
end;
end;
procedure pop(q:contro; a:banghi);
var p:contro;
begin
p:=q;
a.lon:=q^.lon;
a.be:=q^.be;
a.sohieu:=q^.sohieu;
a.truoc:=q^.truoc;
q:=q^.link;
dispose(p);
end;
function chuatham(q:contro; a:banghi):boolean;
var p:contro;
begin
p:=q;
while(p<>nil) and ((p^.lon<>a.lon) or (p^.be<>a.be))do
p:=p^.link;
if((p^.lon=a.lon) or (p^.be=a.be))then
chuatham:=false
else chuatham:=true;
end;
procedure inkq(q:contro);
var p:contro;
begin
p:=q;
while(p<>nil) do
begin
write('(',p^.lon,',',p^.be,')->');
p:=p^.link;
end;
end;
procedure dongnuoc(a:banghi; m,n,k:integer);
var p,q:contro;
b:banghi; i,s,w,f,z,v,t,h,g,c,r:integer;
begin
q:=nil; p:=nil;
push(p,a);push(p,a);
{for i:=1 to 6 do
case i of}
while ((a.lon <>k) or (a.be<>k)) do
begin
{1:} begin
write('Do vao lon:');
a.lon:=m;
s:=a.be;
a.be:=a.be;
writeln(m,',',s);
end;
{2:} begin
write('Do vao be: ');
w:=a.lon;
a.be:=n;
writeln(w,',',n);
end;
{3:} begin
write('Do lon ra: ');
a.lon:=0;
f:=a.lon;
a.be:=a.be;
z:=a.be;
writeln(f,',',z);
end;
begin {them vao de thu}
write('Do be sang lon: ');
if (a.lon+a.be<=m) then
begin
a.lon:=m;
c:=a.lon;
a.be:=0;
r:=a.be;
end
else begin
a.lon:=m;
c:=a.lon;
a.be:=a.lon+a.be-m;
r:=a.be;
end;
writeln(m,',',s);
end; {den day}
{4:} begin
write('Do be ra: ');
a.lon:=a.lon;
v:=a.lon;
a.be:=0;
t:=a.be;
writeln(v,',',t);
end;
{5:} begin
write('Do lon sang be: ');
if (a.lon+a.be<=n) then
begin
a.lon:=0;
h:=a.lon;
a.be:=n;
g:=a.be;
end
else begin
a.lon:=a.lon+a.be-n;
h:=a.lon;
a.be:=n;
g:=a.be;
end;
writeln(h,',',g);
end;
{6:}{ begin
write('Do be sang lon: ');
if (a.lon+a.be<=m) then
begin
a.lon:=m;
c:=a.lon;
a.be:=0;
r:=a.be;
end
else begin
a.lon:=m;
c:=a.lon;
a.be:=a.lon+a.be-m;
r:=a.be;
end;
writeln(m,',',s);
end; }
end;
while (q<>nil) do
begin
pop(q,a);
push(p,a);
for i:=1 to 6 do
if(chuatham(q,a)and chuatham(p,a)) then
begin
push(q,a);
if((a.lon=k) or (a.be=k)) then
begin
push(p,a);
inkq(p);
break;
end;
end;
end;
end;
BEGIN
clrscr;
writeln(' ***************DONG NUOC**************');
nhap;
dongnuoc(a,m,n,k);
readln;
END.