Вычисление множественных выражений

Как мы знаем, алгебра множеств (определённая на булеане некоторого множества и с операциями пересечения, объединения и дополнения), как и алгебра высказываний, является булевой алгеброй.

Это позволяет нам интерпретировать формулы типа a&(b|-a)&c не только как ФБФ, но и как ФАМ (Формулы Алгебры Множеств). При этом, будем теперь сигнатурой < |, &, - > представлять множественные операции, соответственно, < объединение, пересечение, дополнение >.

Переменные a, b, c входящие в ФАМ теперь имеют не булевские значения 0, 1, а множества (точнее, подмножества некоторого универсального множества Un).

Как и с ФБФ, говоря о ФАМ, будем допускать в качестве операндов операций не только переменные, но и константы. Множественная константа будет представляться в виде списка (возможно, пустого) значений из Un, ограниченного квадратными скобками.
В этих обозначениях, значением, например, ФАМ: [1,7] | ( [2,3,1]&([2,3]|[]) ) будет считаться [1,2,3,7].

Поставим себе глобальной задачей, следуя выше указанным соглашениям и опыту создания логического калькулятора, построить теперь множественный калькулятор - функцию:
function SetCalc(fam: String):string, вычисляющую множественное значение заданной формулы fam.
Некоторые из подпрограмм, созданных нами в проекте построения лог. калькулятора могут пригодиться без изменений, некоторые придётся подкорректировать, а часть - создать дополнительно. В любом случае, общий сценарий работы над проектом, как глобальная структура функции SetCalc не будут отличаться от того, как это было с LogCalc.

Для определённости, зафиксируем универсальное множество Un и образованный от него булеан TSet в виде следующих определений (они будут считаться заявлеными на уровне главной программы, из которой запускается калькулятор):

  1. const L='0'; R='9';
  2.          Un=[L..R]
  3. type  TSet= set of L..R;

Начнём с нескольких простых, но при этом, важных подпрограмм, которые лягут в основу всего инструментария работы со множествами.

Задача1. Описать функцию StrToSet(s: String): TSet, которая вычисляет множественное значение по представляющему это значение стрингу s (например, по '[0,5,9]' ).

Задача2. Описать функцию SetToStr(ss: TSet):String , которая формирует стринговое представление заданного множественного значения ss ( т.е. решается задача, обратная к задаче1).

Задача3. Описать процедуру WrtSet(ss: TSet), которая выводит значение множества ss на дисплей.

Задача4. Описать процедуру RdSet(ss: TSet), которая читает в ss значение множества, набираемого в форме множественной константы на клавиатуре.

Приведённые задачи являются вспомогательными и образуют нулевую группу. Далее, рассмотрим перефразированные для множеств и уже знакомые нам задачи первой группы.

Внимание! Решений более, чем одной задачи за один раз не предлагать!

ПЕРВАЯ ГРУППА ЗАДАЧ: Вычисление константных (не содержащих переменных) множественных выражений.

Задача1м. Описать три реализующие основные множественные операции функции:

Function _or(x,y: String): String; //объединение (например, Writeln( _or(‘[0,5]’,’[1,0]’) ) выводит [0,1,5].
Function _and(x,y: String): String; //пересечение (например, Writeln( _and(‘[0,5]’,’[1,0]’) ) выводит [0].
Function _not(x: String): String; //дополнение (например, Writeln( _not(’[1,3,5,7,9],’) ) выводит [0,2,4,6,8].

Написать главную программу, которая на основе указанных функций вычисляет значение заданной в виде стринга элементарной константной ФАМ любого из следующих трёх видов: ‘a&b’, ‘a|c’, ‘-a’, где a,b - константные множества, а знаки &, |, - означают пересечение, объединение и дополнение 'множеств, соответственно (в формуле нет переменных, поэтому она называется константной). Например, если входная строка имеет вид ‘[0,5]|[1,0]’ , то результатом должно быть ‘[0,1,5]'.

При этом, программа должна только вводить исходную строку и выводить результат её вычисления. А для самого вычисления определить функцию:
function SetCalc0(S:String):String, где S-исходная формула.
Например Writeln( SetCalc0( ‘[0,5]|[1,0]’)) выведет ‘[0,1,5]'.

Задача2м. Расширить условие предыдущей задачи, разрешив входные строки в виде константных множественных формул произвольной (в пределах стринга) длины. Скобки внутри строки не используются, а порядок операций определяется с учётом их приоритетов (дополнение-пересечение-объединение).

Эту версию множественного калькулятора оформить как функцию: function SetCalc1(S:String):String.

Например Writeln( SetCalc1( ‘-[0]|-[0]&[]’ ) ) выведет [1,2,3,4,5,6,7,8,9].

Задача3м. Расширить условие предыдущей задачи, разрешив использование внутри множественных выражений круглых скобок (произвольной «правильной» структуры вложенностей).

Соответствующую версию калькулятора назвать SetCalc2.

Например Writeln( SetCalc2( ‘(-[0]|-[0])&0’ ) ) выведет [1].

ВТОРАЯ ГРУППА ЗАДАЧ: Вычисление множественных формул, содержащих переменные.

Задачи 4м - 7м напрямую соответствуют задачам 4 -7 для логического калькулятора. При этом решение задачи 4 (т.е. процедура vars) вообще войдёт в наш новый проект без каких-либо изменений.

Поэтому требуется: Самостоятельно перефразировать условия задач 5-7 применительно к ФАМ и предложить решения полученных задач 5м -7м в форме соответствующих подпрограмм, видоизменённых для новых условий. Имена подпрограмм, как впрочем, и их функциональность, сохранить прежними.

Это намного более простая часть уже пройденного пути. Удачи!

Задачи #1, #2 и #3.

Задача #1.

  1. function StrToSet(s: string): TSet;
  2.   var i: integer;
  3.       y: TSet;
  4. begin
  5.   y:=[];
  6.   for i:=1 to length(s) do begin
  7.     if s[i] in Un then y:=y + [s[i]];
  8.   end;
  9.   StrToSet:=y;
  10. end;

Задача #2.

  1. function SetToStr(ss: TSet): string;
  2.   var c: char;
  3.       s: string;
  4. begin
  5.   s:='';
  6.   for c in Un do begin
  7.     if [ c ] <= ss then s:=s + c;
  8.   end;
  9.   SetToStr:=s;
  10. end;

Задача #3.

  1. procedure WrtSet(ss: TSet);
  2. begin
  3.   Writeln(SetToStr(ss));
  4. end;
  5.  
  6. var a: string;
  7. Begin
  8.   read(a);
  9.   WrtSet(StrToSet(a));
  10.   readln;
  11. End.

Задача_2

  1.  function SetToStr(ss:Tset):string;
  2.   var c,comma:char;
  3.    temp:string;
  4.    i:byte;
  5.  begin
  6.   temp:='[';  // открывающая скобка множества
  7.   comma:=',';
  8.   for c:='0' to  '9' do begin // идем по универсальному множеству ...
  9.    if c in ss then begin   // если элемент из универсального множ-ва  есть во множ-ве ss
  10.     temp:=temp+c+comma; //  добавляем  его в temp, и добавляем запятую
  11.    end;
  12.   end;
  13.   temp[length(temp)]:=']'; // последнему элементу (он является запятой) присваиваем скобку ']'
  14.   setToStr:=temp;
  15.  end;

program xxx;   const

  1. program Сrossing;
  2.   const Un=['0'..'9'];
  3.   const l='0';
  4.   const r='9';
  5.   type Base='0'..'9';
  6.   TSet=set of Base;
  7.  var i:byte;
  8.   S:String;
  9.   z,t1,t2:Tset;
  10.  
  11. ...........................................................
  12. ...........................................................
  13.  
  14. function expr(S:String):char;
  15.   var lf,rt:byte;
  16.   S1,S2:String;
  17. begin
  18.   rt:=pos(']',S);
  19.  while rt<>0 do begin
  20.         lf:=rt;
  21.         while s[lf]<>'[' do Dec(lf);
  22.           s1:=Copy(s,lf+1,rt-lf-1);
  23.           Delete(s,lf,rt-lf);
  24.  end;
  25.         rt:=Pos(']',s);
  26.  while rt<>0 do begin
  27.         lf:=rt;
  28.         while s[lf]<>'[' do Dec(lf);
  29.           s2:=Copy(s,lf+1,rt-lf-1);
  30.  end;
  31. ...........................................................
  32. end;// функция,по идее разбивающая начальный стринг на два подстринга, содержащих будущие множества, с которыми мы и будем работать
  33.  
  34. function StrToSet(S1,S2:String):Tset;
  35.   var i:byte;
  36.    t1,t2:TSet;
  37. begin
  38.   t1:=[];
  39.   for i:=2 to length(s1) do begin
  40.     if S1[i] in [l..r] then t1:=t1+[S1[i]];
  41.   end;
  42.   t2:=[];
  43.   for i:=2 to length(s2) do begin
  44.     if S2[i] in [l..r] then t2:=t2+[S2[i]];
  45.   end;
  46.  StrToSet:=t1=t2; // (а так нельзя присвоить имени функции ее значения?или это надо делать после каждого If?)
  47. end;// функция, преобразующая эти подстринги во множества

Никита, не следует помещать в

Никита, задача2 Вами решена верно. Но не следует помещать в тексты описаний функций явные консанты (типа '0', '9' и т.п.). Тем более, что я уже эти константы объявил и именовал в постановке задачи. Нужно работать только с именами.

Ксения, Ваш текст не соответствует условиям поставленных задач. Главная программа пока не требуется, а заголовок функции StrToSet отличается от того, который объявлен в условии. Да и делает эта ф-ция явно что-то не то (и конечно же, одной переменной, каковой является имя этой функции, одновременно невозможно присвоить два значения!). Разберитесь повнимательней с условием. Хотя эта ф-ция, соответствующая задаче1 (как и ф-ция задачи3) уже реализована Апишевым А.(см. выше).

ок

в последующих решениях учту этот момент )

Добавлены ещё три задачи!

Добавлены ещё три задачи!

Ок

сейчас посмотрю

Задача 4

  1. procedure RdSet(ss:tset);
  2.     var s:string;
  3. begin
  4.     writeln('Введите множество : ');
  5.     readln(s);
  6.     ss:=strtoset(s);
  7. end;

Валерий Шахамболетович

при тестировании функций _or и _and в Паскале АВС :
Результат пересечения и объединения одинаковый !?

Writeln( _or(‘[0,5]’,’[1,0]’) ) выводит [0,1].
Writeln( _and(‘[0,5]’,’[1,0]’) ) выводит [0,1].

В Делфи все работает отлично:

Writeln( _or(‘[0,5]’,’[1,0]’) ) выводит [0,1,5].
Writeln( _and(‘[0,5]’,’[1,0]’) ) выводит [0].

С чем это может быть связано ?

Добрый вечер, Валерий

Добрый вечер, Валерий Шахамболетович. Хочу обратиться к вам за помощью. сейчас пытаюсь решить задачу , но застряла вот на таком моменте:

  1. Function _or(x,y: String): String;
  2.   var i,j:byte;
  3.       s2,s1:Tset;
  4. begin
  5.   s1:=[];
  6.   s2:=[];
  7.   for i:=1 to length(x) do begin
  8.     s1:=s1+[x[i]];
  9.   end;
  10.   s1:=SetToStr(s1);
  11.   for j:=1 to length(y) do begin
  12.         s2:=s2+[y[i]];
  13.   end;
  14.   s2:=SetToStr(s2);
  15. end.

даже просто при тестировании этой функции выходит ошибка "попытка присвоить переменной типа set of выражения типа string." Подскажите подалуйста, где изначально пошла ошибка, чтобы можно было исправить и работать дальше

Вика

Функцию _or можно проще описать

  1. Function _or(x,y: String): String;
  2. begin
  3.  _or:=settostr(strtoset(x) + strtoset(y));
  4. end;

спасибо, Никит, уже поняла:-)

спасибо, Никит, уже поняла:-)

хотя все равно выводит

хотя все равно выводит неправильный ответ, Никита. что-то здесь не так...

Вика

посмотри коммент [Пт, 01/03/2013 - 23:50 — Никита Ширшов]

Задача 1м

  1. program zadaca;
  2.  const L='0'; R='9';
  3.       Un=[L..R];
  4.  type  TSet= set of L..R;
  5.  var st:string;
  6.  
  7. // function SetToStr;
  8.  //function StrToSet;
  9.  
  10.  Function _or(x,y: String): String;  //реализация объединения
  11.  begin
  12.   _or:=settostr(strtoset(x) + strtoset(y));
  13.  end;
  14.  
  15.  Function _and(x,y: String): String; //реализация пересечения
  16.  begin
  17.   _and:=settostr(strtoset(x) * strtoset(y));
  18.  end;
  19.  
  20.  Function _not(x: String): String; // реализация дополнения
  21.  begin
  22.   _not:=settostr(un-strtoset(x));//из универсального вычитаем заданное множ-во
  23.  end;
  24.  
  25.  function SetCalc0(S:String):String; //вычисление ФАМ с константными операндами
  26.   var i,j:byte;
  27.       s1:string;
  28.  begin
  29.   s1:='';
  30.  // вычисление дополнения
  31.   if s[1]='-' then SetCalc0:=_not(copy(s,2,length(s)-1)); // копируем подстроку со 2-й позиции длины length(s)-1
  32. //вычисление пересечения
  33.   j:=pos('[',s); //позиция открывающей скобки
  34.   i:=pos('&',s);// позиция '&' ...
  35.   if i<>0 then begin //если она не равна 0, то
  36.    s1:=copy(s,j,i-1); // копируем подстроку до знака '&'
  37.    delete(s,j,i); // удаляем подстроку от открывающей скобки  до 2-й открывающей
  38.    SetCalc0:=_and(s1,s);
  39.   end;
  40. //вычисление объединения
  41.   i:=pos('|',s);  //аналогично как и для пересечения
  42.   if i<>0 then begin
  43.    s1:=copy(s,j,i-1);
  44.    delete(s,j,i);
  45.    SetCalc0:=_or(s1,s);
  46.   end;
  47.  end;//function SetCalc0
  48.  
  49. begin //главная программа
  50.  Writeln('Введите ФАМ: ');
  51.  readln(st);
  52.  writeln('Результат: ',SetCalc0(st) );
  53. end.

Задача 2м.

Прошу вашей помощи. После ввода ФАМ выдаёт пустую строку. Я не могу найти ошибку. Мне кажется, что всё работает корректно, и вроде трассировкой проверял, но всё равно.

  1. function SetCalc1(s: string): string;
  2.   var k,l,r: integer;
  3.       x: string;
  4. begin
  5.   x:='';
  6.   k:=Pos('-',s);
  7.   while k<>0 do begin
  8.     r:=Pos(']',(copy(s,k+1,length(s)-k)));
  9.     x:=_not(copy(s,k+1,r));
  10.     Insert(x,s,k);
  11.     k:=Pos('-',s);
  12.   end; //while '-'.
  13.  
  14.   k:=Pos('&',s);
  15.   while k<>0 do begin
  16.     l:=k-1;
  17.     while s[l]<>'[' do
  18.       l:=l-1;
  19.       r:=Pos(']',(copy(s,k+1,length(s)-k)));
  20.       x:=_and(copy(s,l,k-1),copy(s,k+1,r));
  21.       Insert(x,s,l);
  22.       k:=Pos('&',s);
  23.   end; //while '&'.
  24.  
  25.   k:=Pos('|',s);
  26.   while k<>0 do begin
  27.     l:=k-1;
  28.     while s[l]<>'[' do
  29.       l:=l-1;
  30.       r:=Pos(']',(copy(s,k+1,length(s)-k)));
  31.       x:=_or(copy(s,l,k-1),copy(s,k+1,r));
  32.       Insert(x,s,l);
  33.       k:=Pos('|',s);
  34.   end; //while '&'.
  35.   SetCalc1:=s;
  36. end;

Никита, не знаю, может дело в

Никита, не знаю, может дело в версии Паскаля, но при реализации твоего кода, программа выводит в качестве ответа (при операциях объединения или пересечения) всегда выдает то множество, которое было введено последним. Я тоже столкнулась с такой проблемой при написании кода, и не пойму в чем дело.

задача 2м

  1. function SetCalc1(S:String):String;
  2.    var j,i:byte;
  3.       s1:string;
  4.  begin
  5.    i:=Pos('-',s);//позиция знака "-" в строке
  6.    While i<>0 do Begin// пока эта позиция не равна нулю
  7.      Delete(s,i,1);//удаляем знак ''-''
  8.      s:=_not(s);
  9.      SetCalc1:=SetToStr(StrToSet(s));
  10.      i:=Pos('-',s);//проверяем, существует ли еще позиция этого знака
  11.    End;
  12.    i:=Pos('&',s);
  13.    j:=pos('[',s);
  14.    while i<>0 do begin
  15.      s1:=copy(s,j,i-1);
  16.      delete(s,j,i);
  17.      SetCalc1:=_and(s1,s);
  18.      i:=Pos('&',s);
  19.    end;
  20.    i:=Pos('|',s);
  21.    while i<>0 do begin
  22.      s1:=copy(s,j,i-1);
  23.      delete(s,j,i);
  24.      SetCalc1:=_or(s1,s);
  25.      i:=Pos('|',s);
  26.    end;
  27.  end;

Задача 2М

  1. function SetCalc1(s:string):string;
  2.  var  i,j,k:byte;
  3.       t,a:string;
  4. begin
  5.  t:='';
  6.  a:='';
  7.  i:=pos('-',s);
  8.  while i<>0 do begin
  9.     j:=i;
  10.     while s[j]<>']' do begin
  11.      inc(j);
  12.     end;
  13.     t:=_not(copy(s,i+1,j-i));
  14.     delete(s,i,j-i+1);
  15.     Insert(t,s,i);
  16.     i:=Pos('-',s);
  17.   end;
  18.   i:=pos('&',s);
  19.   j:=i;
  20.   k:=i;
  21.   while i<>0 do begin
  22.    while s[j]<>'[' do dec(j);
  23.    while s[k]<>']' do inc(k);
  24.    a:=copy(s,j,i-1);
  25.    t:=copy(s,i+1,k-1);
  26.    t:=_and(t,a);
  27.    delete(s,j,k);
  28.    insert(t,s,i);
  29.    i:=pos('&',s);
  30.   end;
  31.   i:=pos('|',s);
  32.   j:=i;
  33.   k:=i;
  34.   while i<>0 do begin
  35.    while s[j]<>'[' do dec(j);
  36.    while s[k]<>']' do inc(k);
  37.    a:=copy(s,j,i-1);
  38.    t:=copy(s,i+1,k-1);
  39.    t:=_and(t,a);
  40.    delete(s,j,k);
  41.    insert(t,s,i);
  42.    i:=pos('|',s);
  43.   end;
  44.  setcalc1:=s;
  45. end;

[Пт, 01/03/2013 - 22:10 —

[Пт, 01/03/2013 - 22:10 — Тураев Валентин] - OK.

[Пт, 01/03/2013 - 22:50 — Никита Ширшов] - нет объяснения (я не знаком с возможными ограничениями ABC).

[Пт, 01/03/2013 - 22:55 — Белецкая Виктория] - В строках 10, 14 в левой части присваивания TSet, а в правой - String. Присвоить не возможно, о чём Вам и сообщается системой. Кроме того, в циклах во множества s1 и s2 собираются ВСЕ символы изображения константы, включая запятые и знаки "[","]". Никита показал Вам идеальное решение этой, а несколько ниже, и других подобных задач.

[Сб, 02/03/2013 - 09:47 — Апишев Асхад] (и, частично, Никита) - превышен оптималный размер кода модуля. Отсюда дублирования строк, усложнение логики. Копаться в этом, я уже писал, никакой охоты нет.
Вместо этого покажу, как бы, например, задачу2м (она обобщает 1м) решал я.

1. Т.к. задача извлечения из строки аргумента для элементарной операции (&,|,-) усложнилась, имеет смысл оформить её как пару полезных процедур:

  1. //Ищет в s левую (L) и правую (R) границы ближайшего
  2. //к поциции p справа аргумента (константного множества)
  3. Procedure rarg(s: String; p: Byte; var L, R: Byte); // Арумент справа от p
  4. Begin
  5.     L:=p+1;
  6.     While s[L] <>'[' Do Inc(L);
  7.     R:=L+1;
  8.     While s[R] <>']' Do Inc(R);
  9. End;
  10.  
  11. //Ищет в s левую (L) и правую (R) границы ближайшего
  12. //к поциции p слева аргумента (константного множества)
  13. Procedure larg(s: String; p: Byte; var L, R: Byte); // Арумент слева от p
  14. Begin
  15.     R:=p-1;
  16.     While s[R] <>']' Do Dec(R);
  17.     L:=R-1;
  18.     While s[L] <>'[' Do Dec(L);
  19. End;

2. T.к логика обработки бинарных операций совпадает (их могло быть и больше чем две!), то для исключения дублирования кода оформим и её как процедуру:

  1. //Выполнить бинарную операцию со знаком (& или |) в позиции p.
  2. Procedure BinCalc(var fam: String; p:Byte);
  3.    Var L,R, L1,R1: Byte;
  4.          res,s1,s2: String;
  5. Begin
  6.    larg(fam,p,L,R);
  7.    s1:= Copy(fam, L, R-L+1); //1-й аргумент
  8.    L1:=L;  // начало элементарной подформулы
  9.    rarg(fam,p,L,R);
  10.    s2:= Copy(fam, L, R-L+1); //2-й аргумент
  11.    R1:=R; // конец элементарной подформулы
  12.    case fam[p] of //вычисляем результат операции
  13.         '&': res:=_and(s1,s2);
  14.         '|': res:= _or(s1,s2)
  15.    End;
  16.    Insert(res, fam, R1+1); //вставляем результат за подформулой ...
  17.    Delete(fam, L1 R1-L1+1) // ... и удаляем саму эту подформулу.  
  18. End;

3. Реализация SetCalc1 теперь упростилась:

  1. Function SetCalc1(fam:String):String;
  2.    Var p,L,R: Byte;
  3.          res: String;
  4. Begin
  5.    p:=Pos('-', fam); //обработка дополнений
  6.    While p<>0 Do Begin
  7.        rarg(fam,p,L,R);
  8.        res:= _not(Copy(fam,L,R-L+1));
  9.        Insert(res,fam,R+1);
  10.        Delete(fam, p, R-p+1);
  11.        p:=Pos('-', fam);
  12.    End;
  13.    p:=Pos('&', fam); //обработка пересечений
  14.    While p<>0 Do Begin
  15.         BinCalc(fam,p);
  16.         p:=Pos('&', fam);
  17.    End;
  18.    p:=Pos('|', fam); //обработка пересечений
  19.    While p<>0 Do Begin
  20.         BinCalc(fam,p);
  21.         p:=Pos('|', fam);
  22.    End;
  23.    SetCalc1:=fam;
  24. End;

Всё. Не проверял, так что могут быть ошибки - буду признателен, если найдёте.

Последние Ваши варианты

Последние Ваши варианты страдают теми же недостатками, что и упоминавшееся мною выше - они, в силу плохо продуманной логики их построения, либо не верны (Виктория - ошибка уже при обработке "-"), либо аморфно-многословны (Валентин) и не обеспечивают элементарных условий сколько-нибудь тщательной их проверки.
Практически, программы последней категории бесполезны, т.к., даже если и не содержат ошибок (что редкость), сопровождение их (перестройка, дополнение, расширение функций, адаптация к специфичным условиям эксплуатации и т.д.) оказывается не возможным.
Модульность, модульность и ещё раз модульность! : Порядка 20 строк кода на модуль - это тот предел, за который не следует выходить.

Дело не только в том, что продуманная модульность может уменьшить суммарный размер кода, а в том, что существенно улучшает возможности понимания логики программы, возможности её тестирования и внесения изменений.

P.s. Кстати, при желании размер кода моей реализации SetCalc1 можно ещё уменьшить, если заметить, что два последних цикла имеют одинаковую структуру, но это, возможно, уже перебор.

Валерий Шахамболетович,

Валерий Шахамболетович, насколько я понимаю, в процедуре BinCalc в строке 6 и 9 неверное количество фактических параметров. Если я не ошибаюсь, должно быть так:

  1. larg(fam,p,L,R);//строка 6
  2. rarg(fam,p,L,R);//строка 9
.
В функции SetCalc1 не хватает описания
  1. var l,r,p:byte;
  2.     res:string;
.
Еще функция, при вызове, не выдает результат, но я пока не разобралась почему

Насколько Я понял.

Под модульностью Вы подразумеваете написание дополнительных, а точнее вспомогательных, процедур или функций, на основе которых будет строиться решение поставленной задачи. Так ведь?

В варианте 3:

В SetCalc1 нужно завести переменные L, R о чем написала Вика а далее в теле

  1. Function SetCalc1(fam:String):String;
  2.  var l,p,r:byte;
  3. Begin
  4.   p:=Pos('-', fam); //обработка дополнений
  5.   l:=p+1;
  6.   r:=p-1;
  7.   ....
  8.   p:=Pos('&', fam); //обработка пересечений
  9.   l:=p+1;
  10.   r:=p-1;
  11.  ...
  12.   p:=Pos('|', fam); //обработка объединений
  13.   l:=p+1;
  14.   r:=p-1;
  15.   ....
  16.  

Выше описанные процедуры и функции

rarg, larg, BinCalc , SetCalc1 работают правильно (с учётом моих поправок и поправок Вики ), ошибка состояла в ранее описанной функции SetToStr.
ошибка в следующем:

  1.  function SetToStr(ss:Tset):string;
  2.   ....
  3.  begin                                // если  ss пустое множество,то
  4.   temp:='[';  
  5.   comma:=',';                        
  6.   for c:=l to  r do begin          
  7.    if c in ss then begin           // в temp не попадёт ни один элемент из универсального множества,
  8.     temp:=temp+c+comma;     // то есть , temp не изменится (    будет равен '[' )
  9.    end;                                                
  10.   end;                         // а так как length(temp)=1, то мы присвоим temp закрывающю скобку ']'
  11.   temp[length(temp)]:=']';  
  12.   SetToStr:=temp;  //   SetToStr =']' (неправильная структура множества и дальнейшие действия не возможны!)
  13.  end;

Вот поэтому программа не выдает результат!

Исходя из вышесказанного, можно сделать следующее:
Проверить является ли ss пустым или нет...

  1. function SetToStr(ss:Tset):string;
  2. ...
  3. begin      
  4.  if ss=[] then  SetToStr:='[]'  // если ss пустое, то SetToStr присваиваем  '[]'
  5.  else begin // иначе ....
  6.   temp:='[';
  7.   comma:=',';
  8.   for c:=l to  r do begin
  9.    if c in ss then begin
  10.     temp:=temp+c+comma;
  11.    end; //if
  12.   end; //for
  13.   temp[length(temp)]:=']';
  14.   SetToStr:=temp;
  15.  end;//else
  16. end; //SetToStr

SetCalc1 test

Поправки Вики принял(добавил пропущенные аргументы вызовов и описания переменных). Молодец, быстро среагировала!

Поправки Никиты с L и R отклонил, т.к. они не верны. Роль rarg и larg как раз и состоит в том, чтобы УСТАНАВЛИВАТЬ значения L и R (которые являются выходными параметрами)!.

ВСЁ РАБОТАЕТ!

По крайней мере, прошли мои тесты:

  1. ...
  2. begin
  3.   Writeln(SetCalc1('-[1,3]') );
  4.   Writeln(SetCalc1('[1,6,9]|[6,0]'));
  5.   Writeln(SetCalc1('[1,6,9]|[6,0]&-[0,1,2,3,4,5,7,8,9]'));
  6.   Readln;
  7. end.

Допускаю, что вы не из тех модулей собрали (были же и ошибочные варианты реализаций!), поэтому свою сборку показываю здесь.

Ок

Ошибку свою понял, а Вы можете протестировать вот такое выражение в Вашей версии? '-[0]&[]’

Последнюю Вашу поправку

Последнюю Вашу поправку SetToStr принимаю не тестируя. Честно говоря, я эту ошибку видел, но сразу не стал о ней говорить, т.к. у меня были и другие претензии к этой Вашей реализации и хотелось обсудить её подробней. А потом забыл ...

Задача 3м

  1.  function SetCalc2(s:string):string; //вычисляет константную формулу со скобками
  2.   var r,l:byte;
  3.   t: string;
  4.  begin
  5.   t:='';
  6.   r:=pos(')',s);
  7.   While r<>0 Do Begin  //Пока в выражении есть правая скобка ')'
  8.    l:=r;
  9.    while s[l]<>'(' do dec(l);  // находим соответствующую левую скобку
  10.     t:=copy(s, l+1,r-l-1);    // извлекаем ФАМ, которую они окаимляют
  11.     t:= Setcalc1(t);   //вычисляем это значение ФАМ
  12.     insert(t,s,r+1);   //вставляем результат за подформулой
  13.     delete(s,l,r-l+1);  // удаляем саму эту подформулу
  14.     r:=pos(')',s);      // ищем следующую правую скобку
  15.    end;
  16.    SetCalc2:=Setcalc1(s);  //оставшуюся строку передаем в   Setcalc1
  17.  end;

Да, реализация задачи 3 почти

Да, реализация задачи 3 почти та же, что и для лог. калькулятора.

Но возвращаясь к Вашей SetToStr (я сказал, что там были и другие недостатки), отмечу печальное:
Если в один прекрасный момент я скажу: "А давайте ка теперь поработаем с подмножествами другого универсума" и мы радостно переопределим Um, например, так const L='a'; R='q'; ... , то возникнет восхитительный повод снова вспомнить об авторе модуля SetToStr ...

Да, но Вы мне уже говорили об

Да, но Вы мне уже говорили об этом недостатке [Пт, 01/03/2013 - 21:50 — VTlyusten]
о том что "... не следует помещать в тексты описаний функций явные консанты (типа '0', '9' и т.п.)...Нужно работать только с именами..." (в данном случае R, L)

Да, говорил, но вот не учёл

Да, говорил, но вот не учёл включая в комплекс. Сейчас поправлю...

2-я группа задач для ФАМ

Смотрите выше, в конце условий задач для ФАМ.

Ок

Ок

Валерий Шахамболетович

Я отправил Вам на почту задачи 5м-7м

Кстати, задача 5м тоже

Кстати, задача 5м тоже останется без изменения...

Задача 5м

  1. procedure inargs(vlst: String; var arglst:String); //ввести значения переменных списка vlst ...
  2.     // ... в список arglst
  3.  var  i: byte;
  4.       a: string;
  5. begin
  6.  arglst:='';
  7.  for i:=1 to length(vlst) do begin // каждую переменную списка ...
  8.   write('Множество ',vlst[i],'=');  // ... показать ...
  9.   readln(a);   // ... ввести для неё значение и ...
  10.   arglst:=arglst+a;  // ... разместить это значение в результирующем списке
  11.  end;
  12. end;

Решения задач 5м -7м

Никита, почту получил.
Решения задач 5м [Пнд, 04/03/2013 - 08:15 — Никита Ширшов] и 7м (SetCalc) без замечаний.
Ваш текст SetCalc выложу без изменений:

  1. function SetCalc(fbf:string):string; //вычисление формулы, содержащей переменные
  2.  var vlst, arglst:string;
  3. begin
  4.   vars(fbf,vlst); //по заданной формуле формируем список её переменных
  5.   inArgs(vl, arglst); // вводим значения для этих переменных
  6.   toConst(fbf,vlst,arglst); // и заменяем переменные в формуле введёнными значенмями
  7.   SetCalc:=SetCalc2(fbf);  // вычисляем полученную константную формулу
  8. end;

А Ваше решение 6м (toConst) можно упростить. Кроме того, необходимы более компактные комменты. Те, которые представили Вы - затрудняют общее восприятие текста программы. Для сохранения структуры и читабельности программы, всегда желательно, чтобы построчные пояснения операторов не выходили за пределы операторных строк. Да и смысловую содержательность комментариев не лишне бы повысить.
После небольшой моей редакции вот что получилось:

  1. procedure toConst(var fam: String; vlst: String; arglst:String);
  2. //замена переменных в формуле fam их значениями (множествами)
  3.  var i,l,r,p:byte;
  4.       val: string;
  5. begin
  6.   for i:=1 to length(vlst)do begin //для каждой перем. из fam...
  7.     rarg(arglst,0,l,r); //... выделяем её значение ...
  8.     val:=copy(arglst,l,r-l+1);  //... и заносим в val.
  9.     p:=pos(vlst[i],fam);//Находим позиц.вхожд.этой перем.в fam
  10.     while p<>0 do begin  //Пока есть вхождения этой перемен. ...    
  11.        insert(val,fam,p+1); //вставляем её знач. за ней ...
  12.        delete(fam,p,1);  //... а саму её удаляем.
  13.        p:=pos(vlst[i],fam); //Ищем следующее её вхождение в fam
  14.     end;//while
  15.     delete(arglst,l,r-l+1); //Удаляем обработан. знач. из arglst  
  16.   end; //for
  17. end; //toConst

Ок

Валерий Шахамболетович, посмотрите здесь пузырьковую сортировку записей файлов