Генерация 9 значных чисел... Опции

[reill]

Задали преподователи задачку:
Придумать алгоритм записи девятизначного числа,в котором нет повторяющихся цифр и которое делится без остатка на 11.Число делится на 11,если разность между суммой цифр,стоящих на четных местах суммой -на нечетных делится на 11 или равна нулю. Определить минимальное и максимальное среди этих чисел.
Минимальное: 102347586; S1=1+2+4+5+6=18; S2=0+3+7+8=18.

Я тут пару часиков посидел вот катала начало:

Код

program cz;
type  mn=set of byte;
masiv=array[1..9] of string;
var cch: masiv;
cn: masiv;
c:longint;
obr: string;
i:byte;
function mnog(var b: string): boolean;
var f,z integer;
begin
val(b,f,z);
for i:=0 to 9
begin
if f=i then
end;
begin
randomize;
c:=trunc(random*1000000000);
str(c,obr);
for i:=1 to 9 do
begin
if odd(i) then
begin
cn[i]:=copy(obr,i,1);
writeln('cn[',i,']:=',cn[i]);
end
else
begin
cch[i]:=copy(obr,i,1);
writeln('cch[',i,']:=',cch[i]);
end
end;

end.

Но чего то мне этот алгоритм не нравится у кого есть другие идеи буду рад обсудить....

Сообщение отредактировано: volvo - 17.12.2004 11:43

[GLuk]

Есть идея - послать препода  :)

[reill]

Идея хорошая,но этом преподу не подойдет...
Не думал что в кодерском форуме мне могут предложить такую идею...... >:(

[GLuk]

Ну вот, сразу и обиделся :o

Ты бы сначала вопрос правильно сформулировал, а затем рожи вот такие >:( >:( >:( ставил...

Исходя из вопроса тебе нужна прога записи сгенеренного 9-значного числа причем без разницы куда - тогда см. проц. OutPut9, а тело самой проги, как раз таки выделяет все эти числа и пишет их в файл. Алг-итм не оптимизирован, т.ч. не обессудь...

Код

Uses
   Crt;
Const
    Min9 = 100000000;
    Max9 = 999999999;
Var
  FName:String;
  L:Word;
Procedure OutPut9(S:String);
begin
    FName:='output.txt'#0;
    {S:='102347586';}
    L:=Length(S);
    {WRITE TO FILE}
    asm
       mov ah,3Ch
       mov cx,20h
       lea dx,FName
       inc dx
       int 21h
       mov bx,ax
       mov ah,40h
       lea dx,S
       inc dx
       mov cx,L
       int 21h
       mov ah,3Eh
       int 21h
    end;
    {WRITE TO SCREEN}
    asm
       mov ax,$B800
       mov es,ax
       xor di,di
       mov cx,L
       lea si,S
       inc si
       cld
       mov ah,7  {ATTRIBUTE}
    @@:lodsb
       stosw
       loop @@
    end;
end;
Var
  i,j,Sum1,Sum2:LongInt;
  S:String;
  R:Real;
  M:array[0..9] of Boolean;
  XEP:Boolean;
  F:Text;
Begin
    ClrScr;
    Assign(F,'output.txt');    
    ReWrite(F);
    {Вот алг., но ужасный и не оптимизированный - у меня считал - 25 мин.}
    For i:=Min9 to Max9 do
    begin
         Str(i,S);
         Sum1:=0; Sum2:=0;
         For j:=1 to 9 do M[j]:=False;
         For j:=1 to 9 do
         If Odd(j) then Inc(Sum1,Ord(S[j])-48)
         else
             Inc(Sum2,Ord(S[j])-48);
         XEP:=False;
         For j:=1 to 9 do
         begin
              If M[Ord(S[j])-48] then XEP:=True;
              If not M[Ord(S[j])-48] then M[Ord(S[j])-48]:=True;
         end;
         If not XEP then
         begin
              R:=abs(Sum2 - Sum1) MOD 11;
              If R=0 then WriteLn(F,S);
         end;
         If KeyPressed then Halt(2);
         GotoXY(1,1);
         Write(i);
    end;
    Close(F);

Сообщение отредактировано: volvo - 17.12.2004 11:44

[reill]

Ну ты наворотил)))
Ладно будем разбираться....

[GLuk]

Напиши сколько будет считать/писать на 1,5 Гц считал не менее 12 мин.  :o

[reill]

;D
Нет ну я конечно все понимаю..  ну ты шутник, форум ведь пасалевский и лабы я по паскалю сдаю=)))
у меня п3 800мгх считало до 200000000 - 30 минут потом я отрубил....

[reill]

Сегодня пойду сдавать лабу проконсультируюсь  с ней. Зачтеную прогу выложу в форум... Будем всем народом читать)))

[GLuk]

У меня на 1,5 ГГц - 25 мин., а все-таки алгоритм рабочий...скоро поправлю маленько - выложу

[reill]

Не люблю  таких преподователей которые сами не знают как решать свои задачи(((
Чего-то нагородила((
Вообщем типа сам разбирайся(((

[GLuk]

Не люблю  таких преподователей которые сами не знают как решать свои задачи(((
Чего-то нагородила((
Вообщем типа сам разбирайся(((

Что ты имеешь ввиду? Твой препод сам не смог решить задачу?

[reill]

типа того=))
Сказала что перебор не подойдет нужно плесать от суммы четных и не четных элементов....

[GLuk]

Тогда поставь условие покорректней!
Как было сформулировано изначально - преподом...

[Ivs]

Нет. Простой перебор в этой задаче, это просто глупо. А если бы там было найти не 9 значное число, а положим 10, время факториально возрастет и считать он будет уже наверное не 30 мин на )быстрых машинах.)
Нужно что то придумывать, например нестоит просчитывать числа с неодинаковыми числами, (какое огромное количество итераций сокращается А ???), т.е предлагаю искать среди этих чисел числа с разными цифрами, что тоже нужно сделать как то оптимально либо формировать такие числа..... вобщем надо думать...........

[GLuk]

To IVS: Смотри условие, лично я, когда писал процедуру на асме, плясал от него. А в условии говорится об алгоритме ЗАПИСИ 9-значного числа, причем не указывается куда конкретно. А перебор - это конечно не рационально. Вот когда напишет условие по-человечески, тогда и ответ получит соответственный. А его исходник, который он "за два часа катала" вообще ничего определенного не делает.  :P

[reill]

То что мой исходник ничего не делает я согласен(((
А вот если кто-то не понимает ясного и понятного условия я не виноват, такой вариант с перебором я мог и за 30 мин и без асма накатать)))
Что тебе не понятно слово "записать"??? Это же смешно)))
Записать - значит получить такое число а - потом с них что хочешь делай... хочешь в файл хочешь на экран.

[GLuk]

То что мой исходник ничего не делает я согласен(((
А вот если кто-то не понимает ясного и понятного условия я не виноват, такой вариант с перебором я мог и за 30 мин и без асма накатать)))
Что тебе не понятно слово "записать"??? Это же смешно)))
Записать - значит получить такое число а - потом с них что хочешь делай... хочешь в файл хочешь на экран.

Все в условии мне было понятно с самого начала, но записать - это не значит получить (и если это смешно, то КВН для тебя). Эквивалент ПОЛУЧИТЬ - СГЕНЕРИРОВАТЬ - СФОРМИРОВАТЬ и т.п. А что ж ты не накатал хоть такой вариант, который я катать вообще-то и не собирался, из-за неверно сформулированного условия. Хрен с ним седни переделаю в нормальный вариант...

[reill]

Ладно не ори записать получить, какая разница. Задание я не сам формулировал а просто с помощью буфера скопировал из файла со спец заданиями...
Если не веришь могу тебе его отправить
Там таких КВНовских шуток 100 штук, на пару недель смеха тебе хватит.

[GLuk]

Мысля следующая: нужно поперекидывать все уникальные неповторяющиеся комбинации, т.е. (123456789-123456780-123456709-123456089 и т.д. - всего 10 штук), тогда основной цикл (это в плане описанный ранее перебор) сокращается в 198723 раз, а время счета соответственно до 10-15 минут, вне принципиальной зависимости от МГц проца. Другого варианта я не знаю, вроде все попробовал...
Для каждого набора 2^9 комбинаций, т.е. всего 512, а в общем 5120!  :)

[reill]

Мыслишь грамотно, прям как я=))
Только комбинаций ты многова-то насчитал...
Я почти закончил прогу только она глючит маленько и я дальше не писать в последнем цикле ставль 8 значений, а она вертит его бесконечно, что за глюк ??? Н у может я чего не усмотрел :-/
Вот исходник( специально для GLuk - напоминаю что она еЩЁ НЕ ДОДЕЛАННА=)):

Код

program cz_new;
uses crt;
type
masiv=array[1..9] of byte;
const
chisla: array[1..10] of longint = & #40;123456789,123456780,123456709,123456089,123450789,123406789,123056789,120456
789,103456789,
234567890);
var
c: masiv;
b:longint;
i: byte;
f: integer;
fl: text;


procedure pr(var a:longint);
var
obr: string;
begin
str(a,obr);
for i:=1 to 9 do
begin
val(copy(obr,i,1),c[i],f);
writeln(c[i]);
end;
end;


procedure perest;
var st,st2: string;
begin
f:=c[1];
for i:=2 to 9 do c[i-1]:=c[i];
c[9]:=f;
st2:='';
for i:=1 to 9 do
begin
str(c[i],st);
st2:=st2+st;
end;
val(st2,b,f);
end;

begin
clrscr;
assign(fl,'out.txt');
rewrite(fl);
pr(chisla[1]);
for i:=1 to 8 do
begin
perest;
writeln(B);
if b mod 11 = 0 then writeln(fl,B);
end;
close(fl);
end.

Сообщение отредактировано: volvo - 17.12.2004 11:45