Матрица бинарного отношения.Как вывести в Memo с проверкой

[kolyaz]

На вход подаётся отсортированное множество А(сделал)
и список упорядоченных пар, задающий отношение R (сделал).
Не могу понять как создать и вывести в Memo матрицу бинарного отношения с проверкой на:
1.Рефлексивность
2.Симметричность
3.Антисимметричность
4.Транзитивность
Процедура TMatrix

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;

type
  TForm1 = class(TForm)
    edt1: TEdit;
    btn1: TButton;
    lbl1: TLabel;
    lbl2: TLabel;
    lbl3: TLabel;
    lbl4: TLabel;
    btn3: TButton;
    lbl5: TLabel;
    lbl6: TLabel;
    lbl7: TLabel;
    mmo1: TMemo;
    mmo2: TMemo;
    lbl8: TLabel;
    lbl9: TLabel;
    procedure edt1KeyPress(Sender: TObject; var Key: Char);
    procedure InitSort(s:string;var z:string);
    procedure btn3Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure TMatrix(z:string);
    procedure mmo2KeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
    procedure InitSortDouble(b:string);
    procedure Clear();
    //procedure Reflex();
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  z2:string;

implementation

{$R *.dfm}
procedure TForm1.InitSort(s:string;var z:string);//Сортировка множества
  var i,j,k:Integer; c:Char;
  begin
      k:=Length(s);
      for i:=1 to k do
        for j:=1 to k do
          if ((s[i]=s[j])and(i<>j))then
            begin
                Delete (s,i,1);
                k:=k-1;
            end;
            for i:=1 to k-1 do
            for j:=i+1 to k do
            if ord(s[i])>ord(s[j]) then
              begin
                 c:=s[i];
                 s[i]:=s[j];
                 s[j]:=c;

              end;
          z:=s;
  end;
  procedure TForm1.InitSortDouble(b:string); //Корректировка пар
    var k,i,j,x,y:Integer;a:string;
  begin
         i:=1;
         j:=1;
         x:=1;
         y:=1;
         for k:=0 to mmo2.Lines.Count-1 do
         a:=mmo2.Lines[k];

         if  (Length(a)>2) then begin
                                  ShowMessage('Только пары латинских букв  '+'Строка : '+(inttostr(k)));
                                end;

         begin

        while  (i<=Length(a)) and (j<=Length(b)) do
           if a[i]<b[j] then  begin
                                    ShowMessage(a[i]+' '+' Такого элемента нет в множестве A  '+'Строка : '+(inttostr(k))+'  Элемент : '+(inttostr(i)));
                                    Exit;
                              end
           else if a[i]>b[j] then
              inc(j)
             else if a[i] = b[j] then
              begin
                Inc(i);
              end;

        end;
        inc(k);
        end;

procedure TForm1.Clear();
begin
      edt1.Clear;
      lbl7.Caption:='';
      mmo1.Clear;
      mmo2.Clear;
      edt1.SetFocus;
end;
//procedure TForm1.Reflex ();

procedure TForm1.edt1KeyPress(Sender: TObject; var Key: Char);//Корректировка на ввод
begin

       if not(key in[#0..#31,'a'..'z']) //перечисление всех допустимых символов
       then begin
               key:=#0;
               ShowMessage('Введите латинские буквы множества');
              end;
        end;

procedure TForm1.btn3Click(Sender: TObject); //Очистка формы
begin
      Clear;
end;


 procedure TForm1.btn1Click(Sender: TObject);  //Кнопка расчитать
begin
       InitSort(edt1.Text,z2);
       lbl7.Caption:=z2;
       TMatrix(z2);
       InitSortDouble(z2);
end;

procedure TForm1.TMatrix(z:string);


var i,j,k:Integer;
begin
      mmo1.Clear;
      mmo1.Lines.add(' '+z);
      for i:=1 to (Length(z)) do
         mmo1.Lines.add(z[i]);
           //for j:=1 to (Length(z)) do

end;



 procedure TForm1.mmo2KeyPress(Sender: TObject; var Key: Char);
begin

             if not((key in[#0..#31,'a'..'z'])) //перечисление всех допустимых символов
                then begin
                       key:=#0;
                       ShowMessage('Введите латинские буквы пар');
                     end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
      Clear;
end;

end.

[kolyaz]

Опять наверное не правильно тему оформил или код не тот?
Ну хоть покритикуйте , а то 50 с лишним просмотров и не одного комментария!

[Stilet]

Я бы может и критиканул, если бы знал что все эти слова ученные означают...

[kolyaz]

На вход подается упорядоченное множество А ( например a b c ) оно будет своеобразной сеткой координат(например морской бой) :
a b c
a
b
c
Затем вводятся пары только из элементов A (например ab bc ca,координаты кораблей)
Должна получиться матрица:
a b c
a001
b100
c010
Так вот не могу придумать как ЭТУ матрицу в mmo1 записать
Вроде как динамический массив напрашивается , но допилить не получается

[Stilet]

Так у тебя и матрицы как таковой нет... По крайней мере в коде я не увидел двумерный массив.
А если ты это и имел ввиду мол, не получается, то тут всю программу выкидывать нужно.

[Serge_Bliznykov]

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

Так у тебя и матрицы как таковой нет...

Как нет и множества (если мы говорим про множество в понимании ЯВУ Паскаль/Delphi - а именно SET OF ... )

Вроде как динамический массив напрашивается

можно динамический, можно и статический.
Если у Вас допускаются ТОЛЬКО латинские буквы, то это массив 26 x 26 - это всего 676 байт.

А вот мемо я бы не стал брать. Для таблиц намного удобнее взять TStringGrid.

Хотя, я по сути согласен со Stilet - если Вы объясните по простому, что делаете и что именно не получается, есть шанс получить ответ. А если речь идёт о том, что нужно бинарную матрицу проверить на "Рефлексивность, Симметричность,
Антисимметричность, Транзитивность" - так это совсем другое. Я, например, это не помню. И, извините, но лезть и изучать теорию - лень и недосуг, да и это Вам очень дорого будет стоить

p.s. разбивайте задачу на мелкие подзадачи и решайте их независимо.
Если сможете сформулировать, в чём Вам помочь - то welcome!

[kolyaz]

Я на создании массива и застрял

[Serge_Bliznykov]

kolyaz, я имел в виду что-то подобное:

uses crt;
type
 TBinMatrix = array['a'..'z','a'..'z'] of byte;

var
  BM : TBinMatrix;
  ASet : set of char;
  A  : string;
  ch1, ch2 : char;
  i : integer;
begin
  {обнулим бинарную матрицу}
  for ch1:='a' to 'z' do
     for ch2:='a' to 'z' do BM[ch1,ch2] := 0; 
  {обнулим используемое множество символов}
  ASet := [];
 
  A := 'abcw';

  for i:=1 to Length(A) do 
    if A[i] in ['a'..'z'] then begin
        BM[A[i], A[i]] := 1; {заполняем матрицу отношений вида aa bb cc ww}
        Include(ASet, A[i]);
    end;


 {вывод матрицы на экран}
 WriteLn('Матрица отношений');

   { заголовки столбцов}
   Write('   ');
   for ch1 := 'a' to 'z' do
     if ch1 in ASet then Write(ch1,' ');
   WriteLn;

   {теперь собственно вывод матрицы построчно/по столбцам}
   for ch1:='a' to 'z' do
      if  ch1 in ASet then begin
         Write(ch1,'  ');
         for ch2:='a' to 'z' do
           if ch2 in ASet then Write(BM[ch1,ch2]:1,' ');
         WriteLn;
      end;

   Readln; {ожидаем Enter для закрытия программы} 
end.

результат:
BinMatrix.jpg

[kolyaz]

Спасибо то что нужно
только как вы ввели aa bb cc ww
Просто мне нужно вначале ввести aa bb cc ww
чтоб потом получить такую матрицу

[Аватар]

Я бы рекомендовал стринггрид для отображения и ввода бинарных отношений по двойному щелчку на ячейке. Button1Click формирует стринггрид, он же матрица. StringGrid1DblClick забивает единички в нужные места вместо ввода пар. Сделайте еще кнопку и по ней анализируйте свойства полученной матрицы

procedure TForm1.Button1Click(Sender: TObject);
var s: String;
    i: Integer;
begin
  s:='abdgklmpgr'; //строка латинских, у меня константа, берите из Edit.Text предварительно упорядочив
  StringGrid1.RowCount:=Length(s)+1;
  StringGrid1.FixedRows:=1;
  StringGrid1.ColCount:=Length(s)+1;
  StringGrid1.FixedCols:=1;
  StringGrid1.DefaultColWidth:=StringGrid1.DefaultRowHeight;
  for i:=1 to Length(s) do begin
    StringGrid1.Cells[i,0]:=s[i];
    StringGrid1.Cells[0,i]:=s[i];
  end;
end;

procedure TForm1.StringGrid1DblClick(Sender: TObject);
var xCoord: TGridCoord;
    xPoint: TPoint;
begin
  xPoint:=StringGrid1.ScreenToClient(Mouse.CursorPos);
  xCoord:=StringGrid1.MouseCoord(xPoint.X,xPoint.Y);
  if (xCoord.X>0) and (xCoord.Y>0) then begin
    if StringGrid1.Cells[xCoord.X,xCoord.Y]='1'
      then StringGrid1.Cells[xCoord.X,xCoord.Y]:=''
      else StringGrid1.Cells[xCoord.X,xCoord.Y]:='1';
  end;
end;