Одномерный массив Pascal/Delphi

[zoha]

Переместить минимальные элементы в начало, сдвинув остальные элементы вправо
Одномерный массив

[denisbrain]

const ncount=25; // размер массива
var a:array [1..ncount] of integer; // массив элементов

procedure CreateArray;
var i:integer;
begin
randomize;// инициализация
  for i:=1 to ncount-1 do  a[i]:=random(150);
end;
// функция поиска минимального элемента
Function GetMin:integer;
var i:integer; // переменная
    MinA:integer;
begin
  MinA:=a[1];
  for i:=1 to ncount-1 do
     if MinA>a[i] then MinA:=a[i];
  result:=MinA;
end;
// возвращает index минимального элемента
Function GetMinIndex:integer;
var i:integer; // переменная
    MinA:integer;
begin
  MinA:=a[1];
  result:=1;
  for i:=1 to ncount-1 do
     if MinA>a[i] then begin MinA:=a[i];result:=i; end;
end;

procedure move_right(index:integer);
var i:integer;
begin
 for i:=ncount-2 downto index do  a[i+1]:=a[i];

end;

procedure move_left(index:integer);
var i:integer;
begin
 for i:=index to ncount-1 do  a[i]:=a[i+1];

end;

Function ShowArray:string;
var s:string;
    i:integer;
begin
s:='';
 for i:=1 to ncount-1 do
 if s='' then s:=s+inttostr(a[i])
 else
  s:=s+','+inttostr(a[i]);
  result:=s;
end;

var mina // значения минимального элемента 
,x:integer; // временная переменая хранит индес мин. элемента 
begin

   CreateArray; // заполняем массив 
   writeln(ShowArray); // выводим исходный массив 
   x:=GetMinIndex; // получем индекс минимальго элемента 
   mina:=a[x]; // получаем знаяения мин. элемента 
   move_left(x); // сдвигаем массив в лево  / затираем минимальный элемент массива 
   move_right(1); // сдвигаем массив вправо с первого элемента 
   a[1]:=mina; // выставляем значения минимального элемента в начало 
   writeln(ShowArray); // выводим полученный массив 

end.

[Serge_Bliznykov]

denisbrain, во-первых, функцию Function GetMin:integer;
вы написали, а потом решили, что она вам не нужна.. а убрать из кода Вы её забыли. это не ошибка (и даже не недочёт!), но некрасиво - зачем в коде лишнее!

но, во-вторых, главное, ваш код решает ДРУГУЮ задачу
в условиях исходной задачи было: "Переместить минимальные элементы в начало"
а ваш код переносит только ОДИН элемент в начало.

но в целом - работа вполне достойная, молодец!

[denisbrain]

Сообщение от Serge_Bliznykov

denisbrain, во-первых, функцию Function GetMin:integer;
вы написали, а потом решили, что она вам не нужна.. а убрать из кода Вы её забыли. это не ошибка (и даже не недочёт!), но некрасиво - зачем в коде лишнее!

но, во-вторых, главное, ваш код решает ДРУГУЮ задачу
в условиях исходной задачи было: "Переместить минимальные элементы в начало"
а ваш код переносит только ОДИН элемент в начало.

но в целом - работа вполне достойная, молодец!

если элементов несколько то да

var mina,x:integer;
    i:integer;
begin

   CreateArray; // создаем массив
   writeln(ShowArray); // выводим исъодный массив
   mina:=GetMin; // получаем минимальный элемент
   Writeln(inttostr(mina)); // выводим минимальный элемент
   for i:=1 to ncount-1 do
     if mina=a[i] then begin // если текущий элемент минимальный
     move_left(i); // сдвигаем влево и затираем элемент
     move_right(1); // двигаем весь массив вправо
     a[1]:=mina; // устанавливаем первый элемент минимальным
   end;
   writeln(ShowArray); // выводим полученный массив


end;

[BDA]

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  ncount = 10;

var
  i, j, min, k: integer;
  a: array[1..ncount] of integer;

begin
  randomize;
  for i := 1 to ncount do
    a[i] := random(5) + 1;
  for i := 1 to ncount do
    write(a[i], ' ');

  min := a[i];
  k := 1;
  for i := 2 to ncount do
    if a[i] < min then
    begin
      min := a[i];
      k := 1;
    end
    else
      if a[i] = min then
        inc(k);
  i := ncount;
  j := ncount;
  while (j > 0) do
  begin
    a[i] := a[j];
    if a[i] = min then
      dec(j)
    else
    begin
      dec(i);
      dec(j);
    end;
  end;
  for i := 1 to k do
    a[i] := min;

  writeln;
  for i := 1 to ncount do
    write(a[i], ' ');
  readln;
end.

[Serge_Bliznykov]

BDA, красавчик! Браво! жаль ещё раз плюсануть сервер не даёт!

[BDA]

Обнаружена ошибка (опечатка)

for i := 1 to ncount do
    write(a[i], ' ');

  min := a[1];
  k := 1;
  for i := 2 to ncount do