IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> подсчитать буквы, можете исправить программу
сообщение
Сообщение #1


Знаток
****

Группа: Пользователи
Сообщений: 324
Пол: Мужской
Реальное имя: maksim

Репутация: -  1  +


дан головоломка 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.


--------------------
Учусь первый год на программиста в колледже. Учусь на втором курсе в школе программирования при научно-исследовательском институте математики и информатики.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Найди тему про ребусы (по словам "+fiat +motor" в поиске, всего 3 темы находит, смотри последнюю), там приведена корректно работающая программа. Достаточно будет только изменить буквы на твои и все.

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


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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

{$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.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Ну, попробуй твоим "решателем" разгадать ребус VOLVO+FIAT=MOTOR...

Добавлено через 7 мин.
P.S. Здесь: Множества -> Ребусы лежит универсальный решатель, но только рекурсивный... Находит все 92 возможных решения...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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



--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






И что это? Где ответ? Показать тебе правильные решения?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


А почему это нерпавильное ?

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

0 + 101 = 101


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Потому что
Цитата
каждая разная буква записана под разным числом
. А у тебя? V = L ??? И так далее?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Понятно.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Знаток
****

Группа: Пользователи
Сообщений: 324
Пол: Мужской
Реальное имя: maksim

Репутация: -  1  +


а мне чтоли так надо было исправить
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.

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

Сообщение отредактировано: maksimla -


--------------------
Учусь первый год на программиста в колледже. Учусь на втором курсе в школе программирования при научно-исследовательском институте математики и информатики.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Гость






Цитата
а мне чтоли так надо было исправить
Нет, тебе надо было сделать так:
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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Пионер
**

Группа: Пользователи
Сообщений: 98
Пол: Мужской
Реальное имя: Andriy

Репутация: -  0  +


А разве не достаточно сделать 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Знаток
****

Группа: Пользователи
Сообщений: 324
Пол: Мужской
Реальное имя: maksim

Репутация: -  1  +


спасибо всем за помощь


--------------------
Учусь первый год на программиста в колледже. Учусь на втором курсе в школе программирования при научно-исследовательском институте математики и информатики.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Знаток
****

Группа: Пользователи
Сообщений: 324
Пол: Мужской
Реальное имя: maksim

Репутация: -  1  +


вопрос образовался у меня а это что вы мне помогли ошибки исправить будит программа с поиском в глубину?


--------------------
Учусь первый год на программиста в колледже. Учусь на втором курсе в школе программирования при научно-исследовательском институте математики и информатики.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 23.10.2020 7:20
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name