Генерация 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]

Ну вот, сразу и обиделся :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