while1-14

Решение задач. День двенадцатый. Задачи While1-14

Приветствуем читателей learnpascal.ru!  Продолжаем наш марафон по решению задач. На очереди задачи while1-14.

Чтобы решить все нижеприведенные задачи, вам надо знать материал трех уроков: div, mod, функции; логические выражения; циклы.

 While1°. Даны положительные числа A и B (A > B). На отрезке длины A размещено максимально возможное количество отрезков длины B (без наложений). Не используя операции умножения и деления, найти длину незанятой части отрезка A.

Умножение — это некоторое количество сложений.

Program while_1;

var
  A, B: integer;

begin
  readln(A,B);
  while (A - B) >=  0 do A := A - B; // пока А - В  > 0, отнимаем В.
  write(A);
end.

While2. Даны положительные числа A и B (A > B). На отрезке длины A размещено максимально возможное количество отрезков длины B (без наложений). Не используя операции умножения и деления, найти количество отрезков B, размещенных на отрезке A.

Добавляем счетчик в предыдущую задачу.

Program while_2;

var
  A, B, count: integer;

begin
  readln(A, B);
  while (A - B) >=  0 do 
  begin
    A := A - B; 
    count := count + 1; // счетчик
  end;
  write(count);
end.

While3. Даны целые положительные числа N и K. Используя только операции сложения и вычитания, найти частное от деления нацело N на K, а также остаток от этого деления.

program while_3;

var
  N, K, count: integer;

begin
  readln(N, K);
  while (N - K >= 0) do
  begin
    N := N - K;
    count := count + 1;
  end;
  writeln('Частное от деления нацело: ', count);
  writeln('Остаток: ', N);
end.

While4°. Дано целое число N (> 0). Если оно является степенью числа 3, то вывести True, если не является — вывести False.

Число будет степенью числа,  если деля заданное число нацело на 3, получится N = 1.

Program while_4;
var
  N: integer;

begin
  readln(N);
  while N mod 3 = 0 do N := N div 3; // пока остаток от деления на 3 равен нулю, делим на 3.
  writeln(N = 1); // Выведет True или False
end.

While5. Дано целое число N (> 0), являющееся некоторой степенью числа 2:  N = 2K. Найти целое число K — показатель этой степени.

Используем метод из предыдущей задачи.

Program while_5;

var 
  n, k: integer;

begin
  write('Введите целое число: ');
  readln(n);
  k := 1;
  while n div 2 <> 1 do // в этой задачи, мы знаем, что N станет равным 1.
  begin 
    n := n div 2;
    inc (k)
  end;
  writeln('Показатель степени: ',k);
  end.

While6. Дано целое число N (> 0). Найти двойной факториал N:  N!! = N·(N–2)·(N–4)·…  (последний сомножитель равен 2, если N — четное, и 1, если N — нечетное). Чтобы избежать целочисленного переполнения, вычислять это произведение с помощью вещественной переменной и вывести его как вещественное число.

Program while_6;
var
  n: integer;
  anva, factorial: real;
begin
  write('Введите целое число: ');
  readln(n);
  factorial := n;
  anva := n;
  if (n <> 1) and (n <> 2) then 
      if odd(n) then // проверяем четность и нечетность. odd возвращает правду, если нечетно
        while anva <> 1 do //  пока неравно 1, выполняем цикл подсчета факториала 
          begin
            anva := anva - 2;
            factorial := factorial * anva;
          end
      else while anva <> 2 do // пока неравно 2, выполняем цикл
          begin
            anva := anva - 2;
            factorial := factorial * anva;
          end;
    writeln('Двойной факториал числа: ',factorial);
end.

While7°. Дано целое число N (> 0). Найти наименьшее целое положительное число K, квадрат которого превосходит N:  K2 > N. Функцию извлечения квадратного корня не использовать.

Program while_7;
var
  n,k: integer;
begin
  write('Введите число: ');
  readln(n);
  k := 1;
  while sqr(k) <= n do
    inc(k); // увеличиваем k на один, пока квадрат к, не превзойдет n. 
  writeln(k);
end.

While8. Дано целое число N (> 0). Найти наибольшее целое число K, квадрат которого не превосходит N: K2 ≤ N. Функцию извлечения квадратного корня не использовать.

Program while_8;

var
  n, k: integer;

begin
  write('Введите число: ');
  readln(n);
  while sqr(k) <= n do 
    inc(k); //используем цикл для нахождения наименьшего целого положительного числа K, квадрат которого превосходит N
  dec(k); //из найденного наименьшего числа вычитаем 1. полученное число наибольшое число, которое не превосходит квадрат числа. 
  writeln(k); 
end.

While9. Дано целое число N (> 1). Найти наименьшее целое число K, при котором выполняется неравенство 3K > N.

Аналагично while 7.

Program while_9;

var
  n, k: integer;

begin
  write('Введите число: ');
  readln(n);
  k := 1;
  while 3 * k <= n do 
    inc(k);  
  writeln(k); 
end.

While10. Дано целое число N (> 1). Найти наибольшее целое число K, при котором выполняется неравенство 3K < N.

Program while_10;

var
  n, k: integer;

begin
  write('Введите число: ');
  readln(n);
  k := 1;
  while 3 * k < n do 
    inc(k); //действуем по схеме, описанной ранее в задаче while_8
  dec(k);
  writeln(k); 
end.

While11°.  Дано целое число N (> 1). Вывести наименьшее из целых чисел K, для которых сумма 1 + 2 + … + K будет больше или равна N, и саму эту сумму.

Действуем аналогично предыдущим задачам.

Program while_11;

var
   n, k, summ: integer;

begin
     write('Введите число: ');
     readln(n);
     k := 1;
     summ := 1;
     while summ < n do
           begin
              inc(k); // увеличиваем к
              summ := summ + k; // прибавляем его к сумме
           end;  
     writeln('Число: ', k);
     writeln('Сумма: ', summ);
end.

While12°. Дано целое число N (> 1). Вывести наибольшее из целых чисел K, для которых сумма 1 + 2 + … + K будет меньше или равна N, и саму эту сумму.

Program while_12;

var
   n, k, summ: integer;

begin
     write('Введите число: ');
     readln(n);
     k := 1;
     summ := 1;
     while summ <= n do // после окончания цикла значение summ > n.
           begin
              inc(k);
              summ := summ + k;
           end;
     summ := summ - k; // Возвращаем предыдущие значение
     dec(k); // Возвращаем предыдущие значения
     writeln('Число: ', k);
     writeln('Сумма: ', summ);
end.

While13. Дано число A (> 1). Вывести наименьшее из целых чисел K, для которых сумма 1 + 1/2 + … + 1/K будет больше A, и саму эту сумму.

Такая же как while11.

Program while_13;

var
   summ: real;
   A, k: integer;

begin
     write('Введите число: ');
     readln(A);
     k := 1;
     summ := 1;
     while summ <= A do
           begin
              inc(k);
              summ := summ + 1 / k;
           end;
     writeln('Число: ', (1 / k):2:10);
     writeln('Сумма: ', summ:2:10);
end.

While14. Дано число A (> 1). Вывести наибольшее из целых чисел K, для которых сумма 1 + 1/2 + … + 1/K будет меньше A, и саму эту сумму.

Такая же как while12.

program while_14;

var
  summ: real;
  A, k, min_k: integer;

begin
  write('Введите число: ');
  readln(A);
  k := 1;
  summ := 1;
  while summ <= A do
  begin
    min_k := k;
    inc(k);
    summ := summ + 1 / k;
  end;
  summ := summ - 1 / k;
  writeln('Число: ', (1 / min_k):2:10);
  writeln('Сумма: ', summ:2:10);
end.

На сегодня все! Если у вас возникли вопросы, не стесняйтесь, задавайте их в комментариях. И не забывайте кликать по кнопочкам.

  • Дмитрий

    6 номер можно попроще сделать, слишком уж замудрено)

  • Акобир

    В задаче while6 строчка if (n 1) and (n 2) then лишнняя

  • Александра

    writeln(N = 1); // Выведет True или False — поясните пожалуйста эту строку в задаче 4
    как выводит true or false?

    • Ну, например, число 9.
      9 / 3 = 3
      3 / 3 = 1
      n = 1.
      А если
      10 / 3 = 3(1)
      n = 10.
      То есть N = 1, если число делится на 3 постоянно и без остатков — то есть является его степенью.

  • forgo77en

    В while13 нужно поменять местами, так как расчет будет неправильный

    inc(k);
    summ := summ + 1 / k;

    • alen_marzz

      Да нет, все правильно. Начальное значение summ = 1. Если поменять строки местами, то уже после второй итерации сумма будет равняться 1+1/1, что абсолютно неверно

  • Владимир

    Мой вариант 6-ой задачи:

    var
    a, n, i: word;
    begin
    read(n);
    if N=0 then a:=1 else begin // по определению 0!!=1
    a := n;
    while i < (n — 2) do
    begin
    i := i + 2;
    a := a * (n — i);
    end;
    end;
    write(a);
    end.

  • Владимир

    13-я задача:

    var
    i: integer;
    k,a:real;

    begin
    read(a);
    i:=1;
    while a > k do begin k:=k+(1/i); i+=1; end;
    writeln(i-1);
    write(k:7:5);
    end.

  • igor

    Помогите решить. Дано число n не меньше 1,определить сумму k чисел,так чтобы сумма не превышала значение n

  • Владимир Безух

    Программы к заданию 13 и 14 не работают.

    Переменной A необходимо присвоить тип Real, чтобы можно было использовать не только целые числа.
    Так или иначе, обе программы выдают верным ответом только сумму. Число же совершенно неверно.

    Вот мой простой и лаконичный пример 14 задания:

    Var
    K: Integer;
    Summ, A: Real;

    Begin
    WriteLn (‘Введите число’);
    ReadLn (A);
    While Summ < A do
    Begin
    Inc (K);
    Summ := Summ + (1 / K);
    End;
    Summ := Summ — (1 / K);
    Dec(K);
    WriteLn (K,' ', Summ);
    End.

    Будьте внимательны.