[angvelem]

Вроде правильно считает

Код:

program asd23_3;

{$APPTYPE CONSOLE}

uses
  Windows, Classes, SysUtils;

type
  TZhidkost	= record
    zh1, zh2,
    zh3, dist	: Integer;
  end;

  TStack	= class
    Buf		: array[0..999] of TZhidkost;
    Top, Tail	: Integer;
  
    constructor Create;
    function    Get : TZhidkost;
    function    Empty : Boolean;
    procedure   SetTop(z : TZhidkost);
    function    Find(t : TZhidkost) : Boolean;
  end;

var
  v1, v2,
  v3, zh  : Integer;

constructor TStack.Create;
begin
  Top  := 1;
  Tail := 0;
end;

function TStack.Get : TZhidkost;
begin
  Result := Buf[Top - 1];
  inc(Top);
end;

function TStack.Empty;
begin
  Result := Top > Tail;    
end;

procedure TStack.SetTop(z : TZhidkost);
begin
  Buf[Tail] := z;
  inc(Tail);
  inc(Buf[Tail - 1].dist);
end;

function TStack.Find(t : TZhidkost) : Boolean;
var
  I : Integer;
begin
  Result := True;

  for I := 0 to Tail - 1 do
    if (Buf[i].zh1 = t.zh1) and (Buf[i].zh2 = t.zh2) and (Buf[i].zh3 = t.zh3) then
      Exit;
  
  Result := False;
end;

//==============================================================

procedure pour(var zh1 : Integer; var zh2 : Integer; v1, v2 : Integer);
var
  I : Integer;
begin
  I := v2 - zh2;

  if zh1 >= I then
  begin
    dec(zh1, I);
    inc(zh2, I);
  end
  else
  begin
    inc(zh2, zh1);
    zh1 := 0;
  end;  
end;

function Rek(zhid : TZhidkost) : Integer;
var
  Stack1  : TStack;
  Stack2,
  Stack3  : TZhidkost;
begin
  Result := -1;

  zhid.dist := 0;
  Stack1 := TStack.Create;
  try
    Stack1.SetTop(zhid);

    while not Stack1.Empty do
    begin
      Stack2 := Stack1.Get;
      Stack3 := Stack2;

      if (Stack2.zh1 <> 0) and (Stack2.zh2 < v2) then
      begin
        pour(Stack2.zh1, Stack2.zh2, v1, v2);
        if (Stack2.zh1 = zh) or (Stack2.zh2 = zh) or (Stack2.zh3 = zh) then
        begin
          Result := Stack2.dist;
          Exit;
        end;

        if not Stack1.Find(Stack2) then
          Stack1.SetTop(Stack2);
      end;
      
      Stack2 := Stack3;
      if (Stack2.zh1 <> 0) and (Stack2.zh3 < v3) then
      begin
        pour(Stack2.zh1, Stack2.zh3, v1, v3);
        if (Stack2.zh1 = zh) or (Stack2.zh2 = zh) or (Stack2.zh3 = zh) then
        begin
          Result := Stack2.dist;
          Exit;
        end;

        if not Stack1.Find(Stack2) then
          Stack1.SetTop(Stack2);
      end;
      
      Stack2 := Stack3;
      if (Stack2.zh2 <> 0) and (Stack2.zh1 < v1) then
      begin
        pour(Stack2.zh2, Stack2.zh1, v2, v1);
        if (Stack2.zh1 = zh) or (Stack2.zh2 = zh) or (Stack2.zh3 = zh) then
        begin
          Result := Stack2.dist;
          Exit;
        end;

        if not Stack1.Find(Stack2) then
          Stack1.SetTop(Stack2);
      end;
   
      Stack2 := Stack3;
      if (Stack2.zh2 <> 0) and (Stack2.zh3 < v3) then
      begin
        pour(Stack2.zh2, Stack2.zh3, v2, v3);
        if (Stack2.zh1 = zh) or (Stack2.zh2 = zh) or (Stack2.zh3 = zh) then
        begin
          Result := Stack2.dist;
          Exit;
        end;

        if not Stack1.Find(Stack2) then
          Stack1.SetTop(Stack2);
      end;
     
      Stack2 := Stack3;
      if (Stack2.zh3 <> 0) and (Stack2.zh1 < v1) then
      begin
        pour(Stack2.zh3, Stack2.zh1, v3, v1);
        if (Stack2.zh1 = zh) or (Stack2.zh2 = zh) or (Stack2.zh3 = zh) then
        begin
          Result := Stack2.dist;
          Exit;
        end;

        if not Stack1.Find(Stack2) then
          Stack1.SetTop(Stack2);
      end;
      
      Stack2 := Stack3;
      if (Stack2.zh3 <> 0) and (Stack2.zh2 < v2) then
      begin
        pour(Stack2.zh3, Stack2.zh2, v3, v2);
        if (Stack2.zh1 = zh) or (Stack2.zh2 = zh) or (Stack2.zh3 = zh) then
        begin
          Result := Stack2.dist;
          Exit;
        end;

        if not Stack1.Find(Stack2) then
          Stack1.SetTop(Stack2);
      end;
    end;
  finally
    Stack1.Free;
  end;
end;

procedure Main;
var
  OutFile : TextFile;
  zhid    : TZhidkost;
  sl      : TStringList;
  St      : String;
  I       : Integer;
begin
  if ParamCount > 0 then                        // Если указан файл для обработки
    St := ParamStr(1)
  else                                          // иначе берём по-умолчанию
    St := 'input.txt';

  // Отсутствуют любые проверки!!!
  sl := TStringList.Create;
  sl.Delimiter := ' ';
  sl.LoadFromFile(St);
  sl.DelimitedText := sl.strings[0];
  v1       := StrToInt(sl.strings[0]);
  v2       := StrToInt(sl.strings[1]);
  v3       := StrToInt(sl.strings[2]);
  zhid.zh1 := StrToInt(sl.strings[3]);
  zhid.zh2 := StrToInt(sl.strings[4]);
  zhid.zh3 := StrToInt(sl.strings[5]);
  zh       := StrToInt(sl.strings[6]);
  
  Assign(OutFile, 'output.txt');
  Rewrite(OutFile);
  try
    if (zhid.zh1 + zhid.zh2 + zhid.zh3 < zh) or
       ((zh > v1) and (zh > v2) and (zh > v3)) then
    begin
      WriteLn(OutFile, 'Нет решения');
      Exit;
    end;
    
    if (zhid.zh1 = zh) or (zhid.zh2 = zh) or (zhid.zh3 = zh) then
    begin
      WriteLn(OutFile, '0');
      Exit;
    end;

    I := Rek(zhid);
    if I = -1 then
      WriteLn(OutFile, 'Нет решения')
    else
      WriteLn(OutFile, I);

  finally
    CloseFile(OutFile);
  end;
end;

begin
  Main;
end.