Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.10.2009, 18:46   #1
ruslan-gonch
 
Регистрация: 25.10.2009
Сообщений: 4
Печаль Задача на повторяющиеся цифры

Использовать Дин.Массивы.

Вводится число k, Вывести k-е по счёту натуральное число, у которого ни одна цифра не повторяется.

Не могу решить уже две недели! При значениях k больше ста, выдаёт неправильный ответ, как я не старался! Пожалуйста, помогите.
ruslan-gonch вне форума Ответить с цитированием
Старый 25.10.2009, 21:10   #2
Lawless
Пользователь
 
Аватар для Lawless
 
Регистрация: 02.05.2009
Сообщений: 13
По умолчанию

Показывайте наработки, а там подправим
Не всё так сложно, как кажется...
Помог - ставь плюсег
Lawless вне форума Ответить с цитированием
Старый 25.10.2009, 21:15   #3
ruslan-gonch
 
Регистрация: 25.10.2009
Сообщений: 4
По умолчанию

Код:
Type
 IntArray = Array Of Integer;


Function GetDigits(n: Integer): IntArray;
Var
 x: IntArray;
Begin
 While (n <> 0) Do
  Begin
   SetLength(x, Length(x)+1);
   x[Length(x)-1] := n Mod 10;
   n := n Div 10;
   GetDigits := x;
  End;
End;



Function Kras(x: Integer): Boolean;
Var
j: Array[1..10000] Of Integer;
jk, mm, summ, ii, jj: Integer;
 y: IntArray;
Begin
 summ := 0;
 jk := 1;
 If x < 10 Then
  Begin
   Kras := TRUE;
  End;
 If (x >= 10) And (x < 100) Then
  Begin
   If x Mod 10 = x Div 10 Then
    Begin
     Kras := FALSE;
    End
   Else
    Begin
     Kras := TRUE;
    End;
  End;
 If (x >= 100) Then
  Begin
  y := GetDigits(x);
  For ii := Length(y)-1 DownTo 0 Do
   Begin
    j[jk] :=  y[ii];
    Inc(jk);
   End;
  For jj := 1 To jk-1 Do
   Begin
    For mm := jj+1 To jk Do
     Begin
      If (j[jj] = j[mm]) Then
      Begin
       Inc(summ);
      End;
     End;
    End;
 If summ = 0 Then
  Begin
   Kras := TRUE;
  End
 Else
  Begin
   Kras := FALSE;
  End;
End;
End;



Var
 i: Array[1..100000] Of Integer;
 k, k1, l, gg: Integer;
Begin
 Read(k);
 For gg := 1 To 10000 Do
 Begin
  i[gg] := gg;
 End;
 k1 := 0;
 l := 1;
 While (k <> k1) Do
  Begin
   If Kras(i[l]) Then
    Begin
     Inc(k1);
    End;
   Inc(l);
  End;
 WriteLn(i[l]-1);
End.

Последний раз редактировалось Stilet; 26.10.2009 в 13:36.
ruslan-gonch вне форума Ответить с цитированием
Старый 26.10.2009, 11:40   #4
Lawless
Пользователь
 
Аватар для Lawless
 
Регистрация: 02.05.2009
Сообщений: 13
По умолчанию

Код:
const n = 200;
Function check(a:integer):boolean;
var
 replace:string;
 i,j:integer;
Begin
 str(a,replace);
 for i:= 1 to length(replace) do
  for j:= i+1 to length(replace) do
   if (replace[i] = replace[j]) then begin
    check:= true;
   end
   else begin
    check:= false;
    exit;
   end;
end;
var 
 a: array[1..n] of integer;
 i,k,c:integer;
Begin
 c:= 1;
 for i:= 10 to n do
  if (check(i) = false) then begin
   a[c]:= i;
   inc(c);
  end;
 readln(k);
 writeln(a[k]);
end.
Не всё так сложно, как кажется...
Помог - ставь плюсег
Lawless вне форума Ответить с цитированием
Старый 26.10.2009, 13:32   #5
ruslan-gonch
 
Регистрация: 25.10.2009
Сообщений: 4
По умолчанию

Ой... Я тут половины текста не понимаю...
Можно попроще... самые основы динмассивов?
ruslan-gonch вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
повторяющиеся записи hinku БД в Delphi 3 18.08.2009 17:25
Задача на цифры числа Siluet Паскаль, Turbo Pascal, PascalABC.NET 6 04.06.2009 11:57
Сортирует цифры по строкам, а надо чтобы сортировала цифры , записанные через пробелы Алексей_xXx Помощь студентам 14 06.05.2009 17:42
Дана строка символов. Задача: удалить из строки все цифры. Striker14 Помощь студентам 1 25.02.2009 20:23
Повторяющиеся значения iid2007 Microsoft Office Access 2 16.09.2008 05:54