Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 05.05.2013, 22:15   #1
ahgpoug
Новичок
Джуниор
 
Регистрация: 05.05.2013
Сообщений: 1
По умолчанию Зацикливается

Помогите пожалуйста!
Задали решить ребус: ТОЧКА+КРУГ=КОНУС
Вроде делаю все правильно, но программа зацикливается.
Код:
program rebus;
uses crt;
var t,c,k,a,o,n,y,s,r,g,tocka,kryg,konys,f:integer;
begin
for t:=0 to 9 do
for o:=1 to 9 do
for c:=0 to 9 do
for k:=1 to 9 do
for a:=0 to 9 do
for r:=0 to 9 do
for y:=0 to 9 do
for g:=0 to 9 do
for n:=0 to 9 do
for s:=0 to 9 do
tocka:=t*10000+o*1000+c*100+k*10+a;
kryg:=k*1000+r*100+y*10+g;
konys:=k*10000+o*1000+n*100+y*10+s;
if (konys=tocka+kryg) and (t<>o) and (t<>c) and (t<>k) and (t<>a) and (t<>r) and (t<>y) and (t<>g) and
(t<>n) and (t<>s) and (o<>t) and (o<>c) and (o<>k) and (o<>a) and (o<>r) and (o<>y) and (o<>g) and (o<>n) and (o<>s) and
(c<>t) and (c<>o) and (c<>k) and (c<>a) and (c<>r) and (c<>y) and (c<>g) and (c<>n) and (c<>s) and
(k<>t) and (k<>o) and (k<>c) and (k<>a) and (k<>r) and (k<>y) and (k<>g) and (k<>n) and (k<>s) and
(a<>t) and (a<>o) and (a<>c) and (a<>k) and (a<>r) and (a<>y) and (a<>g) and (a<>n) and (a<>s) and
(r<>t) and (r<>o) and (r<>c) and (r<>k) and (r<>a) and (r<>y) and (r<>g) and (r<>n) and (r<>s) and
(y<>t) and (y<>o) and (y<>c) and (y<>k) and (y<>a) and (y<>r) and (y<>g) and (y<>n) and (y<>s) and
(g<>t) and (g<>o) and (g<>c) and (g<>k) and (g<>a) and (g<>r) and (g<>y) and (g<>n) and (g<>s) and
(n<>t) and (n<>o) and (n<>c) and (n<>k) and (n<>a) and (n<>r) and (n<>y) and (n<>g) and (n<>s) and
(s<>t) and (s<>o) and (s<>s) and (s<>k) and (s<>a) and (s<>r) and (s<>y) and (s<>g) and (s<>n) then
begin
f:=f+1;
writeln(f,')');
writeln(tocka:7);
writeln('+':1);
writeln(kryg:6);
writeln('_______________');
writeln(konys:7);
if f mod 3=0 then readln;
end;
if f=0 then writeln('Net resheniy');
end.
Умоляю помочь! Заранее благодарю за ответ!
ahgpoug вне форума Ответить с цитированием
Старый 05.05.2013, 23:12   #2
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,291
По умолчанию

Опустим то, что код неверен (не хватает begin и end в последнем цикле, да и в if есть ошибка).
Ваши циклы предполагают 10^8 * 9^2 шагов = 8100000000, хотя очевидно, что у Вас 10 уникальных букв, то есть нужно получить только все перестановки цифр и правильно их подставить в формулу проверки 10! = 3628800, а если учесть, что на первых местах в словах стоят не 0, то количество вариантов сокращается до 8! * 8 * 9 = 2903040.
Красивую реализацию пока не придумал.

UPD
Код:
type
  tarray = array [0 .. 9] of byte;

var
  i: byte;
  count: longint;
  a: tarray;
  { 0123456789 }
  { точкаругнс }

procedure print();
var
  x, y, z: longint;
begin
  x := a[0] * 10000 + a[1] * 1000 + a[2] * 100 + a[3] * 10 + a[4];
  y := a[3] * 1000 + a[5] * 100 + a[6] * 10 + a[7];
  z := a[3] * 10000 + a[1] * 1000 + a[8] * 100 + a[6] * 10 + a[9];
  if (x + y = z) and (a[0] <> 0) and (a[3] <> 0) then
  begin
    inc(count);
    writeln(count, ') ', x, ' + ', y, ' = ', z);
    { for i := 0 to 9 do
      write(a[i], ' ');
      writeln; }
  end;
end;

procedure swap(var a, b: byte);
var
  tmp: byte;
begin
  tmp := a;
  a := b;
  b := tmp;
end;

procedure generate(c: byte);
var
  j: byte;
begin
  if c = 0 then
  begin
    print();
    exit;
  end;
  for j := 0 to c - 1 do
  begin
    swap(a[j], a[c - 1]);
    generate(c - 1);
    swap(a[j], a[c - 1]);
  end;
end;

begin
  for i := 0 to 9 do
    a[i] := i;
  count := 0;
  generate(10);
  if count = 0 then
    writeln('No solutions');
  readln;

end.
Для экономии стека оперирую в процедурах глобальными переменными, хотя так делать не стоит (оперировать глобальными переменными, а не экономить стек ).
Эта реализация проверяет 3628800 перестановок. Теоретически, она быстрее в 1000 раз (на 3 порядка), чем Ваша.
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )

Последний раз редактировалось BDA; 06.05.2013 в 02:30.
BDA вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Зацикливается цикл при выполнении... в чем ошибка? Sturvi Общие вопросы C/C++ 2 15.10.2010 20:26
программа зацикливается Юрий_91 Общие вопросы C/C++ 4 24.04.2010 16:23
Зацикливается recv. asdo Общие вопросы C/C++ 4 23.01.2010 23:38