Задача 11 Урок 18

Задача 11 Урок 18 Задана последовательность символов, имеющая следующий вид: p1q1p2q2p3...qn–, где pi — число, а qi — знак арифметического действия из набора {+, –, *}. Вычислите значение выражения, предполагая, что действия выполняются согласно правилам арифметики.
 Входные данные: На вход программе подается строка указанного вида, состоящая не более чем из 9 чисел, разделенных символами арифметических операций.
 Выходные данные: Выведите значение арифметического выражения.

type  myarr = array[1..3000] of string;  // организуем массив

var s : string;  // вводимая сттрока
  i,j,l,q : integer; //счётчики
  intChislo, Code : Integer; // подпрог для преобразования строки  в  число
  a : myarr;  // массив
  multi,u : integer; // для хранения результата
  n : string; //
  arifm : string;
  one,two,w : integer;
  x,y:integer;
  recor,otvet:integer;



procedure searchmulti(var a1 : myarr; var multi : integer;  var q : integer  );
var    intChislo, Code : Integer;
       i,i2 : integer;
       x1s,y1s : string;
       x1,y1:integer;

begin
  x1:=0;
  y1:=0;
  x1s:='';
  y1s:='';
  for i:=q to high(a1) do  // цикл до первого *
    if a[i]='*' then // если *, то
      begin
        q:=i;  // записываем где встретился *
        break; // выходим из цикла
      end;
    for i2:=q downto low(a1)   do  // цикл в обратном порядке (для числа слева от * )
      begin
        val (a1[i2],intChislo, Code);  // в подпрог val
        if code=0 then  // если число
          x1s:=a1[i2]+x1s;  // текущую цифру + предудыщую цифру(если есть)
        if not (x1s='') then  // если переменная не пуста,то
          if (i2=low(a1)) or (a1[i2]='-') or (a1[i2]='+') or (a1[i2]='*') then // если число первое или - или + или *,то
            begin
              val (x1s,intChislo, Code); // в подпрог val
              x1:=intChislo;  // запись в переменную
              break; // выход из цикла
            end;
      end;
    for i2:=q to high(a1) do // цикл (для числа справа от *)
      begin
        val (a1[i2],intChislo, Code); // в подпрог val
        if code=0 then  // если число
          y1s:=y1s+a1[i2];
         if not (y1s='') then  // если переменная не пуста,то
           if (i2=high(a1)) or (a1[i2]='-') or (a1[i2]='+') or (a1[i2]='*') then // если число последнее или - или + или *,то
             begin
              val (y1s,intChislo, Code); // в подпрог val
              y1:=intChislo; // запись в переменную
              break; // выход из цикла
          end;
      end;
   if (x1<>0) and (y1<>0) then // если переменные не пустые
     multi:=x1*y1;  // умножаем и записываем в переменные
end;

procedure deletmulti(var a1 : myarr; var multi : integer;  var q : integer  );
var    intChislo, Code : Integer;
       i,i2 : integer;
       x1s,y1s : string;
       x1,y1:integer;

begin

q-=1; // отнимаем 1 чтобы не случилось преждевременного прерывания
   for i:=q downto low(a1)   do  // цикл в обратном порядке (для числа слева от * )
     begin
      if (a1[i] = '+') or (a1[i] = '-') or (a1[i] = '*') then  // если + или - или * , то
        break // выход из цикла, если нет,то
      else a1[i]:='';  // записываем пустую строку
     end;

q+=2; // прибавляем 2 чтобы не случилось преждевременного прерывания
    for i:=q to high(a1) do // цикл(справа от *)
      if (a1[i] = '+') or (a1[i] = '-') or (a1[i] = '*')  then // если + или - или * , то
        break // выход из цикла, если нет,то
      else a1[i]:=''; // записываем пустую строку

    for i:=low(a1) to high(a1) do // цикл для поиска * чтобы записать результат умножения
      if a[i]='*' then // если * , то
        begin
          str(multi,s);  // преобразуем число в строку
          a[i]:=s; // записываем в текущий массив
          break;  // выходим из цкла
        end;
end;

procedure searchone(s : string; var n : string; var x1 : integer; var y1 : integer; var w : integer);
var    intChislo, Code : Integer;
       i,i2:integer;
       flag:boolean;
       x1s,y1s:string;
begin
  flag:=false;
  n:='';
  y1s:='';
  for i:=1 to length(s) do
    begin
      val(s[i], intChislo, Code);   // в подпрог для поиска мат операции и для чисел
      if not (y1s='') and ((s[i]='+') or (s[i]='-'))  then   // если не пусто и есть + или -, то
        begin
          w:=i; // присваивание нужно для след подпрог чтобы знать с чего стартовать
          break; // выходим из цикла ( после сложения или вычитания первых двух чисел)
        end;
      if (s[i]='+') or (s[i]='-') and (flag=false) then  // если +/- и флаг спущен, то
        begin
          n:=s[i];  // запись
          flag:= true; // флаг поднят
        end;
      if (code=0) and (flag=false) then // если код 0(цифра) и флаг спущен, то
        x1s:=x1s+s[i];  // запись в эту переменную
      if (code=0) and (flag=true) then  // если код 0(цифра) и флаг поднят, то
        y1s:=y1s+s[i];  // запись в эту переменную
    end;
    val (x1s, intChislo, Code); // в подпрг для преобразования
      x1:=intChislo; // запись преобр числа
    val (y1s, intChislo, Code); // в подпрг для преобразования
      y1:=intChislo; // запись преобр числа
end;

procedure calcularest(s : string;  var recor : integer; var w : integer);
var    intChislo, Code : Integer;
       x1s,y1s:string;
       n:string;
       x1,i:integer;
begin
  n:='';
  x1s:='';
  for i:=w to length(s) do
    begin
      if i=0 then break;   // если расчёт из двух чисел
      val(s[i], intChislo, Code);  // в подпрог для поиска мат операции и для чисел
      if  (n='') and ((s[i]='+') or (s[i]='-'))  then  // для первой мат операции
        n:=s[i];
      if (code=0) then  // если код 0(цифра)
          x1s:=x1s+s[i]; // запись в эту переменную
      if not (x1s='') and ((s[i]='+') or (s[i]='-')) or (i=length(s)) then  // если не пусто и +/- или цикл завершается
        begin
          val(x1s, intChislo, Code); // в подпрог для преобраз для чисел
          x1:=intChislo;  // запись  в переменную
          if n='+' then
            begin
              recor:=recor+x1;
              x1s:='';
            end;
          if n='-' then
            begin
              recor:=recor-x1;
              x1s:='';
            end;
          if ((s[i]='+') or (s[i]='-')) then  // для последующих поисков мат. операции
            n:=s[i];
        end;
    end;
end;


begin
   j:=0;
   l:=1;
    writeln('enter the line');
 // readln(s);
    s:='5*6+7-3*2*3+11';
   for i:=1 to length(s) do  // цикл для записи в массив a
     begin
       j+=1;
       a[j]:=s[i];
     end;
    for i:=low(a) to high(a) do  // цикл для поиска *
      if  a[i]='*' then  // если *, то
        begin
          searchmulti(a,u,l);// заходим в процедуру searchmulti. u: нежен  для результата *, l: нужен чтобы знать с какого знач удалять в след процедур
          multi:= u;  // запись по ссылке
          q:=l;  // запись по ссылке
          deletmulti(a, multi,q); //  в  deletmulti(для удаления множителей и перезапись результата). multi результат умножения.q:с чего стартовать
       end;
    s:='';
    for i:=low(a) to high(a) do // запись в строковую переменную
      s:=s+a[i];
    n:='';
    searchone(s, n,x,y,w);   // в подпрог для поиска +/- и чисел  и  последующ преобразований их из стрк в int
    arifm:=n;  // запись в переменную +/-
    one:=x; // запсиь первого числа
    two:=y; // запись второго числа
    i:=w; // запись для след процедуры чтобы знать с какой точки начать
    if arifm='+' then
      recor:=one+two;
    if arifm='-' then
      recor:=one-two; // запись в переменную первого вычисления
    calcularest(s,recor,i); // в подпрог для остального расчёта
    otvet:=recor;  // после того как подпрог calcularest прервалась  записываем в переменную
    writeln('answer',' ',otvet);
    readln();
end.   

Вывод консоли:

enter the line
answer 30