подсчитать буквы, можете исправить программу Опции

[maksimla]

дан головоломка ABCD+ABCD=EFGH где каждая разная буква записана под разным числом .
надо буквы изменить цифрами чтобы былобы правильное решение .напишите програму чтобы нашлабы всевозможные варьянты решения
написал програму но в ней ошибки есть помогите исправить ошибки

program galvosukis;
  type aibe = set of 0..9;
  var sakitmuo, m, u, h, a : 0..9;
      i, n1, n2 : integer;
      S1, S2 : aibe;
      f : boolean;
  procedure spausdink(x, y : integer);
  begin
    write(x);
    write(' + ');
    write(x);
    write(' = ');
    writeln(y);
    writeln;
  end;
begin
  S1 := [];
  for m := 0 to 9 do
    begin
      S1 := S1+[m];
      for u := 0 to 9 do
        if u in S1
          then
            begin
              S1 := S1+[u];
              for h := 0 to 9 do
                if h in S1
                  then
                    begin
                      S1 := S1+[h];
                        for a := 0 to 9 do
                          if a in S1
                            then
                              begin
                                S1 := S1+[a];
                                n1 := 1000*m+100*u+10*h+a;
                                n2 := n1;
                                f := true;
                                S2 := [];
                                for i := 0 to 9 do
                                  begin
                                    sakitmuo := n2 mod 1;
                                    n2 := n2 mod 10;
                                    f := n2 and sakitmuo in s2;
                                    S2 := [sakitmuo] + S2;
                                  end;
                                if (S1+S2=[ ]) and f
                                  then
                                    spausdink(n1, 2 * n1);
                                S1 := S1-[a];
                              end;
                     S1 := S1-[h];
                end;
            S1 := S1-[u];
        end;
      S1 := S1-[m];
    end;
      readln;
end.

[Vinchkovsky]

А разве не достаточно сделать 4-х уровневый цикл, а остальные буквы получить с полученного числа? Как-то так:

for a:=0 to 9 do
 for b:=0 to 9 do
  if not (b in [a]) then
   for c:=0 to 9 do
    if not (c in [a,b]) then
     for d:=0 to 9 do
      if not (d in [a,b,c]) then
        begin
          result:=(1000*a+100*b+10*c+d)*2;
          if result<10000 then
            begin
              e:=result div 1000;
              result:=result mod 1000;
              f:=result div 100;
              result:=result mod 100;
              g:=result div 10;
              h:=result mod 10;
              if (not (e in [a,b,c,d,f,g,h])) and (not (f in [a,b,c,d,e,g,h])) and
              (not (g in [a,b,c,d,f,e,h])) and (not (h in [a,b,c,d,f,g,e])) then
              writeLn(a,' ',b,' ',c,' ',d,' ',e,' ',f,' ',g,' ',h)
            end;
        end;
  readln
end.

Да и можно сократить пределы поиска вдвое (а - от 0 до 4-х)


Сообщение отредактировано: Vinchkovsky - 28.02.2009 15:13