ОП лекции 2017-18 гг. - решение домашних заданий

program task; begin var (x1, y1):= readreal2 ('введите координаты первой точки: '); var (x2, y2):= readreal2 ('введите координаты второй точки: '); var (x3, y3):= readreal2 ('введите координаты третьей точки: ');

//находим значения A, B, C для формирования общих уравнений прямых для каждой стороны

var (A12, A23, A31):= (y1-y2,y2-y3,y3-y1); var (B12, B23, B31):= (x2-x1,x3-x2,x1-x3); var (C12, C23, C31):= (x1y2-x2y1,x2y3-x3y2,x3y1-x1y3); var (x,y):=readreal2 ('введите координаты точки: '); //проверяем совпадение знака при подстановке третьей точки в уравнение прямой и даной точки //таким образом убеждаемся, что они лежат с однй стороны от данной прямой

if ( sign(a12x + b12y + c12) = sign(a12x3 + b12y3 +c12) ) and ( sign(a23x + b23y + c23) = sign(a23x1 + b23y1 +c23) ) and ( sign(a31x + b31y + c31) = sign(a31x2 + b31y2 +c31) ) then writeln (‘точка лежит внутри треугольника’) else writeln (‘точка не лежит внутри треугольника’); end.

{введите координаты первой точки: 34.5 11.8 введите координаты второй точки: 22.8 4 введите координаты третьей точки: 196.3 5 введите координаты точки: 120 -5 точка не лежит внутри треугольника}

{введите координаты первой точки: 3 3 введите координаты второй точки: 3 3 введите координаты третьей точки: 3 3 введите координаты точки: 3 3 точка лежит внутри треугольника}

Здравствуйте , при проверке значения функции Dist assert’ом выскакивает ошибка , но при этом значение функции является верным . Тоесть , если значение функции Dist равно 2 , то при проверке assert(Dist(…) = 2) программа падает. Прошу помочь исправить программу так , чтобы assert не ругался. Вот код :

main.pas
uses Geometry; begin assert(Dist(3, 3, 1, 1, 4, 1) = 2);
assert(Dist(1, 1, 0, 0, 2, 0) = 1 ); end.

Geometry.pas unit Geometry;

interface

///Вычисляет длину отрезка по координатам function Leng(xA, yA, xB, yB: real): real;

///Вычисляет периметр треугольника по заданым вершинам function Perim(xA, yA, xB, yB, xC, yC: real): real;

///Вычисляет площадь треугольника по формуле герона function Area(xA, yA, xB, yB, xC, yC: real): real;

///Вычисляет расстояние от точки до прямой function Dist(xP, yP, xA, yA, xB, yB: real): real;

implementation

function Leng(xA, yA, xB, yB: real) := sqrt((xA - xB) * (xA - xB) + (yA - yB) * (yA - yB));

function Perim(xA, yA, xB, yB, xC, yC: real) := Leng(xA, yA, xB, yB) + Leng(xA, yA, xC, yC) + Leng(xB, yB, xC, yC);

function Area(xA, yA, xB, yB, xC, yC: real): real; begin var p := Perim(xA, yA, xB, yB, xC, yC); var (a, b, c) := (Leng(xA, yA, xB, yB), Leng(xA, yA, xC, yC), Leng(xB, yB, xC, yC)); result := sqrt(p * (p - 2a) * (p - 2b) * (p - 2*c))/4; end;

function Dist(xP, yP, xA, yA, xB, yB: real): real; begin result := (2 * Area(xP, yP, xA, yA, xB, yB)) / Leng(xA, yA, xB, yB); end;

end.

Хочу заметить , что при ручной проверке writeln(Dist(…)); значения функции совпадает с требуемым значением для assert .

Это означает, что вещественные числа нельзя сравнивать на =

Вещественные числа нужно сравнивать не напрямую, а с учётом погрешности, которая неизбежно возникает из-за ограничений по памяти Я для assertов использовал такую функцию:

/// Сравнивает вещественные числа с точностью eps. True - числа равны
function equals(a, b: real; eps: real := 0.0000001 ) := abs(a - b) < eps;

Например

assert(equals(Dist(1, 1, 0, 0, 2, 0), 1), 'Dist(1, 1, 0, 0, 2, 0)');

Здравствуйте! В задании про сравнение быстродействия удаления элемента с помощью процедуры и срезов как можно измерить затраченную память? В отношении времени получается, что при достаточно большом размере массива срезы работают быстрее (но незначительно) Сравнение.pdf (289,8 КБ)

Думаю, никак напрямую нельзя

Задание про сравнение быстродействия двух алгоритмов по отысканию количества четных элементов в каждой строке. Оказывается, что решение этой задачи с помощью ArrGen при достаточно большом размере массива является неэффективным по времени. ArrGen занимает почти в два раза больше времени, чем обычный алгоритм с двумя вложенными циклами. Тем не менее, в пределах 100 х 100 разница не заметна и в силу компактности и понятности ArrGen лучше использовать все-такие его.Сравнение.pdf (134,1 КБ)

По ходу выполнения сравнения возник такой вопрос: каков наибольший размер двумерного массива, генерируемого с помощью MatrRandomInteger? Зависит ли он от n*m или от каждого параметра в отдельности?

Насчет сравнения быстродействия. Для матриц малых размеров, например 7 х 7, разница составляет 1-2 миллисекунды. Для решения c ArrGen среднее время 1-2 миллисекунды. Для решения с двумя вложенными циклами меньше миллисекунды.

Хотел тоже узнать одну вещь насчет максимального размера матриц. Методом проб выяснил, что максимальная квадратная матрица может быть размером 23170 х 23170. Если увеличить хотя бы один из размеров, выдает ошибку. От чего зависит максимальный размер матрицы?

1 лайк

Я тут тоже потестил, получается, что решение, с помощью DSL, работает в ~2.4 раза медленнее;

Код у меня такой:

function EvenInRows1(a: array[,]of integer): array of integer; begin   result := new Integer[a.RowCount];   for var i := 0 to a.RowCount - 1 do   begin     var c := 0;     for var j := 0 to a.ColCount - 1 do       if a[i, j].IsEven then         c += 1;     result[i] := c;   end;
end;

function EvenInRows2(a: array[,]of integer): array of integer; begin   result := ArrGen(a.RowCount, i -> a.Row(i).Count(x -> x.IsEven));
end;

begin   var a1 := 0;   var a2 := 0;   var a := MatrRandom(100, 100, 0, 1000);   Writeln(MillisecondsDelta);   for var i := 1 to 10000 do   EvenInRows1(a);   a1 := MillisecondsDelta;   for var i := 1 to 10000 do     EvenInRows2(a);   a2 := MillisecondsDelta;   Writeln(a2 / a1); end.

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

Я поправил первый код, заменив явный вызов функции указателем:

function Evens(a:array [,] of integer; pred: integer -> boolean): array of integer;
begin
  var EvenInRow := new Integer[a.RowCount];
  for var i := 0 to a.RowCount - 1 do
  begin
    var c := 0;
    for var j := 0 to a.ColCount - 1 do
    begin
      if pred(a[i, j]) then
        c += 1;
    end;
    EvenInRow[i] := c;
  end;
  Result := EvenInRow;
end;

begin
  var a := MatrRandomInteger(8000, 8000, 100, 900000);
  var d := Milliseconds;
  var EvenInRow := Evens(a,x -> x mod 2 = 0);
  writeln(MillisecondsDelta);
end.

Этот код у меня работает 0.56 с. А такой код

begin
  var a := MatrRandomInteger(8000, 8000, 100, 900000);
  Milliseconds;
  var EvenInRow := ArrGen(a.RowCount,i->a.Row(i).Count(x -> x mod 2 = 0));
  Print(MillisecondsDelta)
end.

работает у меня 0,97 с. Так что в 1.7 раза медленнее

А такой алгоритм

begin
  var a := MatrRandomInteger(8000, 8000, 100, 900000);
  Milliseconds;
  var EvenInRow := ArrGen(a.RowCount,i->a.Row(i).Where(x -> x mod 2 = 0).Count);
  Print(MillisecondsDelta)
end.

работает 0,75 с, что всего на 30% медленнее.

Замечу, что надо не только компилировать в режиме Shift-F9, но и в опциях компиляции снять все флажки.

Сравнение быстродействия программ. 1: Вычисление суммы последовательности вещественных чисел. 1-й справляется за 2 миллисекунды, 2-й за 0-1

begin
  Milliseconds;
  var s := partition(1, 2, 10000).Sum;
  println(MillisecondsDelta);
  print(s);
end.

begin
  var s := 0.0;
  var h := 0.0001;
  var x := 1.0;
  Milliseconds;
  loop 10001 do
  begin
    s += x;
    x += h;
  end;
  println(MillisecondsDelta);
  println(s);
end.

2: Наличие повторяющихся чисел в массиве. Я немного не понял одну вещь, вы вроде говорили, что асимптотическая сложность 1 и 2 алгоритма Θ(n^2), но если 1 выполняется за 7-8 миллисекунд, то 2 за 243 миллисекунды.

begin
  var s := arrgen(10000, 1, x -> x + 1) +arr(1);
  Milliseconds;
  print(s.Distinct.SequenceEqual(s));
  print(MillisecondsDelta);
end.

begin
  var s := arrgen(10000, 1, x -> x + 1);
  var f := true;
  Milliseconds;
  for var i := 0 to s.Count - 2 do
    for var j := i + 1 to s.Count - 1 do
      if s[i] = s[j] then
        f := false;
  print(f);
  print(MillisecondsDelta);
end.

Давно мне хотелось сделать с помощью паскаля что-нибудь ужасное. Сегодня выдалась минутка, и вот, что я натворил.

1 лайк

Под впечатлением языка Brainfuck?

1 лайк

Тащемто, нет, брэйнфак это про другое. Тут скорее просто обфускация и непонятный исходный алгоритм.

Рекомендую Unicode. Не менее эффективно

4 лайка

Я вот про санскрит лекцию прочитал. Шрифт девангари красивый.