Помощь - Поиск - Пользователи - Календарь
Полная версия: Генерация 9 значных чисел...
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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.


Но чего то мне этот алгоритм не нравится у кого есть другие идеи буду рад обсудить....
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);
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.
GLuk
Ты юзаешь глобальную переменную (описанную как i) во всех процедурах - оттого он и крутит его бесконечно...а комбинаций все-таки ни больше ни меньше, хотя хрен его знает...
reill
Да с этим я разобрался все дописал вот что вышло:
Код
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,j,k: 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;
if c[1]=0 then
begin
f:=c[1];
for i:=2 to 9 do c[i-1]:=c[i];
c[9]:=f;
end;
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);
for j:=1 to 10 do
begin
pr(chisla[j]);
for k:=1 to 8 do
begin
perest;
if b mod 11 = 0 then writeln(fl,B);
end;
end;
close(fl);
end.


Но вот маза которую я понял, когда посмотрел на результаты - то что этими 10 числами не отделаешься, цифры ведь могут стоять не только подряд, а у меня они попорядку меняются местами... обыдно, надо додумывать "задачку".... >:(
GLuk
О чем я и говорил, когда писал о 5120 комбинациях, т.к. для каждого разряда выходит + степень => 2^9=512, а чисел всего 10 - поэтому 5120 комбинаций  :smile.gif Числа, которые ты описываешь как массив из LongInt'ов, лучше описать как String.
reill
Зачем стрингом???
Ну зацени свой вариант, надеюсь он без Асма...
GLuk
Данная прога генерить все комбинации из набора "23456789", потом просто подставляется единица, описанная как FN. Чтобы получить действительно все комбинации для "123456789", единицу надо 9 раз поменять с другими цифрами. Думаю теперь уж доделаешь сам smile.gif

А комбинаций кстати всего - 362.880 для одного набора, а для девяти 3.265.920. Поначалу не так посчитал, через факториал надобно...

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

Код
Uses
   Crt;
Const
    S:array[1..9] of String = ('123456789','103456789','120456789',
                               '123056789','123406789','123450789',
                               '123456089','123456709','123456780');
Function Fact(N:LongInt):LongInt;
var
  T:LongInt;
  i:LongInt;
begin
    T:=1;
    For i:=1 to N do T:=T*i;
    Fact:=T;
end;
Const
    O:String = '6789';
    L:String = '2345';
    FN:Char  = '1';
    K:Char = #1;
    N=3;
Var
  T,i,Sum1,Sum2:LongInt;
  j:Byte;
  F:Text;
  V:LongInt;
  Code:Integer;
Procedure Form2;
var
  i,j:Integer;
  Tm:String;
begin
    Tm:=L;
    For j:=1 to N+1 do
    begin
    For i:=1 to 3 do
    begin
         Val(FN+L+O,V,Code);
         If V MOD 11 = 0 then WriteLn(F,V);
         K:=L[N+1];
         L[N+1]:=L[N];
         L[N]:=K;
         Val(FN+L+O,V,Code);
         If V MOD 11 = 0 then WriteLn(F,V);
         If Odd(i) then
         begin
              K:=L[N+1];
              L[N+1]:=L[N];
              L[N]:=K;
         end;
         K:=L[2];
         L[2]:=L[N+1];
         L[N+1]:=K;
    end;
    L:=Tm;
    K:=L[N-j+2];
    L[N-j+2]:=L[1];
    L[1]:=K;
    end;
end;
Procedure Form1;
var
  i,j:Integer;
  Tm:String;
begin
    Tm:=O;
    For j:=1 to N+1 do
    begin
    For i:=1 to 3 do
    begin
         Form2;
         K:=O[N+1];
         O[N+1]:=O[N];
         O[N]:=K;
         Form2;
         If Odd(i) then
         begin
              K:=O[N+1];
              O[N+1]:=O[N];
              O[N]:=K;
         end;
         K:=O[2];
         O[2]:=O[N+1];
         O[N+1]:=K;
    end;
    O:=Tm;
    K:=O[N-j+2];
    O[N-j+2]:=O[1];
    O[1]:=K;
    end;
end;

Begin
    ClrScr;
    Assign(F,'output.txt');
    ReWrite(F);
    Form1;
    Close(F);
End.
reill
Чего-то твоя прога у меня ничего не делает файл создает и ничего не пишет....
Ты уж доделай свой шедевр))
А потом хвастай
GLuk
Доделывать я ничего не буду. Вообще ты просил алгоритм, так вроде он есть да и кусок проги - генерящей какое-то количество номеров.
Ты попробуй протрейсить и посмотреть что она делает - она генерит комбинации для набора 123456789, причем изменяются только цифры 23456789. А когда видишь прогу в мессаге, то сначал почитай то, что в начале написано, а затем запускай. Вообщем посмотри и подумай, а пустой файл и должен быть пустым...
reill
Не парься.... Я читал и месейдж и саму прогу...
Неуже ли ты меня совсем за лоха держишь...Просто в лом вникать было в твои творения, ты бы хоть кометариев нацарапал...
reill
Да чуть не забыл- не забудь раздел называется не алгоритмы, а задачи... :P
GLuk
Цитата
Не парься.... Я читал и месейдж и саму прогу...
Неуже ли ты меня совсем за лоха держишь...Просто в лом вникать было в твои творения, ты бы хоть кометариев нацарапал...


Никого я за лоха не держу, а по поводу проги - ты понял КАК она это делает?

Цитата
Да чуть не забыл- не забудь раздел называется не алгоритмы, а задачи...

А вот по поводу этого: ты сначала просто просил подкинуть идей для генера. А потом вишь я ору, держу кого попало за лохов, хвастаюсь. Смотри как люди общаются (в плане вежливо, исключая частные случаи). Козлом и засранцем я и сам мог тебя назвать, но этого не сделал. Типа выбирай выражения/фильтруй базар/кроши батон и т.п.
reill
Какое трогательное сообщение.... Я не знал что это тебя так сильно заденит :-[ Извини пожалуйста :'( ;)
GLuk
Прогу-то сдал?
reill
На следующей недели здаю...С твоим вариантом ещё даже не разбирался... времени нет(((, но ты не бойся твои глюки все найду))) :P
reill
Так я вот не понял одного ты чего это за прогу написал???
Твои геморно закрученные алгоритмы перестановки я не трогаю, может они и
составленны путем сложных интегрально - факториальных вычислений, (хотя это врядли, уж очень мои напаминают)
Но зачем тебе массив типа стринг из 9 элементов, если ты с ним нифига не делаешь, а меняешь местами другие переменные
Или я чего-то не догнал, и ты имел ввиду что я их туда прилеплю, каким-то макаром???
Тогда хоть идею расскажи(напиши просто ход твоего алгоритма, так ничего не понятно)...
Я весь внимания!!!
GLuk
Дык, все же очень просто, дебагом не пробовал пользоваться. Проследи за изменением локальных переменных по прозвищу Tm в процедурах Form1/2.
reill
Ну вот вчера ходил её здавать...
Все оказалось на много хуже чем я думал/ Ни мой ни твой вареант не пошел так как они оба "используют перебор", а нужно исходить из сумм цифр на четных и не четных местах. Зато она перед мной извинилась и сказала что вычеркнет это задание, так как сама решала  его день, и зделала только половину)) Но если я его доведу до ума  то это будет засчитанно как курсовая..
Она дала мне исходничек  со своим вариантом перестановки  чисел для составления сумм, скоро ввыложу его( как сканер подключу..)
Такие проги.... ;D
GLuk
Выкладывай скорее, что же это за прога, если УЧИТЕЛЬ писал 1/2 оной целый ДЕНЬ!!!  :o  :D

Какой способ использует учитель???

Вроде все прикинул  :(
reill
Способ у нее как раз по условию она подбирает комбинации сумм цифр как в условии написанно... блин ее этот алгоритм на 1.5 листика без бутылки не разберешся, сегодня вечером положу...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.