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

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

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

 
 Ответить  Открыть новую тему 
> подсчитать буквы, можете исправить программу
maksimla
сообщение 27.02.2009 21:49
Сообщение #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 
 К началу страницы 
+ Ответить 
volvo
сообщение 27.02.2009 22:25
Сообщение #2


Гость






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

О проблемах твоего кода: во-первых, у тебя запрограммировано не решение ребуса "ABCD+ABCD=EFGH", а решение с какой-то MUHA-ой... Во-вторых, условие начала цикла должно быть НЕ if u in S1 then, а обратным:
if not (u in S1) then ..., и так везде, по всем переменным кроме первой.
 К началу страницы 
+ Ответить 
klem4
сообщение 28.02.2009 9:34
Сообщение #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(c);
   until (_a + _b = _c) or not (next_palette);

   if ( _a + _b = _c ) then begin
      dump(a); dump(b); dump(c);
      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 
 К началу страницы 
+ Ответить 
volvo
сообщение 28.02.2009 11:08
Сообщение #4


Гость






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

Добавлено через 7 мин.
P.S. Здесь: Множества -> Ребусы лежит универсальный решатель, но только рекурсивный... Находит все 92 возможных решения...
 К началу страницы 
+ Ответить 
klem4
сообщение 28.02.2009 12:05
Сообщение #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 
 К началу страницы 
+ Ответить 
volvo
сообщение 28.02.2009 12:09
Сообщение #6


Гость






И что это? Где ответ? Показать тебе правильные решения?
 К началу страницы 
+ Ответить 
klem4
сообщение 28.02.2009 12:13
Сообщение #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 
 К началу страницы 
+ Ответить 
volvo
сообщение 28.02.2009 12:18
Сообщение #8


Гость






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


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

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

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


Понятно.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
maksimla
сообщение 28.02.2009 13:53
Сообщение #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 - 28.02.2009 14:02


--------------------
Учусь первый год на программиста в колледже. Учусь на втором курсе в школе программирования при научно-исследовательском институте математики и информатики.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 28.02.2009 14:13
Сообщение #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.
 К началу страницы 
+ Ответить 
Vinchkovsky
сообщение 28.02.2009 14:41
Сообщение #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 - 28.02.2009 15:13
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
maksimla
сообщение 28.02.2009 20:27
Сообщение #13


Знаток
****

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

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


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


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


Знаток
****

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

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


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


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

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

 

- Текстовая версия 16.07.2025 21:05
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"