Free Pascal. Полный перебор. Арифметические ребусы

[Léon1]

Free Pascal. Полный перебор. Арифметические ребусы

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

Вот я расшифровала ребус:

Program GodVek;
uses crt;
var g,o,d,v,e,k,l:byte;
begin
clrscr;
l:=0;
for g:=1 to 7 do
for o:=0 to 7 do
for d:=0 to 7 do
for v:=1 to 7 do
for e:=0 to 7 do
for k:=0 to 7 do
if (4*(100*g+10*o+d)=100*v+10*e+k)
and(g<>o)and(g<>d)and(g<>v)and(g<>e)and(g<>k)
and(o<>d)and(o<>v)and(o<>e)and(o<>k)
and(d<>v)and(d<>e)and(d<>k)
and(v<>e)and(v<>k)
and(e<>k) then
begin
writeln(g,o,d,'+',g,o,d,'+',g,o,d,'+',g,o,d,'=',v,e,k);
l:=l+1;
begin
write('Press Enter...');
readln;
end;
end;
readln
end.

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

 

[Vladimir_S]

А из каких соображений исключены восьмерки и девятки?

 

[Léon1]

А из каких соображений исключены восьмерки и девятки?

Да извините исправлю!
Program GodVek;
uses crt;
var g,o,d,v,e,k,l:byte;
begin
clrscr;
l:=0;
for g:=1 to 9 do
for o:=0 to 9 do
for d:=0 to 9 do
for v:=1 to 9 do
for e:=0 to 9 do
for k:=0 to 9 do
if (4*(100*g+10*o+d)=100*v+10*e+k)
and(g<>o)and(g<>d)and(g<>v)and(g<>e)and(g<>k)
and(o<>d)and(o<>v)and(o<>e)and(o<>k)
and(d<>v)and(d<>e)and(d<>k)
and(v<>e)and(v<>k)
and(e<>k) then
begin
writeln(g,o,d,'+',g,o,d,'+',g,o,d,'+',g,o,d,'=',v, e,k);
l:=l+1;
begin
write('Press Enter...');
readln;
end;
end;
readln
end.

 

[Vladimir_S]

Да извините исправлю!

То есть по ошибке? А я-то думал - вдруг какие-то математические тому основания есть? Ну ладно.
Уточните, о какой "сумме цифр" идет речь? О сумме
g+o+d+v+e+k? Или нет?

 

[Léon1]

begin
writeln(g,o,d,'+',g,o,d,'+',g,o,d,'+',g,o,d,'=',v, e,k);
l:=l+1;
if k mod 20=0 then {решений много, через 20 делаем задержку для просмотра}
и это изменила.
Подскажите как найти значения цифр, при которых сумма цифр в результате окажется наибольшей.

 

[Léon1]

То есть по ошибке? А я-то думал - вдруг какие-то математические тому основания есть? Ну ладно.
Уточните, о какой "сумме цифр" идет речь? О сумме
g+o+d+v+e+k? Или нет?

о сумме god+god+god+god=vek, т.е. vek!
вывести то число, где сумма цифр (vek) окажется наибольшей!

 

[Vladimir_S]

вывести то число, где сумма цифр (vek) окажется наибольшей!

Хм... у меня получается, что таких комбинаций (с одинаковой максимальной суммой) тоже несколько. Придется через массивы. Сейчас сделаю.

 

[Vladimir_S]

Вот:

uses crt;
var
 g1,o1,d1,v1,e1,k1,S:Array[1..100] of byte;
 g,o,d,v,e,k,l,i,M:byte;
begin
 clrscr;
 l:=0;
 for g:=1 to 9 do
  for o:=0 to 9 do
   for d:=0 to 9 do
    for v:=1 to 9 do
     for e:=0 to 9 do
      for k:=0 to 9 do
       if (4*(100*g+10*o+d)=100*v+10*e+k)
          and(g<>o)and(g<>d)and(g<>v)and(g<>e)and(g<>k)
          and(o<>d)and(o<>v)and(o<>e)and(o<>k)
          and(d<>v)and(d<>e)and(d<>k)
          and(v<>e)and(v<>k)
          and(e<>k) then
        begin
         Inc(l);
         writeln(g,o,d,'+',g,o,d,'+',g,o,d,'+',g,o,d,'=',v,e,k);
         S[l]:=v+e+k;
         g1[l]:=g;
         o1[l]:=o;
         d1[l]:=d;
         v1[l]:=v;
         e1[l]:=e;
         k1[l]:=k;
         If (l mod 20)=0 then
          begin
           write('Press Enter...');
           readln;
          end;
        end;
 M:=0;
 for i:=1 to l do
  if S[i]>M then M:=S[i];
 writeln;
 writeln('Combinations with maximal sum of figures in "vek" (',M,'):');
 for i:=1 to l do
  if S[i]=M then
   writeln(g1[i],o1[i],d1[i],'+',g1[i],o1[i],d1[i],'+',g1[i],o1[i],d1[i],'+',g1[i],o1[i],d1[i],'=',v1[i],e1[i],k1[i]);
 readln;
end.

 

[Léon1]

Спасибо большое за помощь!