Антон Деревенский записал ряд натуральных чисел в порядке возрастания:1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 … и т.д.Затем вычеркнул из него все числа, в которых имеется хотя бы две одинаковые цифры. Получил:1 2 3 4 5 6 7 8 9 10 12 13 14 15 16 17 18 19 20 21 23 … и т.д.Теперь Вам необходимо по заданному числу N найти N-ое по счету число в получившейся последовательности — Pascal(Паскаль)

program asd;
 
    function IntToStr(number : integer) : string;
        var
            result : string;
        begin
        Str(number, result);
        IntToStr := result;
        end;
        
    function HasIdenticalFigures(number : integer) : boolean;
        var
            sNumber : string;
            letter : char;
        begin
        sNumber := IntToStr(number);
        repeat      
            letter := sNumber[1];
            Delete(sNumber, 1, 1);
            if (Pos(letter, sNumber) <> 0)
                then
                    begin
                    HasIdenticalFigures := true;
                    Exit;
                    end;
        until (Length(sNumber) = 0);
        HasIdenticalFigures := false;
        end;
        
var
    position : word;
    currentPosition : word;
    currentNumber : word;
begin
Write('position = ');
Readln(position);
currentPosition := 1;
currentNumber := 0;
while (currentPosition <= position) do
    begin
    Inc(currentNumber);
    if not(HasIdenticalFigures(currentNumber))
        then
            Inc(currentPosition);   
    end;
Write(currentNumber);
Readln;
end.

Вариант 2

uses crt;
function OstChs(a:integer):boolean;{функция определяет, какие числа остаются}
var m:set of byte;
    k:byte;
    b:integer;
begin
b:=a;
m:=[];
OstChs:=true;
while b<>0 do{пока число не ноль}
 begin
  k:=b mod 10;{отделяем цифру}
  if k in m then{если она уже есть в множестве}
   begin
    OstChs:=false;{это число вычеркиваем}
    break;{выходим из цикла}
   end
  else include(m,k);{если еще нет этой цифры, включаем в множество}
  b:=b div 10;{берем следующее число без этой цифры}
 end;
end;
var i,n,k:integer;
begin
clrscr;
repeat
write('Введите число от 1 до 10000 n=');
readln(n);
until(n>0)and(n<=10000);
i:=1;k:=0;
while k<n do{пока не дошли до заданного номера}
 begin
  if OstChs(i) then{если в числе нет одинаковых цифр}
    begin
     inc(k);{увеличиваем искомое число}
     inc(i);{переходим к следующему по порядку}
    end
  else inc(i);{если удаляем, то просто переходим к следующему}
 end;
write('Число N=',i-1);{результат=предпоследнее число}
readln
end.

Leave a Comment

8 + 1 =