Паскаль. Обработка массивов

[daniluk]

Дан массив. Необходимо заменить все элементы, для которых находится только один равный ему, на наименьший элемент этого массива.
Например массив: 1 3 8 2 2 8 8 4 5 4
Наименьший элемент: 1 (это найти не проблема).
Дальше хуже: Нужно привести массив к виду 1 3 8 1 1 8 8 1 5 1
Т.Е. 2 2, 4 4 - заменили на меньший элемент, а 8 8 8 не заменили, ибо элементов должно быть только 2.
Помогите с написанием.
Мой вариант кода, который ни в какую не хочет работать как нужно

procedure poisk(var m:array of integer);
var
 i,k,x,y:integer;
 min:integer;
begin
 min:=m[1];
 for i:=2 to 10 do
 begin
  if (m[i]<min) then
   min:=m[i];
 end;
  writeln;
  writeln('Minimal element =',min);

  n:=0;
  while n<10 do
  begin
   if (n=min) then
   begin
    n:=n+1;
    continue;
   end;
  k:=0;
  for i:=1 to 10 do
   begin
    if (m[i]=n) then
     begin
      k:=k+1;
       if (k=1) then
       x:=i
      else
       if (k=2) then
        y:=i;
     end;
   end;
  m[x]:=min;
  m[y]:=min;

  n:=n+1;
  end;
  for i:=1 to 10 do
   write(m[i]:4);
end;

[andrewpalkin]

А можно код всей программы

[ArtGrek]

procedure poisk(var m:array of integer);
var
  i, j, k: integer;
  a, c: byte;
begin
  a := 9;
  randomize;

// создание матрицы, видимо она у тебя ранше создаеца, можеш ето удалить
  for i := 0 to 9 do        
    m[i] := Random(10)+1;   

//нахождение минималного числа
  for i := 0 to 9 do              
    if a > m[i] then a := m[i];   

// замена чисел
  for i := 0 to 8 do
  begin
    c:=1;
    for j := i+1 to 9 do
      if m[i] = m[j] then inc(c);
    if not (odd(c)) then
    begin
      m[i] := a;
      for k := i+1 to 9 do
        if m[i] = m[k] then m[k] := a;
    end;
  end;

end;

[daniluk]

В общем, после того как я отошел от новогодней пьянки, написал таки код. Не без помощи занющих людей. Код может показатья немного индийским, но все же, для студентов прокатит. Ловите, вдруг кому надо будет еще.

uses crt;
const  N = 10;

type
   TMas = array[1..N] of integer;

procedure RandArr(var a : TMas);
var
   i : byte;
begin
   randomize;
   for i:=1 to N do
     a[i]:=random(10);
end;

procedure PrintArr(a : TMas);
var
   i : byte;
begin
   writeln('---------------------------------------------------------');
   for i:=1 to N do
     write(a[i]:5);
   writeln;
end;

function FindMin(a : TMas) : integer;
var
   i : byte;
   m : integer;
begin
   m:=a[1];
   for i:=2 to N do
     if (m > a[i]) then m:=a[i];
   FindMin:=m;
end;
//Возвращает индекс второго вхождения элемента a[start] 
//Если элемент единственный или входит в массив более двух раз, вернёт 0. 
function FindPos(a : TMas; start : byte) : byte;
var
   i, res : byte;
begin
   res:=0;
   for i:=1 to N do
     begin
        if i=start then continue; //самого себя не учитываем.
        if a[i]=a[start] then
          if res=0 then  res:=i//второе вхождение найдено
          else
            begin
              res:=0; //третье вхождение, элемент не удовлетворяет условию.
              break;
            end;
     end;
   FindPos:=res;
end;

procedure DoSomething(var a : TMas);
var
  min : integer;
  i, k : byte;
begin
   min:=FindMin(a);
   for i:=1 to N-1 do
     begin
       if (a[i]=min) then continue;
       k:=FindPos(a, i);
       if (k<>0)  then
         begin
           a[k]:=min;
           a[i]:=min;
         end;
     end;
end;

var
   a : TMas;
begin
   clrscr;
   RandArr(a);
   PrintArr(a);
   DoSomething(a);
   PrintArr(a);
   readkey;
end.