[Ghost]

Yurij
Получите и распишитесь.

uses
  crt;

const
  n = 5;

type
  str_vector = array [1..n] of string;
  log_vector = array [1..n] of boolean;
  log_matrix = array [1..n, 1..n] of boolean;

const
  a: str_vector = ('vaz', 'sad', 'gad', 'gaz', 'par');

var
  b: log_matrix;

{
  ----------------------------------------------------------------------------
  Процедура составления двумерного массива.
    вход:  x - одномерный массив (вектор) слов
    выход: y - двумерный массив (матрица) логических величин
}
procedure Metagrams (x: str_vector; var y: log_matrix); far;
{
  Функция определения прямых метаграмм - слов отличающихся друг от друга не
  более чем на один символ.
    вход:  два слова s1 и s2
    выход: "истина" (если метаграммы) или "ложь"
}
function DirectMetagram (s1, s2: string): boolean; far;
var
  i, j: byte;
begin
  if length (s1) = length (s2) then begin
    j := 0;
    for i := 1 to length (s1) do if s1[i] = s2[i] then inc (j);
    DirectMetagram := ((length (s1) - j) <= 1);
  end else DirectMetagram := false;
end;
{
  Функция определения существования метаграммной цепочки между двумя словами.
    вход:  номера двух слов i и j, логический вектор p слов цепочки
    выход: "истина" (если есть метаграммная цепочка) или "ложь"
}
function ChainMetagram (i, j: byte; p: log_vector): boolean; far;
var
  k: byte;
  q: boolean;
begin
  p[i] := true;
  if p[j] then q := true else begin
    q := false;
    for k := 1 to n do begin
      if y[i, k] and not p[k] then q := q or ChainMetagram (k, j, p);
      if q then break;
    end;
  end;
  ChainMetagram := q;
end;

var
  i, j, k: byte;
  q: log_vector;
{
  Основная часть процедуры
}
begin
{
  Обозначаем два одинаковых слова - "true", находим пары слов-метаграмм, и
  копируем "трегульную" матрицу саму на себя относительно главной диагонали.
}
  for i := 1 to n do for j := i to n do if i = j then y[i, i] := true else begin
    y[i, j] := DirectMetagram(x[i], x[j]);
    y[j, i] := y[i, j];
  end;
{
  Находим пару слов, не являющихся метаграммами, и пробуем найти цепочку
  метаграмм, соединяющую их. Полученную "треугольную" матрицу копируем саму на
  себя относительно главной диагонали.
}
  for i := 1 to n - 1 do for j := i + 1 to n do if not y[i, j] then begin
    for k := 1 to n do q[k] := false;
    y[i, j] := ChainMetagram (i, j, q);
    y[j, i] := y[i, j];
  end;
end;
{ ---------------------------------------------------------------------------- }

var
  i, j: byte;

begin
  clrscr;
  writeln ('strings:');
  for i := 1 to n do write (a[i]:4);
  writeln;
  writeln ('boolean:');
  Metagrams (a, b);
  for i := 1 to n do begin
    for j := 1 to n do if b[i, j] then write ('+':4) else write ('-':4);
    writeln;
  end;
  readkey;
end.

Вроде работает. Думаю, разберешься - здесь все достаточно просто.