Вычисление логических выраженний.

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

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

Задача1. Описать три реализующие основные булевы операции функции:
Function _or(x,y: Char): Char; //дизъюнкция (например, Writeln( _or(‘0’,’1’) ) выводит 1.
Function _and(x,y: Char): Char; //конъюнкция (например, Writeln( _and(‘0’,’1’) ) выводит 0.
Function _not(x: Char): Char; //отрицание (например, Writeln( _and(’1’) ) выводит 0.

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

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

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

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

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

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

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

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

ВТОРАЯ ГРУППА ЗАДАЧ: Вычисление логических выражений с переменными.

Будем теперь считать, что заданное логическое выражение (формула булевой функции) содержит в качестве операндов не только константы (0,1), но также, возможно, переменные, обозначенные латинскими малыми буквами. Одна и та же буква может входить в формулу многократно.
Например, логической формулой теперь является стринг: 'a&1&((-b|a)&z)'

Задача4. Описать и протестировать процедуру procedure vars(fbf:String; var vlst: String);, которая по заданной формуле булевской функции fbf формирует упорядоченный список входящих в неё переменных vlst.

Задача5. Описать и протестировать процедуру procedure inargs(vlst: String; var arglst:String);, которая по заданному списку переменных vlst вводит список соответствующих им двоичных значений arglst. При этом, элементы списка arglist должны запрашиваться с клавиатуры, как значения соответствующих переменных из списка vlst.

Например, вызов процедуры inargs('xy',s) должен привести к выводу подсказки:
x=
Затем, после ввода, например 0, должно последовать:
y=
После ввода на этот раз, например, 1, процедура должна завершиться, сформировав результат s='01' .

Задача6. Описать и протестировать процедуру procedure toConst(var fbf: String; vlst: String; arglst:String);, которая по заданной формуле fbf, заданному списку её переменных vlst и списку значений этих переменных arglst заменяет переменные в формуле их значениями, формируя, тем самым, константную логическую формулу.

Например, в результате выполнения:
s:= 'x&(1|-b&x';
toConst( s, 'xb','10') );
получим s= '1&(1|-0&1'

Задача7. Используя выше приведённые подпрограммы, "собрать" из них логический калькулятор - функцию function LogCalc(fbf: String), которая вычисляет значение логического выражения fbf, запрашивая при необходимости значения содержащихся в ней переменных.

ФИНАЛЬНЫЙ ШАГ:

Задача8. Используя необходимые модули из набора задач 1-7 построить процедуру:
procedure TabIst(fbf:String); которая строит таблицу истинности для заданной формулы fbf.

Подсказка. Для генерации в естественном порядке всех двоичных наборов заданной длины (по одному набору на каждую строку), возможно, будет полезно построить 2-3 простенькие подпрограммки. В частности подпрограмму procedure next(var args:String), которая на стринге имитирует прибавление единицы к числу, представленному своим двоичным значением (т.е. переход от одного "двоичного набора" к следующему).
И еще. Здесь наверное удобней воспользоваться top-down подходом к разработки программ - сначала напишите код нужной вам процедуры TabIst, используя как существующие, так и не существующие пока, но желательные для вас подпрограммы, а уж потом, займитесь тем, чего ещё нет.

Задачи ДМ/Программирование

Приглашаю желающих набрать баллы в форум ДМ. Прошу тех, кто уже в теме, не засыпать форум уже готовыми решениями. Не нужно также предлагать решение ВСЕХ задач за один раз. Дайте шанс увидеть условия и поучаствовать другим.
В любом случае, приветствуется активность. Удачи!

Задача 1 функция "AND"

Если я правильно понял задачу, то вот одна элементарная функция

program BF;
var s:string[3];
s1,s2,s3:boolean;
function MyAnd (a,b:char):char;
begin
s1:=(a='1');
s2:=(b='1');
s3:=(s1 and s2);
if s3 then MyAnd:='1'
else MyAnd:='0';
end;
begin
write('Введите функцию ');
readln(s);
if s[2]='&' then write('Результат ', MyAnd(s[1],s[3]));
readln;
end.

P.S. Забыл каким тегом обозначить код программы

задача 1

вот код к 1-й задаче, правда без функции LogCalc, не совсем понимаю, как её здесь использовать

  1. program Logika;
  2. var s:string;
  3.     x,y,c:char;
  4.  
  5.   function _and(x,y:Char):Char;
  6.        var c:Bin;
  7.   begin
  8.      if ((x='0')or(y='0')) then _and:='0'
  9.      else _and:='1';
  10.   end;
  11.   Function _or(x,y: Char): Char;
  12.   begin
  13.      if ((x='1')or(y='1')) then _or:='1'
  14.      else _or:='0'
  15.   end;
  16.   function _not(x:char):Char;
  17.   begin
  18.       if (x='1') then _not:='0'
  19.       else _not:='1';
  20.   end;
  21.   begin
  22.      writeln('vvedite phormulu');
  23.      read(s);
  24.        if (s[1]='-') then begin writeln(s[2],'=');
  25.            read(x); c:=_not(x);
  26.        writeln(c);
  27.        end;//if
  28.        if (s[2]='&')then begin
  29.          writeln(s[1],'=');
  30.          read(x);
  31.          writeln(s[3],'=');
  32.          read(y);
  33.          writeln(_and(x,y))
  34.        end;//if
  35.        if  (s[2]='|') then begin
  36.          writeln(s[1],'=');
  37.          read(x);
  38.          writeln(s[3],'=');
  39.          read(y);
  40.          writeln(_or(x,y));
  41.        end//if
  42.  
  43.  
  44.   end.

Дмитрий, код оформлять

Дмитрий, код оформлять так:
вначале пишешь < pre> а в конце < /pre>, только без пробелов

Дмитрий,Виктория.

Дмитрий. Не оформленный код не рассматривается.

Виктория. Три элементарные функции без замечаний. Но странно, что Вы не поняли фразы:
программа должна только вводить исходную строку и выводить результат её вычисления. А для самого вычисления определить функцию: function LogCalc0(S:String):Char
Т.е. весь алгоритм вычисления значения формулы S спрятан в функцию LogCalc0, которую и вызывает главная программа. Так что конкретно здесь не понятно? Да и задача в целом решается не корректно. Никаких переменных X, значения которых надо было бы вводить, внутри формулы нет. Она (формула) по условию КОНСТАНТНАЯ!

Никита Ширшов аватар

А я, первую задачу решил бы иначе...

  1. program logical;
  2.  type lb=0..1;
  3.  var s:string;
  4.  
  5.  function bin(x,y,z:char):lb;
  6.  begin
  7.   if z='|' then begin   //дизьюнкция
  8.    if (x='1')and (y='1' )then  bin:=1
  9.    else bin:= (ord(x)-ord('0'))+(ord(y)-ord('0')) ;
  10.   end; //дизьюнкция
  11.  
  12.   if z='&' then begin  // коньюнкция
  13.    bin:=(ord(x)-ord('0')*(ord(y)-ord('0'))) ;
  14.   end;// коньюнкция
  15.  end; //function bin
  16.  
  17.  function otr(x:char):lb;  // отрицание
  18.  begin
  19.   otr:=1-(ord(x)-ord('0'))
  20.  end; // function otr
  21.  
  22. begin
  23.  writeln('Введите ФБФ:');
  24.  readln(s);
  25.  if s[1]='-' then begin  // если s[1]='-' ,   то выполнить отрицание
  26.   writeln('Результат =  ', otr(s[2]))
  27.  end
  28.  else begin   // иначе выполнить коньюнкцию или дизьюнкцию  (зависит от s[2])
  29.   writeln('Результат =  ',bin(s[1],s[3],s[2]))
  30.  end;
  31. end.

Панова Ксения аватар

Почему то выводит результат

Почему то выводит результат почти всех простейших формул, кроме 0&0...выводит ошибку-"выход за границы диапозона интервального типа"..Почему?

Панова Ксения аватар

P.S. это на АВС, т.к. другие

P.S. это на АВС, т.к. другие среды у меня вообще не работают на комп-е

Никита Ширшов аватар

Ксения..

Твой первый вопрос кому адресован?

Панова Ксения аватар

Ну можешь и ты ответить,если

Ну можешь и ты ответить,если понимаешь почему так)

Панова Ксения аватар

По сути ты решил и вторую

По сути ты решил и вторую задачу..

Никита Ширшов аватар

Все дело в скобках...

я немного ошибся...
вместо выражения в 13-й строке

  1. ...
  2.  bin:=(ord(x)-ord('0')*(ord(y)-ord('0'))) ;
  3. ...

нужно написать:
  1. ...
  2.  bin:=((ord(x)-ord('0'))) * ((ord(y)-ord('0'))) ;
  3. ...

Панова Ксения аватар

точно..скобки..да,работает.сп

точно..скобки..да,работает.спасибо

Никита Ширшов аватар

Ксения

не за что=)

Никита, задача1 не решена.

Задача1 не решена. Представленные коды абсолютно не соответствуют изложенным мною условиям и спецификациям подпрограмм.
В реализации элементарных булевских операций совершенно точной была Виктория.

Никита Ширшов аватар

А если так?

  1. program logical;
  2.  type lb='0'..'1';
  3.  var s1:string;
  4.  
  5.  function _or(x,y:char):lb;
  6.   var t:0..1;
  7.  begin
  8.   if (x='1')and (y='1' )then  _or:='1'
  9.   else begin
  10.    t:=(ord(x)-ord('0'))+(ord(y)-ord('0')); // t=0 или t=1
  11.    _or:=chr(ord('0')+t);  ;  // перевод  из цифры в символ (например, 1-> '1' )
  12.   end; // else
  13.  end; //functoin _or
  14.  
  15.  function _and(x,y:char):lb;
  16.   var t:0..1;
  17.  begin
  18.   t:=(ord(x)-ord('0'))*(ord(y)-ord('0')); // t=0 или t=1
  19.   _and:=chr(ord('0')+t); // перевод  из цифры в символ (например, 1-> '1' )
  20.  end; // function _and
  21.  
  22.  function _not(x:char):lb;
  23.  begin
  24.   if x='1' then _not:='0'
  25.   else _not:='1'
  26.  end; // function _not
  27.  
  28.  function LogCalc(S:String):lb;
  29.  begin
  30.   if s[1]='-' then begin
  31.    LogCalc:=_not(s[2]) // если s[1] ='-'  , то вызываем функцию _not(s[2])
  32.   end
  33.   else begin  //иначе
  34.    if s[2]='|' then LogCalc:=_or(s[1],s[3]); // если  s[2]='|' , то вызываем функцию  _or(s[1],s[3] )
  35.    if s[2]='&' then LogCalc:=_and(s[1],s[3]); // если s[2]='&'  ,то  вызываем функцию _and(s[1],s[3])
  36.   end
  37.  end; // function LogCalc
  38.  
  39. begin
  40.  writeln('Введите ФБФ:');
  41.  readln(s1);
  42.  writeln('Результат = ', LogCalc(s1));
  43. end.

на мой взгляд, строки в коде

на мой взгляд, строки в коде Никиты, начиная с 9-ой можно упростить

  1. function _or(x,y:char):lb;
  2.  begin
  3.   if (x='1')and (y='1' )then  _or:='1'
  4.   else begin
  5.         _or:='0';
  6.   end; // else
  7. end; //functoin _or
  8.  
  9.  
  10.  
  11.  function _and(x,y:char):lb;
  12.  begin
  13.    if ((x='0')or(y='0')) then _and:='0'
  14.    else _and:='1';
  15.  end; // function _and

Так верно, ... почти

1. "почти" верно, поскольку Вы, Никита, всё же не аккуратны в чтении спецификаций. Раз я уже заявил заголовки в постановке задачи, то они и должны бы у Вас повториться совершенно точно. Это естественное требование работы над любым проектом в команде. Представьте себе, что параллельно работая, люди в своих реализациях используют LogCalc0, а потом при сборке всего кода оказывается, что такого модуля нет (т.к. Вы самовольно переименовали его в LogCalc или ещё во что-то, что понравилось Вам больше).
Это замечание касается и Вашего типа lb (пусть даже и "логичного"), который в спецификациях исходного задания не представлен, а значит и не может появляться в заголовках.

2. "Заумное" (к тому же, соответствующее _and, а не _or):

  1. function _or(x,y:char):lb;
  2.   var t:0..1;
  3. begin
  4.   if (x='1')and (y='1' )then  _or:='1'
  5.   else begin
  6.       t:=(ord(x)-ord('0'))+(ord(y)-ord('0')); // t=0 или t=1
  7.       _or:=chr(ord('0')+t);  ;  // перевод  из цифры в символ (например, 1-> '1' )
  8.   end; // else
  9. end; //functoin _or

явно проигрывает тривиальному (код Виктории):
  1. Function _or(x,y: Char): Char;
  2. begin
  3.      if ((x='1') or (y='1')) then  _or:='1'
  4.      else  _or:='0'
  5. end;

То же и об остальных элементарных функциях.

3. Функция LogCalc (не считая неточности в её названии - должно бы быть LogCalc0) собрана и использована корректно.

Пока я печатал, Вика и сама

Пока я печатал, Вика и сама поправила Никиту :-)

Доброй ночи.

Приветствую всех. Попытался решить первую задачу. Ниже Мои наработки. Что скажете?

  1. program DM.z1;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils;
  7.  
  8. //Дизъюнкция. Выдаёт 1, если хотя бы одина из переменных равна 1. (a|b)
  9. function _or(x,y: char): char;
  10. begin
  11.   if ((x='1') or (y='1')) then _or:='1' //Если Х или У равны 1, то вывод 1...
  12.   else _or:='0'; //Иначе - вывод 0.
  13. end;
  14.  
  15. //Конъюнкция. Выдаёт 0, если хотя бы одна из переменных равна 0. (a&b)
  16. function _and(x,y: char): char;
  17. begin
  18.   if ((x='0') or (y='0')) then _and:='0' //Если Х или У равны 0, то вывод 0...
  19.   else _and:='1'; //Иначе - вывод 1.
  20. end;
  21.  
  22. //Отрицание. Выдаёт противополноже значение заданной переменной. (-a)
  23. function _not(x: char): char;
  24. begin
  25.   if x='0' then _not:='1' //Если Х=0, то выдаём противоположное, т.е. 1...
  26.   else _not:='0'; //Иначе, т.е. если Х=1, то выдаём противоположное, т.е. 0.
  27. end;
  28.  
  29. //Основная программа для вычисления.
  30. function Main(s: string): char;
  31. begin
  32.   if s[1]='-' then Main:=_not(s[2]); //Писать довольно много, но думаю суть и так ясна.
  33.   if s[2]='|' then Main:=_or(s[1],s[2]);
  34.   if s[2]='&' then Main:=_and(s[1],s[2]);
  35. end;
  36.  
  37. var a: string;
  38. Begin
  39.   Readln(a);
  40.   Writeln(Main(a));
  41.   Readln;
  42. End.

Кстати, у вас ошибка в главном сообщении допущена. Цитирую: "Function _or(x,y: Char): Char; //дизъюнкция (например, Writeln( _or(‘0’,’1’) ) выводит 0.", - а должна выдавать 1. Также тут: "Function _and(x,y: Char): Char; //конъюнкция (например, Writeln( _and(‘0’,’1’) ) выводит 1.", - а должна выдавать 0.
P.S. Ну и с праздником, конечно же :))

Спасибо, Асхад.

И за поздравление и что заметили неточность (исправил). Кстати, отменил/подправил и некоторые свои замечания относительно кодов Вики/Никиты.
У Вас тоже неточности в строках 33,34.
Остальное верно, кроме названия главной процедуры (см. мои комменты Никите).

Исправил.

  1. function  LogCalc0(s: string): char;
  2. begin
  3.   if s[1]='-' then Main:=_not(s[2]);
  4.   if s[2]='|' then Main:=_or(s[1],s[3]);
  5.   if s[2]='&' then Main:=_and(s[1],s[3]);
  6. end;

LogCalc1_v1

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

  1. program LogCalc1_v1;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils;
  7. //Дизъюнкция. Выдаёт 1, если хотя бы одина из переменных равна 1. (a|b)
  8. function _or(x,y: char): char;
  9. begin
  10.   if ((x='1') or (y='1')) then _or:='1' //Если Х или У равны 1, то вывод 1...
  11.   else _or:='0'; //Иначе - вывод 0.
  12. end;
  13.  
  14. //Конъюнкция. Выдаёт 0, если хотя бы одна из переменных равна 0. (a%b)
  15. function _and(x,y: char): char;
  16. begin
  17.   if ((x='0') or (y='0')) then _and:='0' //Если Х или У равны 0, то вывод 0...
  18.   else _and:='1'; //Иначе - вывод 1.
  19. end;
  20.  
  21. //Отрицание. Выдаёт противополноже значение заданной переменной. (-a)
  22. function _not(x: char): char;
  23. begin
  24.   if x='0' then _not:='1' //Если Х=0, то выдаём противоположное, т.е. 1...
  25.   else _not:='0'; //Иначе, т.е. если Х=1, то выдаём противоположное, т.е. 0.
  26. end;
  27.  
  28. //Основная программа для вычисления.
  29. //Также в описании будет трассировка.
  30. function LogCalc1(s: string): char;
  31.   var i : integer;
  32. begin
  33.   for i:=1 to length(s) do begin //Запускаем цикл с целью проверки символов. -0|-0&0.
  34.     if s[i]='-' then begin //Если найдет символ "-", то...
  35.       s[i+1]:=_not(s[i+1]); //Следующему за ним символу присваиваем значение _not. -1|-1&0.
  36.       Delete(s,i,1); //Обновляем строку. Удаляем символы "-".  1|1&0.
  37.     end; //if '-'
  38.     if s[i]='&' then begin //Если найден символ "&", то...   1|1&0.
  39.       s[i-1]:=_and(s[i-1],s[i+1]); //Предшествующему символу присваиваем значение _and. 1|0&0.
  40.       Delete(s,i,2); //Обновим строку. Удалив 2 оставшихся после _and символа. 1|0.
  41.     end; //if '&'
  42.     if s[i]='|' then begin //Если найден символ "|", то... 1|0.
  43.       s[i-1]:=_or(s[i-1],s[i+1]); //Предшествующему символу присваиваем значение _or. 1|0. (см. описание функции _or).
  44.       LogCalc1:=s[i-1]; //Результат будет хранится в первом элементе строки. 1.
  45.     end;//if '|'
  46.   end;
  47. end;
  48.  
  49. var a: string;
  50. Begin
  51.   Readln(a);
  52.   Writeln(LogCalc1(a));
  53.   Readln;
  54. End.

Асхад, конъюнкция не

Асхад, конъюнкция не работает, если взять формулу небольшую, например, где только две константы

Никита Ширшов аватар

И не только коньюнкция...

Отрицание тоже не вычисляется ...

Я бы решил так:

  1. program Logical;
  2.  var s1:string;
  3.  
  4.  function _or(x,y: char): char; // дизьюнкция
  5.  begin
  6.   if ((x='1') or (y='1')) then _or:='1'
  7.   else _or:='0';
  8.  end; // дизьюнкция
  9.  
  10.  function _and(x,y: char): char; // коньюнкция
  11.  begin
  12.   if ((x='0') or (y='0')) then _and:='0'
  13.   else _and:='1';
  14.  end; // коньюнкция
  15.  
  16.  function _not(x: char): char; // отрицание
  17.  begin
  18.   if x='0' then _not:='1'
  19.   else _not:='0';
  20.  end; // отрицание
  21.  
  22.  function LogCalc1(s: string): char;
  23.   var i :1..255;
  24.  begin  // выполняем операции в порядке их 'силы'
  25.   for i:=1 to length(s) do begin // идем по всей строке и выполняем отрицание
  26.     if s[i]='-' then begin
  27.       s[i+1]:=_not(s[i+1]);        // -0|-0&0’ -> '1|1&0'
  28.       Delete(s,i,1);
  29.       LogCalc1:=s[i+1];
  30.     end;
  31.   end;
  32.  
  33.  // цикл начинается с 2 , т. к. коньюнкция бинарная операция и выражения вида: '&0'  не может быть, поэтому идём со втрого символа
  34.   for i:=2 to length(s) do begin // идем по всей строке и выполняем коньюнкцию
  35.    if s[i]='&' then begin
  36.     s[i-1]:=_and(s[i-1],s[i+1]);  // '1|1&0' -> '1|0'
  37.     Delete(s,i,2);
  38.     LogCalc1:=s[i-1];
  39.    end;
  40.   end;
  41.  
  42.   for i:=2 to length(s) do begin  // идем по всей строке и выполняем дизьюнкцию
  43.     if s[i]='|' then begin      
  44.       s[i-1]:=_or(s[i-1],s[i+1]);   // '1|0' -> '1'
  45.       delete(s,i,2);
  46.       LogCalc1:=s[i-1];
  47.     end;
  48.   end;
  49.  end; // function LogCalc1
  50.  
  51. Begin
  52.   Readln(s1);  //   например,  s1:= '-0|-0&0’
  53.   Writeln('Результат = ',LogCalc1(s1));
  54. End.

Асхад, Никита

Вычеркнуть операцию с операндами, оставив в строке константу-результат правильная идея, но ...

Асхад, пытаясь всё сделать за один проход не учитывает приоритетов. Отсюда, в частности, ошибка обработки конъюнкции в формуле, например, '1&-0' (знак, следующий за & константой не является!).

Никита, кажется, избавляется от этой ошибки, просматривая и обрабатывая строку в порядке убывания приоритетов. Но тут (как, впрочем, и у Асхада) не учитывается важная особенность цикла FOR - он повторяется столько раз, какова длина ИХОДНОЙ СТРОКИ! А ведь Вы, вычёркивая знаки из строки, в процессе обработки её текущую длину уменьшаете. Следователно, индекс неизбежно выйдет за границу текущей длины.

Мне интересно, вы пытаетесь проверять свои решения на тестах?

Никита Ширшов аватар

Да, я проверяю свои

Да, я проверяю свои решения,
а если так

  1. ...
  2. function LogCalc1(s: string): char;
  3.   var i,o,k,d:0..255;
  4. begin
  5.  o:=0; // инициализация
  6.  d:=0;
  7.  k:=0;
  8.  for i:=1 to length(s) do begin // идем по строке и запоминаем количество операций:
  9.   if s[i]='-' then inc(o); // отрицания
  10.   if s[i]='|' then inc(d); // дизьюнкции
  11.   if s[i]='&' then inc(k); // коньюнкции
  12.  end;
  13.  
  14.   for i:=1 to length(s)-o do begin  // т.к. удаляем один символ, то вычитаем из длины строки  количество операций отрицания
  15.     if s[i]='-' then begin
  16.       s[i+1]:=_not(s[i+1]);
  17.       Delete(s,i,1);
  18.       LogCalc1:=s[i+1];
  19.     end;
  20.    end;
  21.   for i:=2 to length(s)-2*k do begin // т.к. удаляем два символа, то вычитаем из длины строки 2*( количество операций  коньюнкции)
  22.    if s[i]='&' then begin
  23.     s[i-1]:=_and(s[i-1],s[i+1]);
  24.     Delete(s,i,2);
  25.     LogCalc1:=s[i-1];
  26.    end;
  27.   end;
  28.   for i:=2 to length(s)-2*d do begin // анологично как и для коньюнкции
  29.     if s[i]='|' then begin
  30.       s[i-1]:=_or(s[i-1],s[i+1]);
  31.       delete(s,i,2);
  32.       LogCalc1:=s[i-1];
  33.     end;
  34.   end;
  35. end;
  36. ...

думаю что в таком варианте не будет выхода индекса за границы

Ответ.

Так и не понял в чём ошибка. Сначала цикл выполняет следующую задачу: он заменяет все стоящие за "-" символы на противоположные, затем удаляет из строки символ "-". Тем самым мы обновляем строку. Потом мы работает с символом "&", но строка-то новая, в которой уже нет "-", иначе говоря, при работе с "&" в строке отсутствуют такие символы как "-". Цитата: "'1&-0' (знак, следующий за & константой не является!)." Такая ситуация просто невозможна, потому что сначала мы изменим символ, стоящий за "-" на противоположный (теперь строка будет иметь такой вид: 1&-1), а затем удалим символ "-" (теперь строка такая: 1&1). И только сейчас мы начинаем работать со знаком "&". И как мы видим, следующий за ним знак стал константой. Индекс не выходит за границы массива. Работаю на Borland Developer Studio 2006 и там всё отлично компилируется. Я же написал, что код работает.

Никита, идея ясна, но как-то неуклюже

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

А нужно ли так уж цепляться за FOR? Ведь ЛОГИЧЕСКИ куда естественней сказать "пока в строке есть знак операции такой-то ...". И ведь язык с радостью поддержит эту фразу!

  1. i:=Pos('-',s);
  2. While i<>0 do Begin //пока в строке есть знак '-' (его позиция i)
  3.    Delete(s,i,1); //удалим его
  4.    s[i]:=_not(s[i]); // а следующее за ним значение заменим на инверсное
  5.    i:=Pos('-',s); //уже в обновлённой строке поищем такой же знак
  6. End

Из этой ситуации напрашивается 2 вывода:

  1. Следует искать простейшие решения. Если используемый подход требует всё новых и новых "заплаток" для возможности его применения, скорее всего, лучше отказаться от него совсем;
  2. Очень важно знать и использовать все языковые возможности, в частности, стандартные подпрограммы, которые помимо их удобства, зачастую специально оптимизированы под конкретную архитектуру компьютера. Я заметил, что студенты весьма неохотно используют стринговые операции, предпочитая смотреть на стринг как на массив (отсюда приверженность к FOR).

Исправил.

Ошибка была в 15-ой и 18-ой строках.

  1. function LogCalc1(s: string): char;
  2.   var i : integer;
  3. begin
  4.   for i:=1 to length(s) do begin //Запускаем цикл с целью проверки символов. -0|-0&0.
  5.     if s[i]='-' then begin //Если найдет символ "-", то...
  6.       s[i+1]:=_not(s[i+1]); //Следующему за ним символу присваиваем значение _not. -1|-1&0.
  7.       Delete(s,i,1); //Обновляем строку. Удаляем символы "-".  1|1&0.
  8.     end; //if '-'
  9.     if s[i]='&' then begin //Если найден символ "&", то...   1|1&0.
  10.       s[i-1]:=_and(s[i-1],s[i+1]); //Предшествующему символу присваиваем значение _and. 1|0&0.
  11.       Delete(s,i,2); //Обновим строку. Удалив 2 оставшихся после _and символа. 1|0.
  12.     end; //if '&'
  13.     if s[i]='|' then begin //Если найден символ "|", то... 1|0.
  14.       s[i-1]:=_or(s[i-1],s[i+1]); //Предшествующему символу присваиваем значение _or. 1|0. (см. описание функции _or).
  15.       s[1]:=s[i-1]; //Результат будет хранится в первом элементе строки. 1.
  16.     end;//if '|'
  17.   end;
  18.   LogCalc1:=s[1];
  19. end;

Теперь простейшие формулы работают.

Запутался.

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

  1. function LogCalc2(s: string): char;
  2.   var i,k,n,l,m: integer;
  3. begin
  4.   for i:=1 to length(s) do begin //Запускаем цикл с целью проверки символов.
  5.     if s[i]='-' then begin //Если найдет символ "-", то...
  6.       s[i+1]:=_not(s[i+1]); //Следующему за ним символу присваиваем значение _not.
  7.       Delete(s,i,1); //Обновляем строку. Удаляем символы "-".
  8.     end; //if '-'
  9.   end; //for
  10.  
  11.   k:=0; //Обнуляем счётчик.
  12.   for i:=length(s) downto 1 do begin //Цикл, созданный для нахождения индекса последней открытой скобки.
  13.     k:=k+1; //Суммируем счётчик.
  14.     n:=length(s)-k+1; //Формула вычисления последнего открытой скобки. В переменной n хранится индекс последней открытой скобки.
  15.     if s[i]='(' then break //Если найден первый символ с конца, то выходим из цикла.
  16.   end; //for
  17.  
  18.   Delete(s,1,n); //Разделили строку на "после" последней открытой скобки, для нахождения первой закрытой.
  19.   l:=0; //Обнуляем счётчик.
  20.   for i:=1 to length(s) do begin
  21.     l:=l+1; //Суммируем счётчик.
  22.     if s[i]=')' then break //Если найден первый символ, то выходим из цикла.
  23.   end; //for
  24.  
  25.   m:=n+l; //В переменной m хранится индекс первой закрытой скобки.
  26.   for i:=n to m do begin//Рассматриваем элементы, расположенные внутри последних скобок.
  27.     if s[i]='|' then begin //Если в между скобками имеется знак "|', то...
  28.       s[i-2]:=_or(s[i-1],s[i+1]); //Элементу "(" присваиваем _or.
  29.       Delete(s,i-1,4); //Обновляем строку, удаляя всё лишнее.
  30.     end; //if '|'
  31.     if s[i]='&' then begin
  32.       s[i-2]:=_and(s[i-1],s[i+1]);
  33.       Delete(s,i-1,4);
  34.     end; //if '&'
  35.   end; //for
  36.   LogCalc2:=s;
  37. end;

P.S. Поздно Я увидел Ваше сообщение про цикл while. Попытаюсь позже переписать свой код с for на while.

Думаю, Асхад, Вам рано

Думаю, Асхад, Вам рано браться за задачу 3.
Разберитесь сначала с задачей 2 (которая "отлично компилируется"), а заодно и с самим собой. Я мог бы привести тривиальные контрпримеры и к "поправленной" Вами версии, но не буду. Мои замечания, зависающие в воздухе - пустая трата времени, так что, если есть охота, разбирайтесь теперь уж сами.

У меня в итоге код ко второй

У меня в итоге код ко второй задаче получился вот такой:

  1. program Logika;
  2.  
  3. var s:string;
  4.  
  5.     x,y,c:char;
  6.     i:byte;
  7.   function _and(x,y:Char):Char;
  8.   begin
  9.    if ((x='0')or(y='0')) then _and:='0'
  10.      else _and:='1';
  11.   end;
  12.   Function _or(x,y: Char): Char;
  13.   begin
  14.   if ((x='1')or(y='1')) then _or:='1'
  15.     else _or:='0'
  16.   end;
  17.   function _not(x:char):Char;
  18.   begin
  19.   if (x='1') then _not:='0'
  20.     else _not:='1';
  21.   end;
  22.   function LogCalc1(S:String):Char;
  23.      var i:byte;
  24.   begin
  25.   i:=Pos('-',s);
  26.   While i<>0 do Begin //позиция знака "-"
  27.      Delete(s,i,1); //удалили этот знак
  28.      s[i]:=_not(s[i]); // следующее за ним значение заменили на инверсное
  29.      i:=Pos('-',s);//в новой строке поищем такой же знак
  30.      LogCalc1:=s[i+1]
  31.   End;
  32.   i:=Pos('&',s);
  33.   while i<>0 do begin
  34.      delete(s,i-1,2);
  35.      s[i-1]:=_and(s[i-1],s[i+1]);
  36.      i:=Pos('&',s);
  37.   end;
  38.    i:=Pos('|',s);
  39.   while i<>0 do begin
  40.      delete(s,i-1,2);
  41.      s[i-1]:=_or(s[i-1],s[i+1]);
  42.      i:=Pos('|',s);
  43.   end;
  44. end;
  45.  
  46. begin
  47.   writeln('Введите формулу:');
  48.   readln(s);
  49.   writeln('Результат = ', LogCalc1(s));
  50. end.<pre>

Нет, Вика. Строки 34, 40.

Нет, Вика. Строки 30, 34, 40...

в строке 34 и

в строке 34 и 40

  1. delete(s,i,2);

Никита Ширшов аватар

Вика

смотри в чём твоя ошибка:
Рассмотрим вот эту часть кода:

  1. ...
  2.   i:=Pos('-',s);
  3.   While i<>0 do Begin //позиция знака '-'
  4.      Delete(s,i,1); //удалили этот знак
  5.      s[i]:=_not(s[i]); // следующее за ним значение заменили на инверсное
  6.      i:=Pos('-',s);//в новой строке поищем такой же знак
  7.      LogCalc1:=s[i+1]
  8.   End;
  9. ...

строка: ...- 0...
индекс: ...i, i+1,...

Если удалить из строки подстроку с позиции i, длины 1 то в позицию i станет элемент '0'
и далее можно записать следующее:

  1.  ...
  2.   i:=Pos('-',s); //позиция знака '-'
  3.   While i<>0 do Begin
  4.      Delete(s,i,1);//удалили этот знак
  5.      s[i]:=_not(s[i]);// следующее за ним значение заменили на инверсное
  6.      LogCalc1:=s[i];// для случая когда пользователь,например, введет выражение вида: '-0'
  7.      i:=Pos('-',s);//в новой строке поищем такой же знак
  8.   End;
  9. ...

Аналогично для коньюнкции:
в твоем варианте:

  1. ...
  2.   i:=Pos('&',s);
  3.   while i<>0 do begin
  4.      delete(s,i-1,2);
  5.      s[i-1]:=_and(s[i-1],s[i+1]);
  6.      i:=Pos('&',s);
  7.   end;
  8. ...

строка:...0&0...
индекс: .i-1, i, i+1...

Сначала нам нужно выполнить коньюнкцию,при этом результат записав в позицию i-1, а потом удалить 2 символа с i-й позиции:

  1. ...
  2.   i:=Pos('&',s);//позиция знака '&'
  3.   while i<>0 do begin
  4.      s[i-1]:=_and(s[i-1],s[i+1]); // выполняем коньюнкцию
  5.      delete(s,i,2); // удаляем 2 элемента с i -й позиции
  6.      LogCalc1:=s[i-1]; // для случая когда пользователь,например, введет выражение вида: '0&0'
  7.      i:=Pos('&',s);//в новой строке поищем такой же знак
  8.   end;
  9. ...

для дизьюнкции аналогично как для коньюнкции

Да, Никита, возможно ты был

Да, Никита, возможно ты был прав...
получается, что так:

  1. program Logika;
  2.  
  3. var s:string;
  4.  
  5.     x,y,c:char;
  6.     i:byte;
  7.   function _and(x,y:Char):Char;
  8.   begin
  9.    if ((x='0')or(y='0')) then _and:='0'
  10.      else _and:='1';
  11.   end;
  12.   Function _or(x,y: Char): Char;
  13.   begin
  14.   if ((x='1')or(y='1')) then _or:='1'
  15.     else _or:='0'
  16.   end;
  17.   function _not(x:char):Char;
  18.   begin
  19.   if (x='1') then _not:='0'
  20.     else _not:='1';
  21.   end;
  22.   function LogCalc1(S:String):Char;
  23.      var i:byte;
  24.   begin
  25.    i:=Pos('-',s);
  26.  
  27.   While i<>0 do Begin
  28.      Delete(s,i,1);
  29.      s[i]:=_not(s[i]);
  30.      LogCalc1:=s[i];
  31.      i:=Pos('-',s);
  32.   End;
  33.   i:=Pos('&',s);
  34.   while i<>0 do begin
  35.      s[i-1]:=_and(s[i-1],s[i+1]);
  36.      delete(s,i,2);
  37.      LogCalc1:=s[i-1];
  38.      i:=Pos('&',s);
  39.   end;
  40.    i:=Pos('|',s);
  41.   while i<>0 do begin
  42.      s[i-1]:=_or(s[i-1],s[i+1]);
  43.      delete(s,i,2);
  44.      LogCalc1:=s[i-1];
  45.      i:=Pos('|',s);
  46.   end;
  47. end;
  48. begin
  49.   writeln('Введите формулу:');
  50.   readln(s);
  51.   writeln('Результат = ', LogCalc1(s));
  52. end.

Никита,Вика

Всё это правильные рассуждения, но мне не понятна эта суета вокруг присваивания значений LogCalc1.
Лучше их убрать отовсюду и лишь в самом конце (когда строка в результате всех вычёркиваний сократится до одного символа) записать: LogCalc1:=s[1].
Разве не так?

Никита Ширшов аватар

Да

можно и так

Панова Ксения аватар

Здравствуйте. Для раскрытия

Здравствуйте. Для раскрытия скобок тоже ведь нужна отдельная функция?

Вопрос вкуса и выбранного

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

Вторая задача.

  1. function LogCalc1(s: string): char;
  2.   var i : integer;
  3. begin
  4.   i:=Pos('-',s);
  5.   while i<>0 do begin
  6.     Delete(s,i,1);
  7.     s[i]:=_not(s[i]);
  8.     i:=Pos('-',s);
  9.   end; //while '-'
  10.  
  11.   i:=Pos('&',s);
  12.   while i<>0 do begin
  13.     s[i-1]:=_and(s[i-1],s[i+1]);
  14.     Delete(s,i,2);
  15.     i:=Pos('&',s);
  16.   end; //while '&'
  17.  
  18.   i:=Pos('|',s);
  19.   while i<>0 do begin
  20.     s[i-1]:=_or(s[i-1],s[i+1]);
  21.     Delete(s,i,2);
  22.     i:=Pos('&',s);
  23.   end; //while '|'
  24.   LogCalc1:=s[1];
  25. end;

Никита Ширшов аватар

Задача 3

  1.  program Logical;    
  2.   var s:string;  
  3.   function _and(x,y:Char):Char;
  4.   begin
  5.    if ((x='0')or(y='0')) then _and:='0'
  6.    else _and:='1';
  7.   end;
  8.   Function _or(x,y: Char): Char;
  9.   begin
  10.    if ((x='1')or(y='1')) then _or:='1'
  11.    else _or:='0'
  12.   end;
  13.   function _not(x:char):Char
  14.   begin
  15.     if (x='1') then _not:='0'
  16.     else _not:='1';
  17.   end;
  18.   function LogCalc1(S:String):Char;
  19.    var i:byte;
  20.   begin
  21.    i:=Pos('-',s);    
  22.    While i<>0 do Begin
  23.      Delete(s,i,1);
  24.      s[i]:=_not(s[i]);
  25.      LogCalc1:=s[i];
  26.      i:=Pos('-',s);
  27.    End;
  28.    i:=Pos('&',s);
  29.    while i<>0 do begin
  30.     s[i-1]:=_and(s[i-1],s[i+1]);
  31.     delete(s,i,2);
  32.     LogCalc1:=s[i-1];
  33.     i:=Pos('&',s);
  34.    end;
  35.    i:=Pos('|',s);
  36.    while i<>0 do begin
  37.     s[i-1]:=_or(s[i-1],s[i+1]);
  38.     delete(s,i,2);
  39.     LogCalc1:=s[i-1];
  40.     i:=Pos('|',s);
  41.    end;
  42.    logcalc1:=s[1]
  43.   end;
  44.   function LogCalc2(s1:string):char;
  45.    var v,j,m:byte;
  46.           t:string;
  47.   begin
  48.    t:='';
  49.    v:=pos(')',s1); //позиция ')'
  50.    m:=v;
  51.    while v<>0 do begin
  52.     while s1[v]<>'(' do begin // пока s[v]<>'(' уменьшаем v
  53.      dec(v);
  54.     end;
  55.     t:=copy(s1,v+1,m-v-1); //скопировали подстроку
  56.     s1[m]:=logcalc1(t); // отправили в функцию Logcalc1
  57.     delete(s1,v,length(t)+1); //удалили подстроку
  58.     v:=pos(')',s1); //ищем позицию
  59.     m:=v;
  60.    end;
  61.    LogCalc2:=logcalc1(s1);
  62.  end;
  63.  begin
  64.   writeln('Введите формулу:')
  65.   readln(s);
  66.   writeln('Результат = ', LogCalc2(s));
  67. end.

задача 3, функция

задача 3, функция LogCalc2

  1. function LogCalc2(S:String):Char;
  2.       var r,l:byte;
  3.           s1:string;
  4.     begin
  5.       r:=Pos(')',s);
  6.       while r<>0 do begin
  7.         l:=r;
  8.         while s[l]<>'(' do Dec(l);
  9.           s1:=Copy(s,l+1,r-l-1);
  10.           Delete(s,l,r-l);
  11.           s[l]:=LogCalc1(s1);
  12.         r:=Pos(')',s)
  13.       end;
  14.       writeln(LogCalc1(s1))
  15.     end;

LogCalc2

  1.  program LogCalc2;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils;
  7.   function fun(s :string) : char;
  8.   var
  9.     i:integer;
  10.   begin
  11.     i:=pos('~',s);
  12.     while i<>0 do begin
  13.       delete(s,i,1);
  14.       if(s[i]='0') then s[i]:='1'
  15.       else s[i]:='0';
  16.       i:=pos('~',s);
  17.     end;
  18.     i:=pos('&',s);
  19.     while i<>0 do begin
  20.       if(s[i+1]='0') then s[i-1]:='0';
  21.       delete(s,i,2);
  22.       i:=pos('&',s);
  23.     end;
  24.     fun:='0';
  25.     if pos('1',s)<>0 then
  26.       fun:='1';
  27.   end;
  28. var
  29.   s:string;
  30.   r,l,i,j:integer;
  31.   c: char;
  32. begin
  33.   readln (s);
  34.   for I := 1 to length(s) do begin
  35.     if (s[i] in ['a'..'b']) then begin
  36.       write('vvedite ',s[i],'=');
  37.       readln(c);
  38.       for j := i+1 to length(s) do begin
  39.         if(s[j]=s[i]) then s[j]:=c;
  40.       end;
  41.       s[i]:=c
  42.     end;
  43.   end;
  44.   r:=pos(')',s);
  45.   while  (r<>0) do begin
  46.     l:=r;
  47.     while s[l]<>'(' do
  48.       dec(l);
  49.     s[r]:=fun (copy(s,l+1,r-l-1));
  50.     delete (s,l,r-l);
  51.     r:=pos(')',s);
  52.   end;
  53.   write(fun(s))
  54. end.

Никита Ширшов аватар

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

Условие задачи: Будем теперь считать, что заданное логическое выражение (формула булевой функции) содержит в качестве операндов не только константы (0,1), но также, возможно, переменные, обозначенные латинскими малыми буквами. Одна и та же буква может входить в формулу многократно.
Например, логической формулой теперь является стринг: 'a&1&((-b|a)&z)'

  1. program Logical;
  2.  var s:string;
  3.     j:byte;
  4.   a,b:char;
  5.  function _or;
  6.   ...
  7.  end;
  8.  
  9.  function _and;
  10.  ...
  11.  end;
  12.  
  13.  function _not;
  14.  ...
  15.  end;
  16.  function  LogCalc1;
  17.  ...
  18.  end;
  19.  
  20.  function  LogCalc2;
  21.  ...
  22.  end;
  23.  procedure zam(var q:string;h:byte;d,t:char);
  24.    var i:byte;
  25.   begin
  26.    for i:=h  to length(q) do begin
  27.     if q[i] = d then   begin
  28.       q[i]:=t;
  29.     end;
  30.    end;  // h позиция с которой начинается поиск и ,возможно, замена
  31.   end;
  32.  
  33. begin
  34.  writeln('Введите ФБФ:');
  35.  readln(st);
  36.  for j:=1 to length(st) do begin  
  37.    // если  st[j]  не знак операции и не константа и не скобки, то вводим значение st[j] ,{здесь действует правило укороченной коньюнкции}
  38.    if (st[j]<>'-')and (st[j]<>'&') and (st[j]<>'|')and (st[j]<>'0')and(st[j]<>'1')and (st[j]<>'(')and (st[j]<>')') then begin
  39.      writeln('Введите значение переменной: ', st[j]);
  40.      readln(a);
  41.      b:=st[j]; //b- в процедуре zam проверяется на равенство очередному элементу
  42.      zam(st,j,b,a); // j-позиция, с которой начинаем поиск и замену,  a - значение,на которое  заменятся элемент
  43.    end;
  44.  end;
  45.  Writeln('Результат = ', LogCalc2(st));
  46. end.

Сурен, Никита

Не буду обсуждать решения Асхада и Виктории (которые, кстати, не без ошибок) - они уже не новы, и основаны на не раз озвученных мною ( и на сайте, и на лабораторках) идеях.

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

Сразу отмечу - самобытность эта в целом не во благо качеству решения.

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

2. Программы плохо структурированы (нет логичного разделения на функционально значимые подпрограммы), не документированы, а потому трудно постижимы и не допускают лёгкости перестройки в случае изменения условий или контекста их эксплуатации. Идеально, когда весь код модуля (подпрограммы или программы), максимум 15-20 строк.

3. Не удачно подобраны имена объектов, много лишних безликих переменных, дублируется код, имеются явно неуклюжие решения (Вашу длинющую строку 38, Никита, можно бы записать как: if st[j] in ['a'..'z','A'..'Z'] then...) и т.д.

Но всё же главный недостаток (простите, что я остановился именно на недостатках Ваших решений, достоинства тоже несомненно есть) - это вываленный длинющий недокументированный код, который вряд ли (включая и меня) кто-то захочет изучать.
Хотите предметного обсуждения - показывайте только один, самодокументированный и решающий ПОСТАВЛЕННУЮ задачу модуль длиной не более 15-20 строк. Всё что вне этих пределов - отнесите в другие модули, которые давайте обсудим отдельно.
И всё же, спасибо за активность. Вы пока на курсе лучшие. Удачи!

Никита Ширшов аватар

Задача 4

Описать и протестировать процедуру procedure vars(fbf:String; var vlst: String), которая по заданной формуле булевской функции fbf формирует упорядоченный список входящих в неё переменных vlst.

  1.  procedure swap(var a,b:char); //процедура для обмена значений
  2.   var x:char;
  3.  begin
  4.   x:=a;
  5.   a:=b;
  6.   b:=x;
  7.  end; // procedure swap
  8.  
  9.   //фактический параметр, соответствующий формальному параметру vlst, должен быть инициализирован как пустой стринг;
  10.  procedure vars(fbf:String; var vlst:String);
  11.   var i,j:byte;
  12.  begin
  13.   for i:=1 to length(fbf) do begin // идем по строке, просматриваем ФБФ;
  14.   // если fbf[i] элемент оказался переменной, то записываем его в строку vlst {формируем список}
  15.    if fbf[i] in ['a'..'z'] then  vlst:=vlst+fbf[i];
  16.   end; // for
  17.   for i := 1 to length(vlst)-1 do  begin // сортировка {формирование упорядоченного списка переменных} {метод пузырька}
  18.    for j:=1 to length(vlst)-i  do begin
  19.     if vlst[j] > vlst[j+1] then begin // если vlst[j]>vlst[j+1] , то
  20.      swap(vlst[j],vlst[j+1]); // выполняем обмен значений
  21.     end; // if
  22.    end; // внутренний for
  23.   end; // внешний for
  24.  end; // procedure vars

Можно так, Никита.

Но две ошибки:
1. Элементы в создаваемом Вами списке могут дублироваться;
2. Вы не инициализируете программные переменные, как и многие, наивно полагаясь на реализацию ТП.

Никита Ширшов аватар

Исправил

  1.   //фактический параметр, соответствующий формальному параметру vlst, должен быть инициализирован как пустой стринг;
  2.  procedure vars(fbf:String; var vlst:String);
  3.   var i,j:byte;
  4.        temp:string;
  5.  begin
  6.  temp:='';
  7.   i:=1;
  8.   for i:=1 to length(fbf) do begin // идем по строке, просматриваем ФБФ;
  9.   // если fbf[i] элемент оказался переменной, то записываем его в строку vlst {формируем список}
  10.    if fbf[i] in ['a'..'z'] then  vlst:=vlst+fbf[i];
  11.   end; // for
  12.   i:=1;
  13.   j:=1;
  14.   for i := 1 to length(vlst)-1 do  begin // сортировка {формирование упорядоченного списка переменных} {метод пузырька}
  15.    for j:=1 to length(vlst)-i  do begin
  16.     if vlst[j] > vlst[j+1] then begin // если vlst[j]>vlst[j+1] , то
  17.      swap(vlst[j],vlst[j+1]); // выполняем обмен значений
  18.     end; // if
  19.    end; // внутренний for
  20.   end; // внешний for
  21.   i:=1;
  22.  
  23.   for i:=1 to length(vlst) do begin // проверка на дублирование элементов
  24.   //если позиция очередного элемента в строке temp равна 0, то записываем этот элемент в эту строку
  25.    if pos(vlst[i],temp)=0  then temp:=temp+vlst[i];
  26.   end;
  27.   vlst:=temp;
  28.  
  29.  end; // procedure vars