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

Страница 1 из 2

Показывать 40 сообщений этой темы на одной странице

IMHO.WS (http://www.imho.ws/index.php)

- Программирование (http://www.imho.ws/forumdisplay.php?f=40)

- - Решите задачи на ТурбоПаскале (Save the Jeff) (http://www.imho.ws/showthread.php?t=51712)

Jeff	19.02.2004 20:24

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

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

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

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

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

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

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

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

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

is_absent

20.02.2004 10:14

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

Код:

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	20.02.2004 10:54

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

Код:

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

24.02.2004 11:30

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

Код:

{ 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

24.02.2004 13:36

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

Jeff	03.03.2004 22:49

Цитата:

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

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

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

is_absent

04.03.2004 05:45

Цитата:

Училка сказала, что в решении задачи должен обязательно использоваться цикл 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	04.03.2004 09:54

Цитата:

@_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" присутствовало? :rolleyes:
А то фиг её знает....может и не понять :blin:

is_absent

04.03.2004 10:04

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	04.03.2004 10:08

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

albo	04.03.2004 14:59

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

is_absent

04.03.2004 15:04

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

Jeff	09.03.2004 11:16

Вложений: 1

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

Ghost

09.03.2004 11:49

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

09.03.2004 16:07

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

Jeff	08.04.2004 21:09

Вот вам ещё:

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

:)

is_absent

09.04.2004 07:13

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

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

Jeff	09.04.2004 11:11

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

is_absent

09.04.2004 11:14

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

Jeff	09.04.2004 11:40

@_is_absent
попробую понять :rolleyes:;)

V@nya

09.04.2004 12:11

Jeff, давай ещё задачки, я тоже хочу порешать, а то у нас в 9 и 10 классах програмирование было (бейсик и паскаль), а сейчас (11кл), пришла новая учёлка, которая ничего не знает, ну и программирования у нас сейчас нет, а жалко. Вот хочу порешать задачки хоть тут, раз в школе не получается.

Jeff	09.04.2004 12:14

V@nya
можешь полностью написать решение предыдущей задачи + ещё одну, только с матрицей третьего порядка ;)

Ghost

09.04.2004 12:54

Код:

uses

  crt;



const

  n = 4;



var

  a: array [1..n, 1..n] of integer;

  i, j, s: integer;



begin

  clrscr;

  randomize;

  writeln ('start array:');

  for i := 1 to n do begin

    for j := 1 to n do begin

      a[i, j] := random (50);

      write (a[i, j] : 4);

    end;

    writeln;

  end;

  s := 0;

  for i := 1 to n do inc (s, a[i, i]);

  writeln('summ = ', s);

  readkey;

end.

V@nya

09.04.2004 13:12

пред. задача:
uses
crt;
var
a:array[0..9,0..9] of integer;
i,j,k,t:integer;
begin
clrscr;
randomize;
for i:=0 to 9 do begin
for j:=0 to 9 do begin
a[i,j]:=random(10);
{write(a[i][j]); - для вывода массива на экран}
end;
{writeln; - для вывода массива на экран}
end;

for i:=0 to 9 do
t:=t+a[i,i];
writeln(t);
readln;
end.

с трехмерным массивом (если это матрица третьего порядка) :

uses
crt;
var
a:array[0..9,0..9,0..9] of integer;
i,j,k,t:integer;
begin
clrscr;
randomize;
for i:=0 to 9 do
for j:=0 to 9 do
for k:=0 to 9 do
a[i,j,k]:=random(10);

for i:=0 to 9 do
t:=t+a[i,i,i];
writeln(t);
readln;
end.

Давно на паскале ничего не писал.

Добавлено через 5 минут:
Покя я тут печатал ответ, Ghost упел тоже напечатать решение пред. задачи.
P.S. То что заключено в {} можешь не печатать.

Добавлено через 3 минуты:
Жду ещё задачек поинтереснее. Мож чё ещё на с++ написать?

Jeff	09.04.2004 13:34

Ghost
V@nya
спасибо...вроде как работает :)

P.S:
V@nya
не...у нас только турбопаскаль

V@nya

10.04.2004 12:51

Jeff, ещё задачки будут?

is_absent

10.04.2004 13:11

Ghost
так. небольшое замечание... inc работает только с целыми числами... может всетаки += (в смысле s:= s+ a[i,i])?

Jeff	10.04.2004 19:54

V@nya
через недельку-другую будут обязательно :)

Ghost

12.04.2004 10:51

@_is_absent

Цитата:

так. небольшое замечание... inc работает только с целыми числами... может всетаки += (в смысле s:= s+ a[i,i])?

:) А где у меня в проге не целые числа. Но в принципе можно и так, как ты сказал - будет даже лучше - программа не будет зависеть от типа даннах массива.

Jeff
Ждем-с. Я сам вообще-то препод по информатике в вузе - хочется вспомнить старое... ;)

is_absent

12.04.2004 17:28

Ghost
слушай. не в тему немножко. Когда сам был на первом курсе, мне предложили написать программу автоматического расставления "горячих клавиш".
в общем-то не сложная программа..
есть список строк (допустим только на русском языке, но это не важно)
нужно сопоставить с каждой строкой буковку из этой строки, так чтобы буковки не повторялись. либо сказать, что это сделать невозможно.

Ghost

12.04.2004 18:10

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

Код:

uses

  crt;



const

  n = 5;

  words: array [1..n] of string =

    ('copy', 'paste', 'clear', 'cut', 'undo');



procedure hk (s: string; k: integer); far;

var

  i: integer;

  c: char;

begin

  if k > 5 then begin

    writeln ('variant:');

    for i := 1 to n do

      writeln (words[i]:10, ' : ', s[i]);

  end else begin

    for i := 1 to length(words[k]) do begin

      c := words[k, i];

      if (pos(c, s) = 0) and (pos(c, words[k]) = i)

        then hk (s + c, succ(k));

    end;

  end;

end;

begin

  clrscr;

  writeln ('result:');

  hk ('', 1);

  writeln ('- end -');

  readkey;

end.

is_absent

12.04.2004 18:46

Ghost
Красиво. (я не так делал) :)
У меня без рекурсии было... или это не считается рекурсией?

У меня был перебор с возвратом... Это к тому, что может быть такая комбинация строк, при которой важна последователь в которой ты назначаешь "горячие клавиши". Даже где-то был пример, в котором только в одном единственном порядке удавалось найти эти буквочки :)

А вообще -- красиво. :)

mkasoyan

14.04.2004 17:38

ne znau v temu ili net no pro turbo pascal nashel tolko tut.
mojet gde to est ssilka na samu progu "turbo pascal windows"?
a to ochen nujno.(nasha uchilka sama priznalas chto programirovanie ne znaet??!!??!!)
tak chto vikarabkivatsa na ekzamene pridetsa nam samim.
a progi netu chtobi doma grizt granit nauki.
zaranee blagodaru.

Ghost

14.04.2004 18:00

mkasoyan - Смотри ПМ.

V@nya

15.04.2004 10:09

mkasoyan

Цитата:

"turbo pascal windows"

Ну turbo pascal для windows вету, есть Borland poscal 7, в нём есть версия под windows 3.11, а под современные windows'ы токо delphi, для школы достаточно и tp под дос, а если у тебя xp, тр придётся юзать bp 7 под win 3.11, т.к. дос версия под xp глючит.

V@nya

20.04.2004 12:59

Jeff

Цитата:

через недельку-другую будут обязательно

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

Кто знает где в сети можно найти подробное описание комбинаторных алгоритмов и решения олимпиадных задач (про рюкзак там и т.д.). Именно алгоритмы с описанием почему и как работает, а не голый код.

Jeff	28.04.2004 23:07

Ну кто там задачки хотел? ;)
Нумба 1:
Написать функцию Procent, которая возвращает процент от числа, полученного в качестве аргумента

Нумба 2:
Написать процедуру, кторая выводить строчку, состоящую из одинаковых символов. Длина строки и символы являются параметрами процедуры

Честно говоря я даже понятия не имею о чём тут идёт речь, так что, пожалуйста, не надо меня ни о чём спрашивать gigi

is_absent

29.04.2004 04:41

1.
function Procent(N: Integer, Proc: Integer): Real;
begin
Procent:= N/100*Proc;
end;
Если нужно возвращять один процент, то Proc не нужен :)

2.
procedure StringRepeat(Rep: String; Count: Word);
var i: word;
begin
for i:= 1 to Count do
Write(Rep);
end;

Ghost

29.04.2004 11:01

is_absent
Не ошибка, просто замечание: может не "Rep: String;", "Rep: Char;"? ;)

Jeff	29.04.2004 11:19

is_absent
а первую как нибудь не через функцию можно решить?...а то она опять доменя докопается, что функцию мы нне проходили...

Часовой пояс GMT +4, время: 22:46.

Страница 1 из 2

Показывать 40 сообщений этой темы на одной странице