Комментарии: Решаем задачи Абрамян на Паскале. Array89

Автор: Bronislav

Bronislav — Mon, 06 Aug 2018 23:12:18 +0000

Хорошая задача, надо будет по-разбираться в вашем коде. Мое решение — сортировка вставками.

program array_89;//pascalABC.net

procedure InsertShiftRight(a: array of integer; i: integer);
begin
  var j := 0;
  while a[i] < a[j] do inc(j);
  var temp := a[i];
  for var k := i downto j + 1 do
    a[k] := a[k - 1];
  a[j] := temp
end;

procedure InsertShiftLeft(a: array of integer; i: integer);
begin
  var j := a.Length - 1;
  while a[i] > a[j] do dec(j);
  var temp := a[i];
  for var k := i to j - 1 do
    a[k] := a[k + 1];
  a[j] := temp
end;

//главная программа
begin
  var n := 10;
  var a := Arr(9, 8, 7, 0, 6, 5, 4, 3, 2, 1);
  var i, j: integer;
  
  //ищем индекс "неупорядоченного" элемента
  for j := 1 to n - 2 do
    if a[j] > a[j - 1] then
      if a[j - 1] < a[j + 1] then
        begin i := j - 1; break end
      else begin i := j; break end
    else i := n - 1;
  
  //сортировка вставкой со сдвигом элементов вправо, или влево
  if (i = j) or (i = n - 1) then InsertShiftRight(a, i)
  else InsertShiftLeft(a, i);
  
  a.Println;//9 8 7 6 5 4 3 2 1 0
end.

program array_89;//pascalABC.net

procedure InsertShiftRight(a: array of integer; i: integer);

begin

var j := 0;

while a[i] < a[j] do inc(j);

var temp := a[i];

for var k := i downto j + 1 do

a[k] := a[k - 1];

a[j] := temp

end;

procedure InsertShiftLeft(a: array of integer; i: integer);

begin

var j := a.Length - 1;

while a[i] > a[j] do dec(j);

var temp := a[i];

for var k := i to j - 1 do

a[k] := a[k + 1];

a[j] := temp

end;

//главная программа

begin

var n := 10;

var a := Arr(9, 8, 7, 0, 6, 5, 4, 3, 2, 1);

var i, j: integer;

//ищем индекс "неупорядоченного" элемента

for j := 1 to n - 2 do

if a[j] > a[j - 1] then

if a[j - 1] < a[j + 1] then

begin i := j - 1; break end

else begin i := j; break end

else i := n - 1;

//сортировка вставкой со сдвигом элементов вправо, или влево

if (i = j) or (i = n - 1) then InsertShiftRight(a, i)

else InsertShiftLeft(a, i);

a.Println;//9 8 7 6 5 4 3 2 1 0

end.

Автор: olegst1975

olegst1975 — Mon, 11 Apr 2016 07:35:47 +0000

ОГО! Ну не столько же за одно утро!.. «как то это ресурсозатратно звучит» — да, скорее применимо для сортировки всего массива, а не одно число поставить на место(решение с большииим запасом))

Автор: Anton

Anton — Mon, 11 Apr 2016 06:18:34 +0000

мне не нравиться запупск рекурсивной функции в цикле… как то это ресурсозатратно звучит 🙂
в шапку добавил решение где я избавляюсь, от запуска рекурсии в цикле, а потом я изабвился и от всех циклов… 🙂

Автор: olegst1975

olegst1975 — Sun, 10 Apr 2016 20:33:49 +0000

[crayon-6743bef498d27902684273 inline="true" ]
type
  mas=array [1..10]of real;
var
  n,i:integer;      
  a:mas;
procedure sink(var a:mas;i:integer);
  begin
    if (i=1)or(a[i]<a[i-1]) then exit;
    a[i]:=a[i]+a[i-1];
    a[i-1]:=a[i]-a[i-1];
    a[i]:=a[i]-a[i-1];
    sink(a,i-1);
  end;
begin   
  readln(n);        
  for i:=1 to n do readln(a[i]);   
  for i:=2 to n do sink(a,i);  
  for i:=1 to n do writeln(a[i]);
end.

[crayon-6743bef498d27902684273 inline="true" ]

type

mas=array [1..10]of real;

var

n,i:integer;

a:mas;

procedure sink(var a:mas;i:integer);

begin

if (i=1)or(a[i]<a[i-1]) then exit;

a[i]:=a[i]+a[i-1];

a[i-1]:=a[i]-a[i-1];

a[i]:=a[i]-a[i-1];

sink(a,i-1);

end;

begin

readln(n);

for i:=1 to n do readln(a[i]);

for i:=2 to n do sink(a,i);

for i:=1 to n do writeln(a[i]);

end.

[/crayon]