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

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

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

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Генерация 9 значных чисел...
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 52

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


Задали преподователи задачку:
Придумать алгоритм записи девятизначного числа,в котором нет повторяющихся цифр и которое делится без остатка на 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Профи
****

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

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


Есть идея - послать препода  :)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Пионер
**

Группа: Пользователи
Сообщений: 52

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


Идея хорошая,но этом преподу не подойдет...
Не думал что в кодерском форуме мне могут предложить такую идею...... >:(
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Профи
****

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

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


Ну вот, сразу и обиделся :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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Пионер
**

Группа: Пользователи
Сообщений: 52

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


Ну ты наворотил)))
Ладно будем разбираться....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Профи
****

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

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


Напиши сколько будет считать/писать на 1,5 Гц считал не менее 12 мин.  :o
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Пионер
**

Группа: Пользователи
Сообщений: 52

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


;D
Нет ну я конечно все понимаю..  ну ты шутник, форум ведь пасалевский и лабы я по паскалю сдаю=)))
у меня п3 800мгх считало до 200000000 - 30 минут потом я отрубил....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Пионер
**

Группа: Пользователи
Сообщений: 52

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


Сегодня пойду сдавать лабу проконсультируюсь  с ней. Зачтеную прогу выложу в форум... Будем всем народом читать)))
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Профи
****

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

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


У меня на 1,5 ГГц - 25 мин., а все-таки алгоритм рабочий...скоро поправлю маленько - выложу
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Пионер
**

Группа: Пользователи
Сообщений: 52

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


Не люблю  таких преподователей которые сами не знают как решать свои задачи(((
Чего-то нагородила((
Вообщем типа сам разбирайся(((
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Профи
****

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

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


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


Что ты имеешь ввиду? Твой препод сам не смог решить задачу?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Пионер
**

Группа: Пользователи
Сообщений: 52

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


типа того=))
Сказала что перебор не подойдет нужно плесать от суммы четных и не четных элементов....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Профи
****

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

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


Тогда поставь условие покорректней!
Как было сформулировано изначально - преподом...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Бывалый
***

Группа: Пользователи
Сообщений: 209

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


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


--------------------
Если вы хотите чаще встречаться с понравившейся девушкой установите ей Windows'95
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Профи
****

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

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


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


Пионер
**

Группа: Пользователи
Сообщений: 52

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


То что мой исходник ничего не делает я согласен(((
А вот если кто-то не понимает ясного и понятного условия я не виноват, такой вариант с перебором я мог и за 30 мин и без асма накатать)))
Что тебе не понятно слово "записать"??? Это же смешно)))
Записать - значит получить такое число а - потом с них что хочешь делай... хочешь в файл хочешь на экран.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Профи
****

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

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


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


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


Пионер
**

Группа: Пользователи
Сообщений: 52

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


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


Профи
****

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

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


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


Пионер
**

Группа: Пользователи
Сообщений: 52

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


Мыслишь грамотно, прям как я=))
Только комбинаций ты многова-то насчитал...
Я почти закончил прогу только она глючит маленько и я дальше не писать в последнем цикле ставль 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 27.10.2020 11:35
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name