Mail

В этот день много лет назад...
24 апреля. В 1952 году (72 года назад) - В Онтарио впервые по нефтепроводу поступает нефть из провинции Альберта (Канада).

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

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

Модератор.

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

Страница 12

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

В матрице А(4,8) определить с помощью функции разность между максимальным и минимальным элементом каждой строки и записать в дополнительный столбец в основной программе. Предусмотреть вывод начального массива и массива после дозаписи.

Решение

program lab4zad4;
   Uses
       Crt;
    const n=4;n1=8;
     type mas=array[1..n,1..n1+1] of integer;
      var a:mas; i,j,r:integer;
      resul:integer;
{------------------------------------------------------------------}
function razt(var x:mas;n,n1:integer):integer;
      var max, min, raz:integer;
      begin
      randomize;
      writeln('Исходный массив'); writeln;
   for i:=1 to n do
      begin
         for j:=1 to n1 do
            begin
               a[i,j]:=random(25)-10;
               write(a[i,j]:3);
            end;
         writeln;
      end;
writeln('Разность max и min строк');
   for i:=1 to n do
    begin
     max:= a[i,1]; min:=a[i,1];
     for j:=1 to n1 do
      begin
       if max<a[i,j] then max:=a[i,j];
       if min>a[i,j] then
                  min:=a[i,j];
      end;
     write('  max=' , max,'  min=', min,'  ');
     raz:=max-min;
     write(raz);
     a[i,j+1]:=raz;
     writeln;
    end;
   writeln('Результат');
   for i:=1 to n do
    begin
     for j:=1 to n1+1 do
      begin
        write(a[i,j]:3);
      end;
         writeln
         end;
         end;
   Begin
ClrScr;
  r:= razt(a,n,n1);
       readln;
end.

{Форматированный модератором вариант }
program lab4zad4;
  Uses Crt;
  const n=4;n1=8;
  type mas=array[1..n,1..n1+1] of integer;
  var a:mas; i,j,r:integer;
  resul:integer;
{------------------------------------------------------------------}
function razt(var x:mas;n,n1:integer):integer;
var max, min, raz:integer;
  begin
  randomize;
  writeln('Исходный массив'); writeln;
  for i:=1 to n do
    begin
    for j:=1 to n1 do
      begin
      a[i,j]:=random(25)-10;
      write(a[i,j]:3);
      end;
    writeln;
    end;
  writeln('Разность max и min строк');
  for i:=1 to n do
    begin
    max:= a[i,1]; min:=a[i,1];
    for j:=1 to n1 do
      begin
      if max<a[i,j] then max:=a[i,j];
      if min>a[i,j] then
        min:=a[i,j];
      end;
    write('  max=' , max,'  min=', min,'  ');
    raz:=max-min;
    write(raz);
    a[i,j+1]:=raz;
    writeln;
    end;
  writeln('Результат');
  for i:=1 to n do
    begin
    for j:=1 to n1+1 do
      begin
        write(a[i,j]:3);
      end;
    writeln
    end;
  end;

Begin
ClrScr;
r:= razt(a,n,n1);
readln;
end.

Комментарии

1. Совершенно очевидно, что функция притянута тут за уши. То есть, очевидно, сначала была написана программа без функции, но в задании сказано использовать функцию, вот код из основного тела был оформлен в виде отдельного модуля. Я уже говорил и повторю еще раз: процедуры и функции предназначены для выполнения конкретных небольших задач, которые повторяются в данной программе или которые можно будет использовать в дальнейшем. Например, в данном примере отдельной задачей можно выделить нахождение максимального и минимального элемента строки матрицы. А если подумать, то нахождение максимума и минимума можно оформить практически одной функцией. Вывод массива тоже надо оформить в виде отдельного метода. В общем, программа будет иметь вид:

function getMaximum(a:mas; iStroki:integer):integer;
var j,max:integer;
  begin
  max := a[iStroki,1];
  for j:=1 to n1 do
    if (a[iStroki,j] > max)
      begin
      max := a[iStroki,j];
      end;
  getMaximum := max;
  end;
procedure changeSign(var a:mas;iStroki:integer);
var j:integer;
  begin
  for j:=1 to n1 do
      a[iStroki,j] := -a[iStroki,j];
  end;
function getMimimum(a:mas; iStroki:integer):integer;
  begin
  changeSign(a,iStroki);
  getMimimum := - getMaximum(a,iStroki);
  end;
procedure printArray(a:mas);
  begin
  for i:=1 to n do
    begin
    for j:=1 to n1 do
      write(a[i,j]:5);
    writeln;
    end
  end;
procedure initArray(var a:mas);
  begin
  for i:=1 to n do
    begin
    for j:=1 to n1 do
      a[i,j]:=random(25)-10;
    a[i,n1+1] := 0;
    end;
  end;
var m:mas;
    i:integer;
begin { main }
initArray(m);
writeln('Исходный массив');
printArray(m:mas);
for i:=1 to n do
  m[i,n+1] := getMaximum(m,i) - getMinimum(m,i);
writeln('Конечный массив');
printArray(m:mas);
end.

2. Тонкий момент. Непонятно, зачем функции передаются параметры. n и n1 все равно константы, а переданный массив вернется в основную программу нетронутым. То есть все печати пройдут нормально внутри функции, а вот если попробовать распечатать массив после обращения к функции, то он должен остаться неизменным. Действительно, массив а объявленный в основной программе передается в качестве фактического параметра в функцию. Формальным параметром в процедуре является массив х (описаный с модификатором var, что означает, что все изменения этого массива внутри функции будут переданы обратно в основную программу). Однако внутри функции используется массив a, который является в данном случае глобальной переменной. Но когда придет черед возвращаться в основную программу вместо массива а обратно будет передан массив х, нетронутый с начала выполнения функции.

to top

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

Создать файл из 5 чисел разного знака. Подсчитать сумму
положительных чисел. Дописать созданный файл этой суммой.

Решение
Автор: Валерий

program laba ;
uses crt;
type fail = file of integer;
var c:fail; x, k:integer;

procedure Vvod(var s:fail);
  begin
  assign(s,'c:\ono');
  writeln;
  writeln('введите 5 значений(+ и -)');
  rewrite(s);
  k:=0;
  repeat
    read(x);
    {append(s);}
    write(s,x);
    k:=k+1;
  until k=5;
  close(s);
end;
Function otr(var s:fail):integer;
var sum, x:integer;
  begin
  reset(s);
  sum:=0;
  while not eof(s) do
    begin
    read(s,x);
    if x>0 then sum:=sum+x;
    end;
  close(s);
  writeln;
  writeln('sum=',sum:8);
  otr:=sum;
  end;
procedure dop(var s:fail; k:integer);
var l:integer;
  begin
  reset(s);
  l:=filesize(s);
  writeln('в файле всего',l:3, 'компонентов');
  seek(s,l-1);
  write (s,k);
  close(s);
  end;
procedure viv(var s:fail);
var i:integer;
  begin
  assign(s,'c:\ono');
  reset(s);
  writeln('получили');
  for i:=1 to filesize(s) do
    begin
    read(s,x);
    write(x:4);
    end;
  close(s);
end;

begin
clrscr;
vvod(c);
viv(c);
k:=otr(c);
dop(c,k);
viv(c);
readkey;
end.

Комментарии

1. Нигде в задании не указано, что необходимо использовать процедуры. Я всегда "ЗА" использование процедур, но не такое механическое. Здесь линейная программа разделена на куски и каждый кусок оформлен процедурой. Это не есть то ради чего стоит затевать функции. Едиснтвенное ради чего это стоит делать - использовать написанный код где-нибудь в дальнейшем без какой либо модификации. Например, если бы процедуре Vvod были переданы в качестве параметров имя файла и число N (=5), то ее можно было бы использовать для занесения в произвольный файл произвольного количества значений.

2. Кстати, а вы программу тестировали? Мне просто стало интересно, я ее прогнал, и обнаружил, что она не дополняет файл, а заменяет последний элемент. В общем должно быть seek(s,l); вместо seek(s,l-1);

3. По хорошему, у файла должно быть расширение

to top

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

Сформировать множество А и В, базовый тип которых 0..50, по заданному числу элементов для каждого множества. Найти число и сумму элементов, принадлежащих одновеменно и А и В. Выведите на экран все элементы множества А Не пренадлежащие В.

Решение
Автор: Валерий

program ab;
uses crt;
type mn = set of 0..50; mas = array[1..50] of byte;
var a,b,c,d: mn; x, k,w,o,i,z,n: byte; l:integer;
procedure viv(y:mn);
begin
for k := 0 to 50 do
if k in y then write(k:3);
end;
{-----------------------------------------}
begin
randomize;
clrscr;
writeln('введите колличество элементов в множестве a');
readln(n);
Writeln('элементы множества a=->');
a:=[];
for i:=1 to n do
begin
x:= random(50);
a:= a+[x];
end;
viv(a);
writeln;
writeln('введите колличество элементов в множестве b');
readln(z);
Writeln('элементы множества b=->');
b:=[];
for i:= 1 to z do
begin
x:= random(50);
b:= b+[x];
end;
viv(b);
writeln;
writeln('элементы множества а не пренадлежащие множеству b');
C:= a-b;
viv(c);
writeln;
d:= a+b;
l:=0; i:=0;
for k := 0 to 50 do
begin
if k in d then
begin
l:=l+k;
inc(i)
end;
end;
writeln;
writeln('элементы принадлежащие множ. a и b=->');
viv(d);
writeln;
writeln('их кол-во =->');
writeln(i);
writeln('их сумма =->');
writeln(l);
readln;
end.

Комментарии

Все верно за исключением задания: Найти число и сумму элементов, принадлежащих одновеменно и А и В. Одновременно - это значит и тому и другому, то есть если А=[1,3,5,7], B=[2,3,7,11,15] то искомое множество будет [3,7]. Чтобы найти пересечение двух множеств:
d:=[];
for i:=0 to 50 do if ((i in A) and (i in B)) then
d:=d+[i];

to top

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

Дана строка в виде предложения, причем известно что слова отделены друг от друга пробелами. Предложение заканчивается точкой. Сформировать массив состоящий из слов исходного предложения. Вывести слова предложения колличесво букв в которых четно. Посчитать сколько слов начинается с буквы 'T'

Решение
Автор: Валерий

program stroki;
uses crt;
var i,j,m,n,s,s1,b:integer;
    F:array[1..10] of string [40];
    KK: set of char;
    A:string;
begin
clrscr;
writeln;
A:='Тихо треска апрель летучка лес туча шар . ';
m:= Length(a);
n:=1;
F[1]:='';
for i:=1 to m do
    if A[i]=' ' then
      begin
       inc(n);
       F[n]:=''
      end
      else
        F[n]:=F[n]+A[i];
Writeln('полученный массив');
for i:=1 to n-1 do
    write(F[i],' ');
    writeln;
textcolor(red);
writeln('слова кол-во букв кот. четно =->');
for i:=1 to n-1 do
if length(f[i]) mod 2=0 then
      write(F[i],' ');
textcolor(green);
writeln('слов на Т =->');
kk:=['т','Т'];
for i:=1 to n do begin
  if f[i,1] in kk  then
writeln(f[i]);
end;
  readkey;
end .

Комментарии

В целом все правильно. Правда опять-таки есть несколько недочетов.
1. Имена переменных, регистр букв в именах переменных - те же замечания
что и в предыдущих примерах. Старайтесь давать значимые имена переменным.
Старайтесь даже в Паскале (которому нет дела до регистра букв) не именовать
одинаковые переменные в разных регистрах: может так статься А и а в один
прекрасный день окажутся разными переменными.
2. В условии сказано, что предложение заканчивается точкой. Я так понимаю,
что это должно быть условием окончания занесения слов в массив. Программа
не распознает это условие, более того, в предложение искусственно занесены
два последних пробела.
3. В условии не оговорено, что нужно использовать строковые функции, но
почему бы не использовать их? Функция strPos, например, возвращает позицию
определенного символа в строке, Функция copy() - подстроку в строке,
delete - удаляет часть подстроки. Поскольку эти функции встроенные,
они заведомо будут работать быстрее (ну или не медленнее) любой подобной
написанной на Паскале. Поэтому перебор символов в строке - медленный и
неэффективный метод.
Чтобы не быть голословным приведу программу:

uses timeunit;
const Nloops = 10000;
var a,b:string;
    k,n:byte;
    F:array[1..20] of string[30];
    dh, dm, ds, dhund, iLoop :word;
    var m,i:integer;
begin
a:='Я помню чудное мгновенье, передо мной явилась ты, как мимолетное виденье, как гений чистой красоты.';
resetTimePoint;
for iLoop:=1 to Nloops do
  begin
  b:=a;
  k:=Pos(' ',b);
  n:=0;
  while (length(b)>0) and (k>0) do
    begin
    inc(n);
    F[n]:=copy(b,1,k-1);
    delete(b,1,k);
    k:=Pos(' ',b);
    end;
  inc(n);
  k:=Pos('.',b);
  if (k=0) then
    begin
    writeln('Ошибка. Предложение не заканчивается точкой.');
    halt(1);
    end;
  F[n]:=copy(b,1,k-1);
  end;
GetTimePoint(dh, dm, ds, dhund);
for k:=1 to n do
  writeln(' F[',k:2,']=',F[k]);
writeln('Затрачено: ',dh,' часов', dm,' минут ',  ds, ' секунд ', dhund, ' сотых секунд.');

resetTimePoint;
for iLoop:=1 to Nloops do
  begin
  m:= Length(a);
  n:=1;
  F[1]:='';
  for i:=1 to m do
      if A[i]=' ' then
        begin
         inc(n);
         F[n]:=''
        end
        else
          F[n]:=F[n]+A[i];
  end;
GetTimePoint(dh, dm, ds, dhund);
for k:=1 to n do
  writeln(' F[',k:2,']=',F[k]);
writeln('Затрачено: ',dh,' часов', dm,' минут ',  ds, ' секунд ', dhund, ' сотых секунд.');
end.

Здесь приведены два метода и они сравниваются по времени затраченному на
выполнение того и другого кода 10000 раз. Для подсчета времени используется
модуль timeunit, который можно взять здесь: http://delphid.dax.ru/www/timeunit.zip
У меня получилась следующая разница:
Мой медод -    Затрачено: 0 часов0 минут 0 секунд 88 сотых секунд.
Первый метод - Затрачено: 0 часов0 минут 1 секунд 48 сотых секунд.
То есть стандартными функциями получается почти в два раза быстрее.
4. Использование множеств в последней части правильно, но неоправдано (из пушек по воробьям). Ежели бы это были не кириллические, а латинские символы, то лучше было бы написать:
if (upCase(f[i,1])=='T') ...

to top

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

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