Расшифровать ребус, паскаль

[IIo3uTuB]

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

ГОД+ГОД+ГОД+ГОД=ВЕК

[digitalis]

Так сгодится ?

program god_vek;
var i,j,god,vek,god_ms,tk : integer ;
   tmp:array[0..5] of integer ; tmp10:array[0..9] of integer ;
procedure d100 (arg,ind: integer) ;
begin
   tmp[ind] := arg div 100 ;
   tmp[ind+2] := arg mod 10 ;
   tmp[ind+1] := (arg - tmp[ind]*100-tmp[ind+2]) div 10 ;
end ;
begin
  god_ms := 0 ;
  for god := 1 to 249 do
    begin
      vek := god * 4 ;
      d100(god,0) ; d100(vek,3) ;
      for j := 0 to 9 do tmp10[j] := 0 ;
      for j := 0 to 5 do 
         if tmp10[tmp[j]] =0 then
             begin tmp10[tmp[j]] := 1 ; Inc (tk) end ;
      if tk =6 then
         begin
          Writeln(god,'  ',vek,'  ',tk) ;
          if god_ms < god then god_ms := god
         end ;
    end ;
  Writeln(god_ms) ;
end.

И тишина...

[digitalis]

ИЧСХ, ему важно вопрос задать - ответы он не читает. Совсем как в фильме "О чем говорят мужчины" .

[IIo3uTuB]

Можно её сделать методом полного перебора используя 3 цикла? Что бы попроще было

[Аватар]

Проще не будет, а правильней так точно ))

var i1,i2,i3,j,k,vmax: Integer;
    s: Set of Byte;
...
  s:=[];  vmax:=0;
  for i1:=1 to 2 do begin
    s:=[i1];
    for i2:=0 to 9 do
      if not (i2 in s) then begin
        s:=s+[i2];
        for i3:=0 to 9 do
          if not (i3 in s) then begin
            s:=s+[i3];
            j:=(i1*100+i2*10+i3)*4;
            if j<1000 then begin
              k:=j div 100;
              if not (k in s) then begin
                s:=s+[k];
                k:=(j mod 100) div 10;
                if not (k in s) then begin
                  s:=s+[k];
                  k:=j mod 10;
                  if not (k in s) then begin
                    if j>vmax then vmax:=j;   //в vmax результат
                  end;
                end;
              end;
            end;
            s:=[i1,i2];
          end;
        s:=[i1];
      end;
  end;

[digitalis]

Интересно девки пляшуть... И где же неправильность в моем решении? Тем более протестировано.

[Аватар]

И не анализировал. Просто результат:

2 8 6
2

Что это? Правильный ответ 245+245+245+245=980. Там еще около трех десятков подходящих решений, но в выше приведенном максимум для ВЕК

ЗЫ Может и не прав. Там

Найти также такие значения цифр, при которых сумма цифр в результате окажется наибольшей

а я ищу максимум всего числа. Щас посмотрим ))

Итого так, но прогу пусть ТС подправит ))

192+192+192+192=768 - 7+6+8=21

[digitalis]

Да, есть косяк... Все оттого, что отлаживал и тестировал в Дельфи ( отвык уже от этого у...го консольного редактора ), а потом при переносе в ТР последнюю правку пропустил. Признаю и посыпаю этим самым ... Но лаконичность решения этот досадный баг не опорочил Все 45 решений от 37/48 до 245/980 на лице

program god_vek;
var i,j,god,vek,god_ms,tk : integer ;
   tmp:array[0..5] of integer ; tmp10:array[0..9] of integer ;
procedure d100 (arg,ind: integer) ;
begin
   tmp[ind] := arg div 100 ;
   tmp[ind+2] := arg mod 10 ;
   tmp[ind+1] := (arg - tmp[ind]*100-tmp[ind+2]) div 10 ;
end ;
begin
  god_ms := 0 ;
  for god := 12 to 249 do 
    begin
      vek := god * 4 ; tk := 0 ;
      d100(god,0) ; d100(vek,3) ;
      for j := 0 to 9 do tmp10[j] := 0 ; tk := 0 ;
      for j := 0 to 5 do
        if tmp10[tmp[j]] =0 then
          begin tmp10[tmp[j]] := 1 ; Inc (tk) end ;
      if tk =6 then
         begin
          Writeln(god,'  ',vek,'  ',tk) ;
          if god_ms < god then god_ms := god
         end ;
    end ;
  Writeln(god_ms) ;
end.

[Аватар]

37/148 не решение. В таких ребусах первая цифра числа обычно не ноль. ГОД именно трехзначное число. Так что искать со 100 ))

[IIo3uTuB]

Спасибо