Цитата

Дано натуральное k. Напечатать k-ую цифру последовательности: 123456789101112131415161718192021222324...

Вот моё решение:

Код

program N4; {$APPTYPE CONSOLE} var a:array of byte; pos_inc1:integer; pos_inc2:integer; f:boolean; procedure inc_a(pos:integer); begin if Length(a) < pos  then   SetLength(a, pos); inc(a[pos]); if not f  then   pos_inc1:=pos  else   pos_inc2:=pos; if a[pos] > 9  then   begin    f:=true;    a[pos]:=a[pos] mod 10;    inc_a(pos+1)   end end; var x,k,i:integer; begin readln(k); if k < 10  then   x:=k  else   begin    SetLength(a,2);    a[1]:=9;    for i:=10 to k do     if i mod 2 = 0      then       begin        f:=false;        inc_a(1)       end;   if k mod 2 = 0    then     x:=a[pos_inc2]    else     x:=a[pos_inc1]   end; writeln; writeln(x); readln end.

... и в чём вопрос?

Правильно рассуждал?

А k какой максимальности может быть ?

А чёрт его знает. Скорее всего ограничивается типом переменной, т. к. в условии об этом не сказано...

Тогда объясни словами что ты тут делаешь, а то загружать в Delphi для прогона не охота... Хотя смотря на объём кода в голове мигает лампочка, что можно легче и проще...

В массив записано число
пример
12
a[1] = 2
a[2] = 1
Есть переменные
pos_inc1:integer;
pos_inc2:integer;
они сохраняют номер элемента массива, который был изменен в последний раз
f - бы лли перехо типа 9 -> 10, т .е. новый разряд...

Объяснить тяжело!!!

p0s0l, привет. мне тоже эта срань покою не даёт вот первое, что на ум пришло:

Код

procedure TForm1.Button1Click(Sender: TObject); var  s, s1: string;  k, i, j, n: integer; begin  if InputQuery ('Enter', 'Enter natural number: ', s) then begin    k := StrToInt (s);    s1 := '';    i := 1;    n := 1;    repeat      s := IntToStr (n);      for j := 1 to Length (s) do begin        s1 := s1 + s [j];        if i > k then          Break        else          Inc (i);      end;      Inc (n);    until i > k;    ShowMessage (IntToStr (k) + '-th ?number - ' + s1 [k]);  end; end;

Вот, что у меня щас в голову пришло:

Код

program N4_2; {$APPTYPE CONSOLE} uses  SysUtils; var k,i,x:int64; a,s:int64; begin readln(k); i:=1; a:=1; while i <= k do  begin   s:=a;   if a = 10    then     inc(i);   while (s <> 0) and (i <= k) do    begin     x:=s mod 10;     s:=s div 10;     inc(i)    end;   if i <= k    then     inc(a)  end; writeln; writeln(x); readln end.

Какая же это задача по программированию! Помню много лет назад она была на какой-то математической олимпиаде для k=какому-то году. Я не помню как, но она решалась и без компьютера для любого k. Вроде можно вывести формулу.

что-то у меня сложилось впечатление, что этот код работает только до места "9899***100101 (или на 99 последовательность заканчивается?
думаю, здесь подошло бы что-нибудь вроде этого:

Код

function GetDigit(k:integer):char; var  beg,size,degree:integer;  index,subindex:integer; begin  beg:=0;  size:=10;  degree:=1;  while(k>=size)do  begin    beg:=beg+size;    size:=size*10;    degree:=degree+1;  end;  index:=beg+(k-beg)div degree;  subindex:=(k-beg)mod degree;  while(subindex>0)do  begin    index:=index div 10;    subindex:=subidex-1;  end;  result:=index mod 10; end;

только вот проверить не удалось: с тех пор, как поменял компьютер никак руки не доходят Delphi установить...
Добавлено @ 23:09
угу...
все, что я писал в начале - про первый вариант
а то я подключился на dialup, скачал кучу тем, а пока дошел до прочтения этой и написания ответа тут уже вон сколько написали...
Добавлено @ 23:10

Цитата

Какая же это задача по программированию! Помню много лет назад она была на какой-то математической олимпиаде для k=какому-то году. Я не помню как, но она решалась и без компьютера для любого k. Вроде можно вывести формулу.

прочитал и дошло - действительно, можно записать в виде формулы, если использовать вместо degree порядок числа (округленный десятичный логарифм)

упс... напутал маленько...

Код

function GetDigit(k:integer):char; var  beg,size,degree:integer;  index,subindex:integer; begin  beg:=1;  size:=9;  degree:=1;  while(k>=size)do  begin    beg:=beg+size*degree;    size:=size*10;    degree:=degree+1;  end;  beg:=beg-1;  index:=beg+(k-beg)div degree;  subindex:=(k-beg)mod degree;  while(subindex>0)do  begin    index:=index div 10;    subindex:=subidex-1;  end;  result:=index mod 10; end;

Чего то я не совсем понимаю условия задачи, но на всякий случай кину, пришедший в голову код:

Код

function FindSequenceElement(Sequence: String; const Number: Integer): String; var  Count, i, Offset: Integer; begin  Offset := 0;  Count := Length(IntToStr(Number));  Inc(Offset, (Number - Trunc(Power(10, (Count - 1)))) * Count);  for i := Count - 1 downto 2 do    Inc(Offset, i * 9 * (Trunc(Power(10, (i - 1)))));  Result := Copy(Sequence, Offset + 10, Count); end; procedure TForm1.Button1Click(Sender: TObject); var  Seq: String;  i: integer; begin  Seq := '';  for i := 1 to 10000 do    Seq := Seq + IntToStr(i);  ShowMessage(FindSequenceElement(Seq, 7310)); end;

Хотя это равносильно IntToStr(7310) )) Может ты дашь нормашьную постановку задачи?

Это сообщение отредактировал(а) <Spawn> - 15.10.2004, 11:33

Код

procedure GetK(t:integer); var c,n,k:integer; begin c:=1; n:=1; while (t>9*n*c) do  begin   t:=t-9*n*c;   n:=n*10;   inc(c);  end; if c>1 then  begin   dec(t);   n:=(t div c)+n; //Число!   t:=(t mod c); //Позиция k в числе!   dec(c);   k:=n;   while (c<>t) do    begin     k:=k div 10;     dec(c);    end;   k:=k mod 10; //К цифра  end else  begin   k:=t;   n:=t;  end; caption:='К-я цифра:'+IntToStr(k)+'; До кучи и число: '+IntToStr(n); end;

Удачи.

Цитата

Может ты дашь нормашьную постановку задачи?

Что есть, то есть...

ряд можно сотавить при момощи такой штуки

Код

s:=''; for i:=1 to NN do s:=s + IntToStr(i);

Надо найти k-тую цифру "строки", типа s[k]. Но это решается на Pascal'е и без всяких строк...