[r]
(1)ChuÈn ho¸ 3-7 Program Norm_3_7;
uses crt ; const
fi = 'norm.inp' ; fo = 'norm.out' ; { fo = '' ;}
max = '000000000000000000000' ; type
st = string[21] ; var
f,g : text ; s,smax : st ; d,c : integer ; ok : boolean ; procedure khoitao ;
begin
smax:='0' ; end ;
function lonhon(s,s1 : st) : boolean ; begin
lonhon:=true ;
if length(s1)>length(s) then begin
lonhon:=false ; exit ;
end ;
if length(s1)<length(s) then exit ; if s>s1 then exit ;
lonhon:=false ; end ;
procedure ghinhan ; begin
if lonhon(s,smax) then smax:=s ; end ;
procedure xoa0 ; begin
while s[1]='0' delete(s,1,1) ; end ;
procedure chia3 ;
var so,nho,i,j : byte ; a,c,du : integer ; x,x1,x2 : st ; begin
x:='' ; x1:='' ; i:=1 ;
if s[1]<'3' then begin
(2)end ;
while i<=length(s) begin
x1:=x1+s[i] ; val(x1,a,c) ; du:=a mod ; c:=a div ;
if du=0 then x1:='' else str(du,x1); str(c,x2) ;
x:=x+x2 ; inc(i) ; end ;
if x1='' then begin
ok:=true ; s:=x ; end ; end ;
procedure chuan1 ; var i,tcs : integer ; begin
tcs:=0 ;
for i:=1 to length(s) inc(tcs,ord(s[i])-48) ; if tcs mod = then chia3 ;
end ;
procedure chuan2 ; var so,nho,i,j : byte ; a,c,du : integer ; x,x1,x2 : st ; begin
x:='' ; x1:='' ; i:=1 ;
if s[1]<'7' then begin
x1:=x1+s[1] ; i:=2 ;
end ;
while i<=length(s) begin
x1:=x1+s[i] ; val(x1,a,c) ; du:=a mod ; c:=a div ;
if du=0 then x1:='' else str(du,x1) ; str(c,x2) ;
x:=x+x2 ; inc(i) ; end ;
if x1='' then begin
(3)end ; end ;
procedure chuan3 ; var i : integer ; begin
ok:=false ;
for i:=1 to length(s) if s[i]='3' then begin
delete(s,i,1) ; ok:=true ; exit ; end ; xoa0 ; end ;
procedure chuan4 ; var i : integer ; begin
ok:=false ;
for i:=1 to length(s) if s[i]='7' then begin
delete(s,i,1) ; ok:=true ; exit ; end ; xoa0 ; end ;
procedure chuan5 ; var i,dem,j : integer ; c : char ; begin
ok:=false ; i:=1 ;
while i<=length(s) begin
c:=s[i] ; dem:=0 ; j:=i ;
while (s[i]=c) and (dem<3) begin
inc(i) ; inc(dem) ; end ;
if dem=3 then begin
delete(s,j,3) ; ok:=true ; exit ; end ; end ;
(4)procedure chuan6 ; var i,dem,j : integer ; c : char ; begin
i:=1 ; ok:=false ;
while i<=length(s) begin
c:=s[i] ; dem:=0 ; j:=i ;
while (s[i]=c) and (dem<7) begin
inc(i) ; inc(dem) ; end ;
if dem=7 then begin
delete(s,j,7) ; ok:=true ; exit ; end ; end ;
xoa0 ; end ;
function thoaman : boolean ; var
x : st ; begin
thoaman:=false ; x:=s ;
chuan1 ;
if s<>x then exit ; s:=x ;
chuan2 ;
if s<>x then exit ; s:=x ;
chuan3 ;
if s<>x then exit ; s:=x ;
chuan4 ;
if s<>x then exit ; s:=x ;
chuan5 ;
if s<>x then exit ; s:=x ;
chuan6 ;
if s<>x then exit ; thoaman:=true ; end ;
procedure duyet(var x : st) ; var a : st ;
(5)a:=s ;
for i:=1 to begin
case i of
: chuan1 ; : chuan2 ; : chuan3 ; : chuan4 ; : chuan5 ; : chuan6 ; end ;
if lonhon(s,smax) and lonhon(a,s) then duyet(s) else
if thoaman then ghinhan ; s:=a ;
end ; end ;
procedure xuly ; var ch : char ; begin
repeat
ch:=readkey ; case ch of
'3' : chuan3 ; '4' : chuan4 ; '1' : chuan1 ; '2' : chuan2 ; '5' : chuan5 ; '6' : chuan6 ; end ;
writeln(s) ; until ch=#27 ; end ;
procedure inkq ; begin
writeln('Max = ',smax) ; writeln(g,smax) ;
end ; BEGIN
clrscr ;
assign(f,fi) ; reset(f) ; assign(g,fo) ; rewrite(g) ;
while not eof(f) begin
(6)close(g) ; END