Вот эта программа проверяет, является ли строка, заданная в S, приведенной к НСДФ (изменив несколько символов, можно сделать функцию, проверяющую на НСКФ) :D
Код
function noSpace(s: string): string;
var p: byte;
begin
repeat
p := pos(' ', s);
if p <> 0 then
delete(s, p, 1)
until p = 0;
noSpace := s
end;
const
maxTokens = 20;
stackIndex: integer = 0;
type
stackType = array[1 .. maxTokens] of string;
var
stack, localStack: stackType;
firstPass: boolean;
{ returns True if st already exists in s }
function insertStack(st: string; var s: stackType;
var index: integer): boolean;
var
i: integer;
begin
insertStack := True;
for i := 1 to index do
if s[i] = st then exit;
inc(index); s[index] := st;
insertStack := False
end;
{bubble sort}
procedure sort(var a: stackType; len: integer);
var
i, j: integer;
T: string;
begin
for i := 1 to len do
for j := 1 to len - i do
if a[j] >= a[j+1] then
begin
T := a[j]; a[j] := a[j+1]; a[j+1] := T;
end;
end;
function equalStacks(var a, b: stackType;
len: integer): boolean;
var i: integer;
begin
equalStacks := false;
for i := 1 to len do
if a[i] <> b[i] then exit;
equalStacks := true
end;
function getToken(delim: char;
var s: string): string;
var p: byte;
begin
getToken := '';
p := pos(delim, s);
if p <> 0 then
begin
getToken := Copy(s, 1, pred(p));
delete(s, 1, p); exit
end;
getToken := s; s := ''
end;
function checkToDf(delim: char;
s: string): boolean;
var
localStack: stackType;
nextToken: string;
i, index: integer;
exists: boolean;
begin
checkToDf := false;
index := 0;
while s <> '' do
begin
nextToken := getToken(delim, s);
if nextToken[1] = '\' then
delete(nextToken, 1, 1);
if insertStack(nextToken, localStack, index)
then exit;
if firstPass then
if insertStack(nextToken, stack, stackIndex) then exit;
end;
checkToDf := true;
if firstPass then
sort(stack, stackIndex)
else
if index = stackIndex then
begin
sort(localStack, index);
checkToDf := equalStacks(stack, localStack, index)
end
else checkToDf := false
end;
const
s: string = 'b*\a*c + \a*\b*c + a*\b*c + a*\b*\c'; {Ok}
(*
s: string = 'b*\a*c + \a*\b*c + a*\b*c + a*\b*\a*c'; {Ошибка}
*)
var
nextToken: string;
const
b: boolean = True;
begin
firstPass := True;
s := noSpace(s);
while (s <> '') and b do
begin
nextToken := getToken('+', s);
b := checkToDf('*', nextToken);
firstPass := False;
end;
if b then
writeln( 'This function is Ok' )
else
writeln( 'Error - wrong function' )
end.