IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Помогите доработать Задачу, Задача на преобразование булевской функции к нормальной форме.
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 2
Пол: Мужской

Репутация: -  0  +



program bool;
uses crt;
Procedure UpChar ( var s : string);

var i: byte;
Begin
For i:= 1 to length(s) do
s[i]:=UpCase(s[i]);
end;

function finish:boolean;
var ch,scr:char;
begin
writeln(' Prodolgit? (Y - Yes, N - Now) ');
ch:=readkey;
if upcase(ch)='Y'
then
finish:=false
else
finish:=true;
end;
function Bin(n, r: longint): string;
var s: string;
const
d: string[16] = '0123456789ABCDEF';
begin
s := '';
repeat
s := d[(n mod r) + 1] + s;
n := n div r;
until n = 0;
while length(s) < 2 do s := '0' + s;
Bin := s;
end;
function nul(s: string; n: integer): string;
begin
while length(s) < n do s := '0' + s;
nul := s;
end;
const per: string[6] = 'ABCDEF';
var
i, j, p, pp, vars_count,c,cc,f,ddd,g,dddd: integer;
ch,d,ch1: char;
l_v, st, bs,s, prs,k,w,result,s1,s2,s3,s4,s5,s6,s7: string;
b_s, b_m: boolean;
begin
Repeat
Clrscr;

Writeln('Vvedite Func: ');
readln(s1);
UpChar(s1);
While pos('>',s1)>0 do
Begin
s1[pos('>',s1)]:='+';
insert('\',s1,pos('>',s1)-2);
End;
s:=s1;
For ch1:='(' to ')' do {Skobki}
s3:=copy(s,pos('(',s2)+1,pos(')',s2)-pos('(',s2)-1);
f:=length(s3);
IF pos('+',s)=(pos('(',s)-1) then {A+(A+B) A+(A*B)}
begin
delete(s,pos('(',s),1);
delete(s,pos('(',s)+length(s),1);
End;
s5:=s;
s7:=s;
IF pos('\',s7)=(pos('(',s7)-1) then {\(A+B)}
Begin
s6:=copy(s7,pos('(',s7)+1,pos(')',s7)-pos('(',s7)-1);
While pos('+',s6)>0 do
begin
s6[pos('+',s6)]:='\';
end;
delete(s,pos('(',s)+1,length(s6)+1);
insert(s6,s,pos('(',s)+1);
delete(s,pos('(',s),1);
End;

for g:=1 to 100 do
Begin
IF pos(per[g],s)=(pos('(',s)-1) then
begin
If pos('+',s)>pos('(',s) then
if pos('+',s)<pos(')',s) then {A*(A+B) }
begin
insert(per[g],s,pos('+',s)+1);
delete(s,pos('(',s),1);
delete(s,pos('(',s)+length(s),1);
End;
IF pos(per[g],s)=(pos('(',s)-1) then {A*(A*B)}
begin
delete(s,pos('(',s),1);
delete(s,pos('(',s)+length(s),1);
End;
End;
End;

result:=''; {Algoritm }
for ch:='A' to 'Z' do
if pos(ch,s)>0 then
result:=result+ch;
w:=result;
vars_count := 0; prs := '';
for ch := 'A' to 'Z' do
begin
if pos(ch, s) > 0 then
begin
inc(vars_count);
prs := prs + ch;
end;
end;
for i := 0 to pred(1 shl vars_count) do
begin
l_v := nul(Bin(i, 2), vars_count);
st := s + '+';
b_s := false;
repeat
p := pos('+', st);
if p > 0 then
begin
bs := copy(st, 1, pred(p));
b_m := true;
for j := 1 to length(prs) do
begin
pp := pos(prs[j], bs);
if pp > 0 then
begin
if (pp > 1) and (bs[pp - 1] = '\') then
begin
b_m := b_m and not(l_v[j] = '1')
end
else
begin
b_m := b_m and (l_v[j] = '1');
end;
end;
end;
delete(st, 1, p);
b_s := b_s or b_m;
end
until p = 0;
If b_s=true Then
begin
For j:=1 to length (w) do
Begin
if l_v[j]='1' then write(w[j]);
if l_v[j]='0' then write('\',w[j]);
End;
Write('+');
End;
end;
Writeln(' ' );

until finish;
end.




Вот задача которая должна булевскую функцию к нормальной форме приводить. Она и приводит, только проблема при работу со скобками. Неправильно она работает в случае типа: (A+B)(\A+C). \ - отрицание. Помогите ее доработать что бы в таких случаех результат был верен.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 23.09.2020 17:07
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name