Сестра убиралась у себя в шкафу и нашла книгу которую я искалпол года, сборник олипиадных задача 80-х годов Вот стал решать там все подрят, собственно задача :

В написании выражения ((((1?2)?3)?4)?5?)?6 вместо каждого знака ? вставить знак одного из 4-х арифметическихвыражений : +, -, *, / так, чтобы результат вычислений равнялся 35 (при делении дробная часть отбрасывается) Достаточно найти одно решение.

Мое решение оказалосб менше и понятней для меня чем решение приведенное в книге, но может кто придложет еще более комактный вариант ;)

uses crt;
var
   a_1,a_2 : integer;

function calculate(a,b : integer; ch : char) : integer;
begin
   case ch of
    '+' : calculate := a + b;
    '-' : calculate := a - b;
    '*' : calculate := a * b;
    '/' : calculate := a div b;
   end;
end;

var
   c : array[1..4] of char = ('+','-','*','/');
   c1, c2, c3, c4, c5  : byte;

begin
   clrscr;
   for c1 := 1 to 4 do
    for c2 := 1 to 4 do
     for c3 := 1 to 4 do
      for c4 := 1 to 4 do
       for c5 := 1 to 4 do begin
          a_1 := 1;
          a_2 := 2;
          a_1 := calculate(a_1,a_2,c[c1]);
          inc(a_2);
          a_1 := calculate(a_1,a_2,c[c2]);
          inc(a_2);
          a_1 := calculate(a_1,a_2,c[c3]);
          inc(a_2);
          a_1 := calculate(a_1,a_2,c[c4]);
          inc(a_2);
          a_1 := calculate(a_1,a_2,c[c5]);
          if a_1 = 35 then begin
             writeln(c[c1],' ',c[c2],' ',c[c3],' ',c[c4],' ',c[c5]);
             halt;
          end;
       end;
end.

чувствую что можно это все еще сократить, но пока не получается ..

буду выклывадывать интересные задачки, если етсь желающие мозги размять

По-моему, у тебя не все результаты находятся... Моя программа нашла 3 возможных варианта:

uses crt;

function oper(a, b: integer; ch: char): integer;
begin
  case ch of
    '+' : oper := a + b;
    '-' : oper := a - b;
    '*' : oper := a * b;
    '/' : oper := a div b;
  end;
end;

const
  op: array[1 .. 4] of char = ('+','-','*','/');

procedure calculate(s: string);
var res, i: integer;
begin
  if length(s) = 5 then begin

    res := 1;
    for i := 1 to 5 do
      res := oper(res, i+1, s[i]);

    if res = 35 then begin
      for i := 1 to 5 do write(s[i]:3);
      writeln
    end;
  end

  else
    for i := 1 to 4 do
      calculate(s + op[i]);
end;

begin
  calculate('');
end.

У меня просто после нахождения первого решение происходит выход из программы, можно и убрать.

Я тоже решил поупражняться в краткости. И вот что у меня получилось:

var
  a,i,j:integer;
  s:string;

begin
  for i:=0 to 1023 do begin
    a:=1;
    s:='';
    for j:=2 to 6 do begin
      case i shr ((j-2)*2) and 3 of
        0:begin a:=a+j; s:=s+'+ ' end;
        1:begin a:=a-j; s:=s+'- ' end;
        2:begin a:=a*j; s:=s+'* ' end;
        3:begin a:=a div j; s:=s+'/ ' end;
      end;
    end;
    if a=35 then WriteLn(s)
  end
end.

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