Var i,j: integer; chislo: string; begin chislo:='12323'; for j:=1 to 14 do begin i:=1; while i<=length(chislo) do begin if copy(chislo,i,1)='1' then begin delete(chislo,i,1);insert('33',chislo,i); inc(i); end; inc(i); end; i:=1; while i<=length(chislo) do begin if copy(chislo,i,1)='2' then begin delete(chislo,i,1);insert('1',chislo,i); end; inc(i); end; i:=1; while i<=length(chislo) do begin if copy(chislo,i,1)='3' then begin delete(chislo,i,1);insert('2',chislo,i); end; inc(i); end; end; Writeln(chislo); readln; end.
samogon-mozhaisk
14.04.2023
Dim mas(,) As Integer Dim u As Integer, u2 As Integer Dim a As Integer Dim b As Integer
a = InputBox("Введите Начало промежутка (A)") b = InputBox("Введите Конец промежутка (В)")
Dim Length As Integer Length = CInt(((b - a) ^ 2) ^ 0.5) ReDim mas(Length, 1)
Dim x As Integer, y As Integer, i As Integer
For x = a To b mas(i, 0) = x i += 1 Next
For x = 0 To Length For i = 1 To mas(x, 0) If (mas(x, 0) Mod i) = 0 Then mas(x, 1) += 1 End If Next Next
For i = Length To 0 Step -1 For y = Length To 1 Step -1 If mas(y, 1) > mas(y - 1, 1) Then u = mas(y, 1) u2 = mas(y, 0) mas(y, 1) = mas(y - 1, 1) mas(y, 0) = mas(y - 1, 0)
mas(y - 1, 1) = u mas(y - 1, 0) = u2 End If Next y Next i
chislo: string;
begin
chislo:='12323';
for j:=1 to 14 do
begin
i:=1;
while i<=length(chislo) do
begin
if copy(chislo,i,1)='1' then begin delete(chislo,i,1);insert('33',chislo,i); inc(i); end;
inc(i);
end;
i:=1;
while i<=length(chislo) do
begin
if copy(chislo,i,1)='2' then begin delete(chislo,i,1);insert('1',chislo,i); end;
inc(i);
end;
i:=1;
while i<=length(chislo) do
begin
if copy(chislo,i,1)='3' then begin delete(chislo,i,1);insert('2',chislo,i); end;
inc(i);
end;
end;
Writeln(chislo);
readln;
end.