Задачи на While и Repeat. Опции

[kolydos]

Привет, я полистал ваш форум и понял, что мне тут могут могут оказать качественную помощь. Если не сложно напишите пожалуйста решения следующих задач:

1. напишите программу, которая определяет максимальное число из последовательности положительных чисел. признак окончания ввода ноль.
2. Напишите программу, которая вычисляет среднее арифмитическое последовательности положительных чисел, которые вводятся с клавиатуры. Для окончания ввода использовать ноль.
3. сколько слогаемых войдет в сумму пока она не привысит заданного А?
S=1+1/2+1/3+...
4. Сколько слогаемых войдет в сумму, прежде чем она привысит А?
S=2/1+3/2+4/3+5/4...
5. Дано целое m. получить наибольшее целое к, при котором три в степени к будет строго больше m.
6. Среди чисел вида:0,25; 0,25*1,25; 0,25*1,25*2,25;... найти первое! число большее заданного А.

Просьба особо не мудрить, это для первого курса и заранее огромное спасибо

[volvo]

я полистал ваш форум и понял, что мне тут могут могут оказать качественную помощь...
Просьба особо не мудрить

У меня тоже просьба: в следующий раз не "листать" форум, а пользоваться поиском - по крайней мере 90% этих задач уже решались на форуме...

[klem4]

1)

Код

uses crt;
var x:array[1..100] of integer;
   i,j:integer;
   nfind:integer;
   flag:boolean;

Begin
  clrscr;
  flag:=true;
  while not(x[j]=0) do
   begin
      inc(j);
      readln(x[j]);
   end;
  i:=1;
  nfind:=0;
  while (i<=j)or(nfind=0) do
   begin
      if x[i]>0 then
       begin
          if nfind=0 then nfind:=i;
          if x[i]>x[nfind] then
           nfind:=i
       end;
      inc(i);
  end;
  writeln;
  writeln('max=',x[nfind]);
readln;
end.

2)

Код

uses crt;
var x:array[1..100] of integer;
  i,j,s,sr:integer;
  nfind:integer;
  flag:boolean;

Begin
 clrscr;
 flag:=true;
 while not(x[j]=0) do
  begin
     inc(j);
     readln(x[j]);
  end;
 for i:=1 to j-1 do
  inc(s,x[i]);

 writeln;
 writeln('sr=',s/(j-1):2:3);
readln;
end.

3)

Код

uses crt;
var k,n:integer;
  s,a:extended;
Begin
 clrscr;
 s:=0;
 k:=0;
 n:=0;
 readln(a);
 while not(s>a) do
  begin
     inc(n);
     inc(k);
     s:=s+1/k;
  end;
  writeln;
  writeln('n=',n);
  readln;
end.

4)

Код

uses crt;
var k,n:integer;
  s,a:extended;
Begin
 clrscr;
 s:=0;
 k:=0;
 n:=2;
 readln(a);
 while not(s>a) do
  begin
     inc(k);
     s:=s+n/(n-1);
     inc(n);
  end;
  writeln;
  writeln('k=',k);
  readln;
end.

5)

Код

uses crt;
var m,k:integer;
begin
 clrscr;
 readln(m);
 k:=0;
 while not(exp(k*ln(3))>m) do
  inc(k);
 writeln('k=',k);
 readln;
end.

6)

Код

uses crt;
const n=0.25;
var a,p:extended;
   k:integer;

Begin
  clrscr;
  readln(a);
  k:=0;
  p:=n;

  while not(p>a) do
   begin
      inc(k);
      p:=p*(k+n);
   end;
  writeln;
  writeln('First=',p:2:3);
  readln;
end.

Сообщение отредактировано: klem4 - 21.01.2005 15:02

[volvo]

klem4
Вопрос: в решении первой программы зачем массив? Написано только про последовательность, но хранить-то ее не надо...
Тогда делаем проще (Задача №1):

Код

uses crt;
var
 max, x: integer;
Begin
 clrscr;
 max := 0;
 repeat
   readln(x);
   if x <> 0 then
     if x > max then max := x
 until x = 0;
 writeln('max = ',max);
 readln;
end.

Сообщение отредактировано: volvo - 21.01.2005 14:26