imho.ws
IMHO.WS  

Вернуться   IMHO.WS > Компьютеры > Программирование
Опции темы
Старый 10.04.2006, 18:39     # 1
Yurij
Member
 
Аватар для Yurij
 
Регистрация: 30.05.2003
Адрес: Литва
Пол: Male
Сообщения: 329

Yurij Луч света в тёмном царствеYurij Луч света в тёмном царствеYurij Луч света в тёмном царствеYurij Луч света в тёмном царствеYurij Луч света в тёмном царствеYurij Луч света в тёмном царстве
Нужен исходник по Pascal. Метаграммы

Привет всем!
Прошу помощи, может кто сталкивался с такой задачей:
"Метаграммой слова называется слово, коорое получено заменив одну букву данного слова. С нескольких слов можно создать цепочку метаграмм,которая соединяет два данных слова.
Имеется одномерный массив с n словами(их длины одинаковые). Нужно создать двумерный логический массив nXn, которого значение элемента [i,j] равно true, если слова i и y соединяет созданная из масива цепочка метаграмм, и false - если такой цепочки нет.
Напишите процедуру."
Если честно, я даже не совсем понимаю, что нужно сделать.
Помогите пожалуйста кто чем может.
Спасибо!
Yurij вне форума  
Старый 11.04.2006, 14:12     # 2
Ghost
::VIP::
Звезда первого сезона
Молчун-2004
 
Аватар для Ghost
 
Регистрация: 24.08.2002
Сообщения: 1 575

Ghost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех Гуру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.
Вроде работает. Думаю, разберешься - здесь все достаточно просто.
__________________
Действовать надо тупо и это лучшее доказательство нашей чистоты и силы!
Ghost вне форума  


Ваши права в разделе
Вы НЕ можете создавать новые темы
Вы не можете отвечать в темах.
Вы НЕ можете прикреплять вложения
Вы НЕ можете редактировать свои сообщения

BB код Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.

Быстрый переход


Часовой пояс GMT +4, время: 13:53.




Powered by vBulletin® Version 3.8.5
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.