Program S3;
Var
k : integer;
f : text;
//****************************************
Function Rob(u:longint) : longint;
Var
nb,e,x : integer;
a : char;
ch,ch1,r : string;
r1 : longint;
Begin
str(u,ch);
r := '';
Repeat
nb := 0;
a := ch[1];
x := pos(a,ch);
While (x<>0) Do
Begin
nb := nb+1;
delete(ch,x,1);
x := pos(a,ch);
End;
str(nb,ch1);
r := r+ch1+a;
Until (ch='');
val(r,r1,e);
Rob := r1;
End;
//****************************************
Procedure tri(Var n:longint);
Var
x : char;
ch : string;
max,e,i,j : integer;
Begin
str(n,ch);
For i:=1 To length(ch)-1 Do
Begin
max := i;
For j:=i+1 To length(ch) Do
Begin
If (ch[j]>=ch[max]) Then
max := j;
End;
x := ch[i];
ch[i] := ch[max];
ch[max] := x;
End;
val(ch,n,e);
End;
//****************************************
Procedure ouvrirF(Var f :text);
Begin
assign(f,'Robinson.txt');
rewrite(f);
End;
Procedure suite(Var n:integer; Var f:text);
Var
i : integer;
r,u : longint;
ch : string;
Begin
Repeat
write(' donner k dans [2..15] = ');
readln(n);
Until (n In [2..15]);
ouvrirF(f);
u := 0;
writeln(f,'U0=0');
For i:=1 To n Do
Begin
tri(u);
r := rob(u);
str(r,ch);
writeln(f,'U',i,'=',ch);
u := r;
End;
close(f);
End;
//****************************************
Procedure affiche(Var f:text);
Var
ch : string;
Begin
reset(f);
While Not eof(f) Do
Begin
readln(f,ch);
writeln(ch);
End;
close(f);
End;
//****************************************
Begin
suite(k,f);
affiche(f);
End.
Inscription à :
Publier les commentaires (Atom)
