Mail

Уголок начинающего программиста

В данном разделе приводятся программы, написанные посетителями данного сайта. Идея данного раздела принадлежит Валерию из города Новотроицк Оренбургской области, который прислал мне письмо, в котором предложил публиковать его программы, мотивировав это тем, что на сайте не хватает простых, элементарных программ. А поскольку он все-равно будет "мучаться", то чтоб труд не пропадал зря, он предложил размещать его примеры на сайте. Мне эта идея понравилась и вот первая партия программ размещена в данном новом разделе. Я постараюсь снабжать программы комментариями, если что-то можно сделать в программах лучше. Я не обещаю проверять данные программы на работоспособность, компилируя их, но просматривать на предмет ошибок обязательно буду.

Модератор.

Задач в выбранных темах: 66

Страница 10

Условие задачи

Составьте программу вычисления значения функции y = f на отрезке [a,b] в точках Xi = a + i*h, где h = (b-a)/m, где m заданное целое число. Найти среднееарефметическое значение y на отрезке [a, b]. Y=tg(x/2)+cos(x), A=0, B=pi/2, m=20.

Решение

01: program tabff;
02: uses crt;
03: label opa;
04: var a,b,m:integer;
05:     i:byte;
06:     y,x,h,sr:real;
07: BEGIN
08: CLRSCR;
09: opa:writeln('введите числа соответсвующие промежутку функции ');
10: readln(a,b);
11: writeln('введите число m');
12: readln(m);
13: h:=((b-a)/m);
14: begin
15: if (a<b) and (h>0) then
16:          else begin writeln('введены ошибочные данные');
17:             goto opa ;
18:             end;
19:       end;
20: For i:=1 to trunc((b-a)/h) do
21: begin
22: x:=a+i*h;
23: y:=(sin(x/2))/(cos(x/2))+cos(x);
24: writeln('значение функции при x = ',x:4:3,' = ',y:4:3);
25: sr:=sr+y;
26: end;
27: if m<=2 then
28: writeln('Среднее арефметическое значение = ',sr/m:4:3)
29: else
30: writeln('Среднее арефметическое значение = ',sr/(m-1):4:3);
32: readln;
33: end.

Комментарии

1. Строки 9-19 я бы заменил на следующие (ну не люблю я метки):
в секции описания переменных:

var inputOK:boolean;
...
repeat
  writeln('введите числа [a,b] соответсвующие промежутку функции ');
  readln(a,b);
  writeln('введите целое число m');
  readln(m);
  inputOK := (b>a) and (m>0);
  if (not inputOK) then
     writeln('введены ошибочные данные. Надо b>a; m>0');
until inputOK;
h:=(b-a)/m;

2. Зачем вычислять trunc((b-a)/h), когда у нас есть m?
3. Граничные условия: при i=1, x=a+h, а должно быть a.
Посему строка 22: x := a + (i-1)*h; И соответсвенно, в 20-й строке:
for i:=1 to m+1 do
m+1 - чтобы захватить b, при i=m+1, x=a+(m+1-1)*(b-a)/m=b
4. Форматирование! Все внутренние блоки должны иметь отступ.
5. Среднее значение не зависит от m и определено для любого m>=1 одинаково. Поэтому я не понял, зачем нужны строки 27-30. Я бы написал:
writeln('Среднее арефметическое значение y на [',a,',',b,']  = ',sr/m:4:3);
6. Формат вывода :4:3 недостаточен для вывода вещественных переменных со знаком. Надо хотя бы :7:3
7. При х=Pi значение тангенса не определено. Надо проверять в 23 строке на равенство х=Pi. В случае равенства, выдвать сообщение, что произошло деление на ноль. Это всяко лучше, чем получить потом Runtime error 002 at 4fd2:00af и гадать, что же произошло. :-)
А потом написать единую процедуру подсчета оплаты, но это уже для дальнейших упражнений.

to top

Условие задачи

По введенной дате в формате ДД ММ ГГГГ определить день недели.

Решение
Автор: strike

uses crt;
var IsCorrectDate:boolean;
    d,m,y:integer;
procedure  INPUTDATE(var d,m,y:integer;var correctly: boolean);
begin
write('Input date in format DD MM YYYY: '); readln(d,m,y);
correctly:= (d>=1) and (d<=31) and (m>=1)
                   and (m<=12) and (y>=1582) and (y<=4903)
end;
procedure WRITEDAY(d,m,y: integer);
const
doweek:array [0..6] of string[11]=('sunday','monday','tuesday','wednesday','thursday','friday','saturday');
var c,w: integer;
begin
if m<3 then
  begin
  m:=m+10;
  y:=y-1;
  end
else
  m:=m-2;
c:=y div 100;
y:=y mod 100;
w:=abs(trunc(2.6*m-0.2)+d+y div 4+y+c div 4-2*c) mod 7;
writeln('DAY: ',doweek[w]);
end;
begin
clrscr;
repeat
INPUTDATE(d,m,y,IsCorrectDate);
if IsCorrectDate then
   WRITEDAY(d,m,y);
  until not IsCorrectDate
end.

Комментарии

Комментарий от автора: В проге есть свои заморочки, т.к. день определяется по невероятной формуле. Эту формулу придумал не я, но её работоспособность проверил на десятке тестов.
Модератор: Ну что тут сказать? Когда-то я тоже программировал эту формулу. Вполне возможно она верна, но никогда не доверяйте черным ящикам, если можно без них обойтись. :-) То есть я не исключаю, что есть даты, для которых она не работает и если, скажем, преподаватель такую дату знает, то... в общем понятно.
К слову сказать, я эту задачу решал и другим путем - зная конкретный день недели, например сегодня среда 14 января 2004 года я высчитывал количество дней до какой-либо даты и потом просто брал остаток от деления на 7. Надо сказать метод жутко заморочный учитывая все високосные года и переход (14 января (!), кстати, 1918 года) на новый календарь. Но тот метод работал и работал правильно и понятно как. Так что выбор за вами. :-)

to top

Условие задачи

Ввести число и четные цмфры этого числа уменьшить вдвое.

Решение
Автор: Moderator

var
  k,k0,m,power:longint;
  lastDight:byte;
function addWithShift(m:longint;n:byte):longint;
  begin
  addWithShift := m + n*power;
  end;
begin
write('Input number:');
readln(k0);
k:=k0;
m:=0;
power := 1;
while k>0 do
  begin
  lastDight := k mod 10;
  if ((lastDight mod 2) = 0)
    then m:=addWithShift(m,lastDight div 2)
    else m:=addWithShift(m,lastDight);
  k:=k div 10;
  power := power*10;
  end;
writeln('  New number:',m);
end.

Комментарии

to top

Условие задачи

получить и напечатать последовательность натуральных чисел, образованную по следующему правилу: каждое число в последовательности, начиная с третьего, получается сложением двух предыдущих чисел.(напр.1+2=3+2=5+3=8+5=13)

Решение
Автор: Moderator

var f0,f1,f2,max:longint;
begin
f0:=1;
f1:=1;
max:=300;
writeln('Fibonachi numbers below ',max,':');
write('1,1,');
while (f1<max) do
  begin
  f2:=f0+f1;
  f0:=f1;
  f1:=f2;
  write(f2,',');
  end;
writeln('...');
end.

Комментарии

to top

Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

Задач в выбранных темах: 66