Решите задачи на ТурбоПаскале (Save the Jeff)

[Jeff]

У нас информатика с 10го класса. Программирования на турбопаскале Учитель впринципе никакой... Всё что мы проходили - это написать формулу вычисления площади/периметра треугольника и т.п. И ещё что-то эта дура толкала про массивы, но никто ничего не понял...

И вот теперь в 11м снова та же самая фигня началась...причём, эта дура считает, что мы с прошлого года что-то запомнили, т.к. она нам "всё прекрасно объснила" (это её слова) и теперь мы пол года будем просто задачи решать....без какой либо теории...

Я сюда буду подкидывать по 2-3 задачи раз в 3 недели примерно...
Кому не лень - решите пожалуйста. Они поидее не такие уж и сложные...

Понеслась....

Задача№ 1:
Написать программу, которая генерирует три последовательности из десяти случайных чисел в диапазоне от 1 до 10, выводит каждую последовательность на экран и вычисляет среднее арифметическое каждой последовательности.

Задача№ 2:
Написать программу приближённого вычисления интеграла методом трапеций. После каждого цикла программа должна выводить вычисленное значение, количество и величину интервалов. (Самое "весёлое" здесь то, что тему Интегралы мы по математике ещё не проходили)

Задача№ 3:
Написать программу, которая вычисляет наибольший общий делитель двух целых чисел.


Вот собссно и всё...Если дело сдвинется с мёртвой точки, то через 3 недели ещё задач подкину...

[is_absent]

ну это нескольно не веб программирование
по первой задаче:

var
  a: array [1..10] of real;
  i, j: integer;
  sum: real;
begin
  for i:= i to 3 do
  begin
    sum:= 0;
    WriteLn('Последовательность №', i);
    for j:= 1 to 10 do
    begin
      a[j]:= Random;
      Write(a[j]:4:4, '':2);
      sum:= sum + a[j];
    end;
    sum:= sum / 10
    WriteLn();
    WriteLn('Среднее арифмитическое:', sum:4:4);
  end;
end;

должно работать. не проверял

Вторую поищу, где-то была решенная на паскале постучись в аську или на мыло. договоримся
вот алгоритм для НОДа (так называемый Бинарный Алгоритм Евклида):

  m:= a; n:=b; d:=1;
  {НОД(a,b) = d * НОД(m,n)}
  while not ((m=0) or (n=0)) do begin
    if (m mod 2 = 0) and (n mod 2 = 0) then begin
      d:= d*2; m:= m div 2; n:= n div 2;
    end else if (m mod 2 = 0) and (n mod 2 = 1) then begin
      m:= m div 2;
    end else if (m mod 2 = 1) and (n mod 2 = 0) then begin
      n:= n div 2;
    end else if (m mod 2=1) and (n mod 2=1) and (m>=n)then begin
      m:= m-n;
    end else if (m mod 2=1) and (n mod 2=1) and (m<=n)then begin
      n:= n-m;
    end;
  end;
  {m=0 => ответ=d*n; n=0 =>  ответ=d*m}

взят с http://algolist.manual.ru/maths/teornum/nod.php

[albo]

Вторая задача (алгоритм был откуда-то спёрт )

function Func(const x: Real): Real;
 begin
  Func:=x+2;
 end;

function Min(const v1, v2: Real): Real;
 begin
  if (v2>v1) then Min:=v1 else Min:=v2;
 end;

function Integrate(const a, b, eps: Real): Real;
var
 x1, x2, Result: Real;
 i, Count: Longint;
 begin
  Result:=0;
  Count:=Round(Abs(b-a)/eps);
  for i:=1 to Count do
   begin
    Result:=Result + (Abs(b-a) + Abs(Min(Func(a+Count*eps), Func(a+Count*eps+eps))))*eps;
   end;
  Integrate:=Result;
 end;

var
 a, b, eps: Real;
begin
 Write('Введите начальное значение x: ');
 Readln(a);
 Write('Введите конечное значение x: ');
 Readln(b);
 Write('Введите точность: ');
 Readln(eps);
 Writeln('Результат: ', Integrate(a, b, eps));
end.

[Ghost]

Вообще говоря НОД вычисляется проще:

{ a, b - входные данные, целые положительные числа }
{ nod - результат }
while a <> b do
  if a > b then a := a - b else b := b - a;
nod := a; { или nod := b; }

Добавлено через 2 минуты:
З.Ы. В первой программе не забудь в начале вставить вызов процедуры Randomize.

[is_absent]

Ghost
Согласен. Алгоритм проще, но он сходится дольше.

[Jeff]

Jeff:
Задача№ 2:
Написать программу приближённого вычисления интеграла методом трапеций. После каждого цикла программа должна выводить вычисленное значение, количество и величину интервалов.

Училка сказала, что в решении задачи должен обязательно использоваться цикл repeat

У кого какие соображения на этот счёт?

[is_absent]

Училка сказала, что в решении задачи должен обязательно использоваться цикл repeat

repeat
...
until abs(b - a) < eps

вместо

Count:=Round(Abs(b-a)/eps);
  for i:=1 to Count do
   begin
    Result:=Result + (Abs(b-a) + Abs(Min(Func(a+Count*eps), Func(a+Count*eps+eps))))*eps;
   end;

Вроде так

[Jeff]

@_is_absent:
code:Count:=Round(Abs(b-a)/eps);
for i:=1 to Count do
begin
Result:=Result + (Abs(b-a) + Abs(Min(Func(a+Count*eps), Func(a+Count*eps+eps))))*eps;
end;

А нельзя чтоб там слово "repeat" присутствовало?
А то фиг её знает....может и не понять

[is_absent]

Jeff
Прочитай внимательней :-)
Result:=Result + (Abs(b-a) + Abs(Min(Func(a+Count*eps), Func(a+Count*eps+eps))))*eps;
нужно вставить вместо многоточия в моем примере

Count:=Round(Abs(b-a)/eps);
repeat
  Result:=Result + (Abs(b-a) + Abs(Min(Func(a+Count*eps), Func(a+Count*eps+eps))))*eps;
until i > Count

но это полный аналог примера

[Jeff]

@_is_absent
а...блин....тормоз

[albo]

Не забываем перед циклом сделать i:=1;
а в цикле Inc(i);

[is_absent]

albo
точно. забыл. каюсь

[Jeff]

Блин...кароч я окончательно запутался
я файл прицепил - гляньте пжалуста - чё у меня там не то

[Ghost]

inc(i) нужно вставлять внутрь цикла repeat...until, а не после него.

Добавлено через 2 минуты:
Непонятно еуда вставлен integrate := result;
Вот, что надо было:

uses
  crt;

function Func (const x: real): real;
begin
  func := x + 2;
end;

function min (const v1, v2: real): real;
begin
  if (v2 > v1) then min := v1 else min := v2;
end;

function integrate (const a, b, eps: real): real;
var
  x1, x2, result: real;
  i, count:       longint;
begin
  result := 0;
  i := 1;
  count := round (abs(b - a) / eps);
  repeat
    result := result + (abs(b - a) +
      abs(min(func(a + count * eps),
      func(a + count * eps + eps)))) * eps;
    inc (i);
  until i > Count;
  integrate := result;
end;

var
  a, b, eps: real;

begin
  write('Vvedite nachalnoe znachenie x: ');
  readln(a);
  write('Vvedite konechnoe znachenie x: ');
  readln(b);
  write('Vvedite tochnost: ');
  readln(eps);
  writeln('Rezultat: ', integrate(a, b, eps));
end.

Добавлено через 12 минут:
Вот, что получилось у меня:

uses
  crt;

type
  integr_func = function (x: real): real;

function f(x: real): real; far;
begin
  f := x * x;
end;

procedure integrate (f: integr_func; a, b, e: real; var r: real);
var
  s, s0, h: real;
  n, i: integer;
begin
  n := 10;
  s := 0;
  repeat
    s0 := s; s := 0;
    h := (b - a) / n;
    for i := 0 to pred(n) do
      s := s + (f(a + h * i) + f(a + h * succ(i))) * h * 0.5;
    writeln ('   n = ', n:6, ', result = ', s:10:6);
    n := n * 2;
  until abs(s - s0) <= e;
  r := s;
end;

var
  a, b, e, r: real;

begin
  clrscr;
  write ('enter a: '); readln (a);
  write ('enter b: '); readln (b);
  write ('enter e: '); readln (e);
  writeln ('calculate...');
  integrate (f, a, b, e, r);
  writeln ('result = ', r:10:6);
  readkey;
end.

[is_absent]

Ghost
второй вариант, imho, правильнее... :-)

[Jeff]

Вот вам ещё:

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

[is_absent]

Jeff
begin
{формируем массив}
sum:= 0;
for i:= 1 to N do
tr:=tr + a[i,i];
end;

вроде так.. N - размерность матрицы, tr -- след матрицы (сумма диагональных элементов) a --матрица

[Jeff]

@_is_absent
пардон, за тупость, но можно немного поподробнее?....я только примерно представляю, что такое матрица

[is_absent]

Jeff
квадратная матрица это тоже самое, что и двумерный массив.
определяется он вроде вот так: var a: array [1..10] of array of [1..10] integer;

[Jeff]

@_is_absent
попробую понять