Вот что у меня получилось:

var n,n2,a,d,x,ch: longint;
    f: boolean;
const max=2147483647;
begin
  write('введите значение n: ');
  readln(n);
  if (n mod 5=0) then  writeln('для n=',n,' искомого числа не существует')
  else
    begin
      a:=0;
      n2:=2*n;
      x:=0;
        repeat
          begin
            f:=true;
            x:=0;
            a:=a+n2;
            d:=a;
            while (d<>0) and f do
              begin
                ch:=d mod 10;
                if (ch<>1) and (ch<>2) then f:=false;
                d:=d div 10;
              end;
            if f then x:=a;
          end;
        until (a>=max) or f;
        writeln('для n=',n,' x=',x,'')
    end;
end.

Вроде работает нормально.. но может можно что-то упростить или сделать лучше?

Во всяком случае мне сразу бросается в глаза:



я бы заменил на:



И еще между repeat и until использовать логические скобки (begin и end) не обязательно

Сообщение отредактировано: КМА - 1.11.2007 4:16

KMA
А зачем? Менять - так уж менять на n2 := n shl 1

Оля,

if (ch<>1) and (ch<>2) then f:=false;

меняем на

f := (d mod 10) in [1 .. 2]; { <--- переменная ch больше не нужна}

Лишний Begin/End тоже убираем (Repeat сам по себе является операторной скобкой...)

P.S. Описание max тоже не нужно... Есть MaxLongInt в Турбо Паскале...

Сообщение отредактировано: volvo - 1.11.2007 4:19

Еще наверное, логично будет поставить условие, на то, если вдруг предел перскочит. И вроде еще директиву надо включить от переполнения?

Директиву от переполнения и подобные ей не надо выключать, чтоб потом не было проблем...

Учитывая, что max= MaxLongInt условие a>max сработать не сможет и вероятна ситуация при которой а вылетит с переполнением и станет меньше max. Поэтому можно на всякий случай добавить еще одно условие:

     until (a>=max) or f or (a<0);

Ну и после на это тоже проверить, т.к. результат не получен, вывести соответствующее сообщение.
;)

Сообщение отредактировано: Malice - 1.11.2007 4:27

может, проще так проверять:
если (max-a<n2) - то и незачем n2 прибавлять...

Хм.. а это потому что сложение выполняется быстрее умножения или как?

Исправления внесла, всем спасибо))


С n2 я так поняла: вот, например, когда я ввожу 6, то n2=12 - уже подходит, а если я введу 2 - будет сначала 4, потом 8, и только потом 12.. т.е. чтобы добраться до искомого числа мне нужно двигаться с шагом n2, или можно как-то по-другому?

Сообщение отредактировано: Айра - 1.11.2007 5:50

Можно попробовать зайти с другой стороны.. Идти именно по числам, состоящим из 1,2 и проверять на делимость с 2*n. Количество таких чисел по идее меньше (769 всего до MaxLongInt) чем MaxLongINt / 2*n (Хотя это конечно от N зависит ) Чтобы идти по таким числам подряд достаточно переводить счетчик в двоичную систему и прибавлять 1-цу к каждому разряду.. Здесь вычислений поболее будет, но в целом должно быть быстрее
Вот примерчик:

var s,p,i,x,n:longint;
begin
readln (n);
i:=1;
repeat
   x:=i; s:=0; p:=1;
    while x>0 do begin
      s:=s+((x and 1)+1)*p; x:=x shr 1; p:=p*10;
    end;
  if (s mod (n shl 1))=0 then begin writeln (s); break; end;
  inc (i);
until s<0;
if s<0 then writeln ('Not found..');
end.

Спасибо, Malice
У меня были мысли по поводу именно 1,2-х чисел, но как реализовать я бы не догадалась. Буду разбираться))

Еще раз всем спасибо))

"Раз пошла такая пьянка" (С)

Оля,
еще один способ (правда, чуть более медленный, ибо - рекурсия, но вроде изначально о предельной скорости выполнения речь не шла) вывода нужных тебе чисел:

var
  n: integer;
const
  min: longint = maxlongint;

procedure check(X: longint);
var T: longint;
begin
  if (X > 0) and (X mod (2*n) = 0) then begin
    if min > X then min := X; exit;
  end
  else begin
    if X < MaxLongInt div 10 then begin
      check(10 * X + 1); check(10 * X + 2);
    end;
  end;
end;

begin
  write('n = '); readln(n);
  check(0);
  writeln(min);
end.

(если убрать махинации с min - то будут напечатаны ВСЕ числа в интервале 1 .. MaxLongInt, делящиеся на 2n)