Помощь - Поиск - Пользователи - Календарь
Полная версия: подсчитать буквы
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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.
volvo
Найди тему про ребусы (по словам "+fiat +motor" в поиске, всего 3 темы находит, смотри последнюю), там приведена корректно работающая программа. Достаточно будет только изменить буквы на твои и все.

О проблемах твоего кода: во-первых, у тебя запрограммировано не решение ребуса "ABCD+ABCD=EFGH", а решение с какой-то MUHA-ой... Во-вторых, условие начала цикла должно быть НЕ if u in S1 then, а обратным:
if not (u in S1) then ..., и так везде, по всем переменным кроме первой.
klem4
Вот что-то на подобии универсального решателя таких задачек, писал вчера ночью, так что возможны ошибки, сейчас потестил, вроде ок ..

{$mode tp}
{$b-}
const alpha = 'abcdefgh';
var palette: array [1..length( alpha )] of byte;

procedure dump(const s: string);
var
i: byte;
begin
for i := 1 to length(s) do write(palette[pos(s[i], alpha)]);
writeln;
end;

function atoi( const s: string ): integer;
var
i: byte;
int, ten, pow, cvalue: longint;
begin
int := 0;
ten := 1;
for i := length(s) downto 1 do begin
cvalue := palette[ pos(s[i], alpha) ];
inc(int, cvalue * ten);
ten := ten * 10;
end;
atoi := int;
end;

function next_palette: boolean;
var i: byte;
begin
i := length(palette) + 1;
repeat
dec(i);
inc( palette[i]);
if ( palette[i] > 9 ) then palette[i] := 0;
until (palette[i] <> 0) or ((palette[i] = 0) and (i = 1));
next_palette := palette[i] <> 0;
end;

procedure solve( const a, b, c: string);
var
done: boolean;
_a, _b, _c, i: longint;
begin
fillchar( palette, sizeof(palette), 0);
next_palette;

repeat
_a := atoi(a); _b := atoi(b); _c := atoi©;
until (_a + _b = _c) or not (next_palette);

if ( _a + _b = _c ) then begin
dump(a); dump(b); dump©;
writeln(_a, '+', _b, '=', _c);
for i := 1 to length(alpha) do writeln(alpha[i], '=', palette[i]);
end else writeln('no');
end;

begin
solve('abcd', 'abcd', 'efgh');
end.
volvo
Ну, попробуй твоим "решателем" разгадать ребус VOLVO+FIAT=MOTOR...

Добавлено через 7 мин.
P.S. Здесь: Множества -> Ребусы лежит универсальный решатель, но только рекурсивный... Находит все 92 возможных решения...
klem4
const alpha = 'volfiamtr';
...
function atoi( const s: string ): longint; // вместо integer
...
solve('volvo', 'fiat', 'motor');


Код

C:\FPC\2.2.2\bin\i386-win32>forum1.exe
00000
0101
00101
0+101=101
v=0
o=0
l=0
f=0
i=1
a=0
m=0
t=1
r=1

volvo
И что это? Где ответ? Показать тебе правильные решения?
klem4
А почему это нерпавильное ?

volvo=00000 === 0
fiat = 0101 === 101
motor = 00101 === 101

0 + 101 = 101
volvo
Потому что
Цитата
каждая разная буква записана под разным числом
. А у тебя? V = L ??? И так далее?
klem4
Понятно.
maksimla
а мне чтоли так надо было исправить
program galvosukis;
type aibe = set of 0..9;
var sakitmuo, a,b,c,d : 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 := [0];
for a := 0 to 9 do
begin
S1 := S1+[a];
for b := 0 to 9 do
if not(b in S1)
then
begin
S1 := S1+[b];
for c := 0 to 9 do
if not (c in S1)
then
begin
S1 := S1+[c];
for a := 0 to 9 do
if not (d in S1)
then
begin
S1 := S1+[d];
n1 := 1000*a+100*b+10*c+d;
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-[d];
end;
S1 := S1-[c];
end;
S1 := S1-[b];
end;
S1 := S1-[a];
end;
readln;
end.

но серавно тут неправильно идет
volvo
Цитата
а мне чтоли так надо было исправить
Нет, тебе надо было сделать так:
program galvosukis;
type aibe = set of 0..9;
var sakitmuo, a,b,c,d, e,f,g,h : 0..9;
i, n1, n2 : integer;
S1: aibe;

procedure spausdink(x, y : integer);
begin
write(x);
write(' + ');
write(x);
write(' = ');
writeln(y);
end;
begin
S1 := [];
for a := 0 to 9 do begin
S1 := S1+[a];
for b := 0 to 9 do if not (b in S1) then begin
S1 := S1+[b];
for c := 0 to 9 do if not (c in S1) then begin
S1 := S1+[c];
for d := 0 to 9 do if not (d in S1) then begin
S1 := S1+[d];
for e := 0 to 9 do if not (e in S1) then begin
s1 := s1+[e];
for f := 0 to 9 do if not (f in S1) then begin
S1 := S1+[f];
for g := 0 to 9 do if not (g in S1) then begin
s1 := s1+[g];
for h := 0 to 9 do if not (h in S1) then begin
s1 := s1+[h];

n1 := 1000*a+100*b+10*c+d;
n2 := 1000*e+100*f+10*g+h;
if n1 + n1 = n2 then spausdink(n1, n2);

s1 := s1-[h];
end;
s1 := s1-[g];
end;
s1 := s1-[f];
end;
s1 := s1-[e];
end;
s1 := s1-[d];
end;
s1 := s1-[c];
end;
S1 := S1-[b];
end;
S1 := S1-[a];
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-х)
maksimla
спасибо всем за помощь
maksimla
вопрос образовался у меня а это что вы мне помогли ошибки исправить будит программа с поиском в глубину?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.