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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 05.11.2009, 18:53   #1
k1r1ch
ACM!
Форумчанин
 
Аватар для k1r1ch
 
Регистрация: 19.06.2009
Сообщений: 382
Вопрос Как "ускорить" задачу на перебор

Цитата:
10-11.3. «Мартин Гарднер».
Имеется числовой ребус:
МАРТИН + МАРТИН + ... + МАРТИН = ГАРДНЕР
N раз

Напишите программу, которая для заданного n решает этот ребус.
Напомним, что согласно правилам составления ребуса, одинаковые цифры заменяются одинаковыми буквами, а разные цифры — разными буквами. Также в расшифровке ребуса
не допускаются числа с ведущими нулями. То есть, в нашем ребусе буквы М и Г не могут обозначать нуль.

Формат ввода: В первой строке входного файла содержится единственное натуральное число n (1 < n < 10000).

Формат вывода: В первой строке выходного файла содержится либо строка NO, если для заданного n ребус решений не имеет, либо YES, если имеет. В случае, когда ребус имеет решение, вторая строка должна содержать число, соответствующее слову МАРТИН, а третья — число, соответствующее слову ГАРДНЕР.
Вот такая задачка, и как я понял, тут нужен перебор. Вот что я написал:

Код:
program Obl1x10x3;
uses CRT;
type
  TLArr = array [1..9] of integer;
const
  Martin: array [1..6] of byte = (1, 3, 6, 7, 4, 5);
  Gardner: array [1..7] of byte = (2, 3, 6, 8, 5, 9, 6);
var
  N, i: integer;
  Num: longint;
  Ready: boolean;
  L: TLArr; {М, Г, А, И, Н, Р, Т, Д, Е}

procedure NextL;
var
  i: integer;
  Temp: longint;
begin
  Temp := Num;
  for i := 9 downto 1 do
    begin
      L[i] := Temp mod 10;
      Temp := Temp div 10;
    end;
  Inc(Num);
end;

function Power(X, Y: integer): longint;
var i: integer; Temp: longint;
begin
  Temp := 1;
  for i := 1 to Y do
    Temp := Temp * X;
  Power := Temp;
end;

function CreateNumber(First: boolean): longint;
var Temp: longint;
begin
  Temp := 0;
  if First then
    for i := 1 to 6 do
      Temp := Temp + L[Martin[i]] * Power(10, 6 - i + 1)
  else for i := 1 to 7 do
    Temp := Temp + L[Gardner[i]] * Power(10, 7 - i + 1);
  CreateNumber := Temp;
end;

begin
  ClrScr;
  Ready := false;
  Write('N = ');
  Read(N);
  Num := 110000000;
  repeat
    NextL;
    if CreateNumber(true) * N = CreateNumber(false) then
      begin
        Ready := true;
        Break;
      end;
    Writeln(Num);
  until Num = 1000000000;
  if Ready then
    begin
      Writeln('Found!');
      Writeln('MARTIN is ', CreateNumber(true));
      Writeln('GARDNER is ', CreateNumber(false));
    end else
  Write('Can''t do it!');
  repeat until keypressed;
end.
Но работает так долго, что я не дотерпел до конца, чтобы проверить решение. Есть ли варианты "убыстрить" это?
k1r1ch вне форума Ответить с цитированием
Старый 05.11.2009, 19:04   #2
LeBron
Форумчанин
 
Регистрация: 10.10.2009
Сообщений: 680
По умолчанию

Довольно детский вариант задачи, дали бы букв 9-10 - надо бы было оптимально перебирать, с отсечением и подстановкой, а так..
Какой лимит времени? 1 секунда?
Тогда тупой "правильный" лобовик должен катить. Из 10 цифр можно згенерить всего 151200 вариант слова "МАРТИН", из которых 15120 начинаються на 0. Остаеться всего 136080 чисел. Генерим все числа, проверяем, совпадают ли в результате ключевые буквы (А и Р) и все дела.
LeBron вне форума Ответить с цитированием
Старый 05.11.2009, 19:27   #3
k1r1ch
ACM!
Форумчанин
 
Аватар для k1r1ch
 
Регистрация: 19.06.2009
Сообщений: 382
По умолчанию

Как 151200 вариантов?! Каждая буква - 10 вариантов, кроме первой =>
9 * 10 * 10 * 10 * 10 * 10 = 900 000
Дак и я у себя так и сделал - генерю число и подставляю, если МАРТИН * N = ГАРДНЕР, то все, иначе следующее число. Но я где-то накосил, в результате оно минут 5 работает! Вот только где?
k1r1ch вне форума Ответить с цитированием
Старый 05.11.2009, 20:03   #4
LeBron
Форумчанин
 
Регистрация: 10.10.2009
Сообщений: 680
По умолчанию

Цитата:
Сообщение от k1r1ch Посмотреть сообщение
Как 151200 вариантов?! Каждая буква - 10 вариантов, кроме первой =>
9 * 10 * 10 * 10 * 10 * 10 = 900 000
В слове Мартин 6 разных букв, а разные буквы=разные цифры. Если первой букве отдать цифру 1, то вторая, третья, четрветая, пятая и шестая уже не могут быть единицами Хотя я подумал, проще написать полный перебор, чем генерацию выборок. Сейчас попробую, как у него со временем - а то подозреваю, что в секунду он уложиться разве что на мощной и не загруженой виртуальной машине тестирующей системы, а не на "обычном компе прошлого века". Сейчас посмотрим. Миллион итераций, вложеность 6, 15 уловий проверки и еще огранизация самого сравнения...

Вот, в секунду укладываеться (edit - на моем не сильно продвинутом металобрухте показывает 0.54с ), вроде бы рабочий (то, что выводит для части тестов, проверял вручную, правильно, но не могу гарантировать, что он находит все решения или что дает верные ответы на все тесты, так как проверил только штук 15), сейчас еще тестить буду. Использовал полный перебор. Если есть напряги с памятью, то лучше выбросить 2мерные массивы и сделать объявление внутри самого цикла. Но мой вариант позволяет время секономить
Код:
 var i,j,q,w,e,r,t,nm,p,n,h:longint;
a1,ara1,ara:array[0..1000000,0..10] of byte;er:array[0..1000000] of byte;
begin
readln(n);if n<100 then begin 
for i:=1 to 9 do begin for j:=0 to 9 do begin for q:=0 to 9 do begin for w:=0 to 9 do begin for e:=0 to 9 do begin for r:=0 to 9 do begin

nm:=i*100000+j*10000+q*1000+w*100+e*10+r;t:=nm*n;if (t>=10000000)or (t<1000000)then er[nm]:=1;
if er[nm]=0 then begin 
for p:=1 to 7 do begin ara1[nm,p]:=t mod 10;t:=t div 10;end;
if (ara1[nm,1]<>ara1[nm,5])
or (ara1[nm,5]<>q) or (ara1[nm,6]<>j)or (ara1[nm,3]<>r)
then er[nm]:=1; if er[nm]=0 then begin inc(a1[nm,i]);inc(a1[nm,j]);inc(a1[nm,q]);inc(a1[nm,w]);
inc(a1[nm,e]);inc(a1[nm,r]);
for p:=1 to 7 do inc(a1[nm,ara1[nm,p]]);a1[nm,ara1[nm,1]]:=1;a1[nm,ara1[nm,6]]:=1;  a1[nm,ara1[nm,3]]:=1;
 h:=0;
for p:=0 to 9 do if a1[nm,p]<>1 then inc(h);if h=1 then begin writeln(nm);writeln(nm*n);writeln;end;

end;end;end;end;end;end; end;end;end;
end.
Осталось доделать оформление вывода согласно условию задачи и, при желании, отформатировать.
edit Дописал "проверку а глупость". Ведь на входе может быть и миллион, тогда надо переделывать под инт64, а то, что ответа не будет, и так понятно.

Последний раз редактировалось LeBron; 06.11.2009 в 11:38.
LeBron вне форума Ответить с цитированием
Старый 06.11.2009, 09:33   #5
k1r1ch
ACM!
Форумчанин
 
Аватар для k1r1ch
 
Регистрация: 19.06.2009
Сообщений: 382
По умолчанию

Хм, я переделывал пока, LeBron уже сделал Только это, вы всегда так форматируете? Просто сложно читать...

З.Ы.: Нифига, ваша программа действительно меньше секунды работает! А моя новая 10 секунд Сейчас попытаюсь понять секрет

З.Ы.Ы: А как это объяснить: под Delphi моя программа 3 сек. ищет, а под Паскалем 10 сек.? В чем тут вообще может быть разница?

Последний раз редактировалось k1r1ch; 06.11.2009 в 09:47.
k1r1ch вне форума Ответить с цитированием
Старый 06.11.2009, 10:33   #6
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
а под Паскалем 10 сек.?
Может тем что паскаль из под виртуальной машины запускается...
Я имею ввду NTVDM
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 06.11.2009, 10:40   #7
k1r1ch
ACM!
Форумчанин
 
Аватар для k1r1ch
 
Регистрация: 19.06.2009
Сообщений: 382
По умолчанию

Скомпилированный под Делфи файл работает быстрее скомпилированного из под Паскаля и ФриПаскаля. Значит надо пользоваться Делфи
k1r1ch вне форума Ответить с цитированием
Старый 06.11.2009, 11:32   #8
LeBron
Форумчанин
 
Регистрация: 10.10.2009
Сообщений: 680
По умолчанию

Цитата:
Сообщение от k1r1ch Посмотреть сообщение
Хм, я переделывал пока, LeBron уже сделал Только это, вы всегда так форматируете? Просто сложно читать...
Нет, всегда я вообще не форматирую и срезаю по краю екрана. Я уже привык, а удобность в том, что меньше над бегать глазами вверх-вниз и мотать страницу. А сдесь немного "переделал" для "удобства" других. Большинство программ умещаються в 1 екран Сейчас еще в своей программе кое-что допишу.
LeBron вне форума Ответить с цитированием
Старый 07.11.2009, 11:34   #9
k1r1ch
ACM!
Форумчанин
 
Аватар для k1r1ch
 
Регистрация: 19.06.2009
Сообщений: 382
По умолчанию

Я все-таки решил вернуться к этой задаче и сделать по-другому (чтоб не копировать тупо ). Вот как я сделал (у меня около секунды выполняется):
Код:
program Obl1x10x3;
uses CRT;
label FromCycle;
var
  i1, i2, i3, i4, i5, i6, i7, i8, i9: integer; {М, Г, А, И, Н, Р, Т, Д, Е}
  Used: array [0..9] of boolean;
  N: integer;
  Ready: boolean;
  Martin, Gardner: longint;
begin
  ClrScr;
  Ready := false;
  Write('N = ');
  Read(N);
  for i1 := 1 to 9 do
   begin
   Used[i1] := true;
   for i2 := 1 to 9 do
   if not Used[i2] then
    begin
    Used[i2] := true;
    for i3 := 0 to 9 do
    if not Used[i3] then
     begin
     Used[i3] := true;
     for i4 := 0 to 9 do
     if not Used[i4] then
      begin
      Used[i4] := true;
      for i5 := 0 to 9 do
      if not Used[i5] then
       begin
       Used[i5] := true;
       for i6 := 0 to 9 do
       if not Used[i6] then
        begin
        Used[i6] := true;
        for i7 := 0 to 9 do
        if not Used[i7] then
         begin
         Used[i7] := true;
         for i8 := 0 to 9 do
         if not Used[i8] then
          begin
          Used[i8] := true;
          for i9 := 0 to 9 do
          if not Used[i9] then
           begin
             Used[i9] := true;
             Martin := i1 * 100000 + i3 * 10000 + i6 * 1000 +
             i7 * 100 + i4 * 10 + i5;
             Gardner := i2 * 1000000 + i3 * 100000 + i6 * 10000 +
             i8 * 1000 + i5 * 100 + i9 * 10 + i6;
             if Martin * N = Gardner then
               begin Ready := true; goto FromCycle; end;
             Used[i9] := false;
           end;
          Used[i8] := false;
          end;
         Used[i7] := false;
         end;
        Used[i6] := false;
        end;
       Used[i5] := false;
       end;
      Used[i4] := false;
      end;
     Used[i3] := false;
     end;
    Used[i2] := false;
    end;
   Used[i1] := false;
   end;
  FromCycle:
  Writeln('-------------------');
  if Ready then
    begin
      Writeln('Found!');
      Writeln('MARTIN is ', Martin);
      Writeln('GARDNER is ', Gardner);
    end else
  Writeln('Can''t do it!');
  repeat until keypressed;
end.
k1r1ch вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как ускорить расчеты формул??? Иванов_ДМ Microsoft Office Excel 7 02.09.2009 09:53
Как ускорить программу ? juan666777 Общие вопросы Delphi 2 02.05.2009 19:48
Как ускорить работу программы SibBear Общие вопросы Delphi 7 27.03.2009 14:40
Как ускорить работу с сетевой БД Ramires БД в Delphi 3 21.08.2008 12:16
Как ускорить выполнение макросов tat-besidovska Microsoft Office Excel 1 22.01.2008 12:12