Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.01.2022, 22:29   #1
shkolnik45
Пользователь
 
Регистрация: 16.04.2021
Сообщений: 19
По умолчанию круги эйлера. Есть программа для пересечения и объединения, как добавить отрицание?

Добрый день, помогите пожалуйста вот с такой проблемой. Есть программа для пересечения и объединения (считывается выражение, переводится в постфиксную форму, результат выводится в виде закрашивания кругов эйлера), нужно добавить отрицание, но я не совсем понимаю, как это сделать, возникают проблемы с переводом в постфиксную форму и ответ не во всех случаях получается верным.
Я так понимаю, что первичная проблема находится в переводе в постфиксную форму. Буду признателен за помощь.
Код:
var
  size: integer;
  A,B,C,res,res1,res2,res3,U:mn;
  st:string;

    type
    pnode=^node;
    node = record
    p : pnode;
    datainf:char;
    end;

   var
   topinf,temp: pnode;
   postfiks, infiks : string;
   symb, outdata: char;
    k : integer;
 
implementation

{$R *.dfm}

function pushinf (topinf : pnode; datainf : char) : pnode;
var
p : pnode;
begin
new (p);
p^.datainf := datainf;
p^.p := topinf;
pushinf := p;
end;

function popinf (topinf : pnode; var datainf : char) : pnode;
begin
datainf := topinf^.datainf;
popinf := topinf^.p;
dispose (topinf);
end;

function empty (topinf : pnode) : boolean;
begin
if topinf = nil then empty := true
else empty := false;
end;

function pred (oper1 : char; oper2 : char) : boolean;
begin
pred := true;
if (oper1 = '(') or (oper2 = '(') then pred := false;
if oper2 = '^' then pred := false;
if ((oper1 = '-') or (oper1 = '+'))
and ((oper2 = '*') or (oper2 = '/')) then pred := false;
end;


procedure push (var stack:Tstack; var size:integer; x:mn);
begin
  size:=size+1;
  Stack[size]:=x;
end;

function topST(var stack:Tstack; var size:integer):mn;
begin
  topSt:=stack[size];
end;

procedure pop;
begin
size:=size-1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
x,y:integer;
i,z,count: integer;
s,sAns:string;
flag:boolean;
begin
count:=0;
sAns:=' ';

St:=ListBox1.Items[ListBox1.ItemIndex];

/// перевод
infiks := St + ' ';
postfiks:= '';
topinf:=nil;
k := 1;

repeat
symb := infiks[k];
if (symb >= 'A') and (symb <= 'Z')
   then begin
   postfiks := postfiks + symb;
   inc (k);
   end
      else begin
           while (empty(topinf) = false) and (pred (topinf^.datainf, symb) = true) do
           begin
           topinf := popinf (topinf, outdata);
           postfiks := postfiks + outdata;
           end;
      if (empty (topinf) = true) or (symb <> ')')
         then topinf := pushinf (topinf, symb)
              else topinf := popinf (topinf, outdata);
      inc (k);
      end;

until symb = ' ';
while empty (topinf) = false do
begin
topinf := popinf (topinf, outdata);
postfiks := postfiks + outdata;
end;

st:=postfiks;
label1.caption:=st;
 
A:=[1,2,5,6];
B:=[2,3,5,4];
C:=[4,5,6,7];
U:=[1,2,3,4,5,6,7,8];
size:=0;
res1:=[];
res2:=[];
res3:=[];
res:=[];
for i := 1 to length(st) do
begin
  case st[i] of
     '|': begin
          if size>1
             then begin
             res1:=topSt(stack,size);
             pop;
             res2:=topSt(stack,size);
             pop;
             res:=res1+res2; end
                 else begin res3:= topSt(stack,size); res:=res+res3;
                      end;
            end;
     '&': begin
          if size>1
             then begin
             res1:= topSt(stack,size);
             pop;
             res2:=topSt(stack,size);
             pop;
             res:=res1*res2; end
                 else begin res3:= topSt(stack,size); res:=res*res3;
                      end;
          end;
/////попытка написать для отрицания
     '!':begin
         if size=1
             then begin
             res1:= topSt(stack,size);
             pop;
             res:=U-res1; end
         else if size>1
           then begin
           res3:= topSt(stack,size); res:=res-res3;
         end
         else begin res3:= topSt(stack,size); res:=res-res3;
                      end;


     end;
     'A': push(stack,size,A);
     'B': push(stack,size,B);
     'C': push(stack,size,C);
     'U':push(stack,size,U);

      end;
end;

s:=' ';
for i:= 1 to 8 do
if i in res then
s:=s+inttostr(i);
shkolnik45 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
есть программа поиска минимума строк матрицы, нужно добавить процедуры и функции superrim Помощь студентам 1 25.05.2015 07:44
программа по растровой графике в delphi, как сделать чтобы круги строились по циклам?? Alexxx_screen Помощь студентам 28 04.09.2011 23:04
Круги Эйлера NecRomant Общие вопросы Delphi 2 17.12.2008 15:07