Решения задач / Окружность и трапеция

2

3

Таблица 2 — Код программы на Turbo Prolog

Код

NOWARNINGS

%Раздел описания доменов

DOMAINS

file = datafile % Файл datafile

point = point(real, real) % Структура, описывающая точку points = point* % Список точек

%Раздел описания предикатов

PREDICATES

input(point, real, point, point, point, point) input_action(point, real, point, point, point, point, integer) exist_file(string)

read_data_from_console(point, real, point, point, point, point) read_data_from_file(point, real, point, point, point, point) main(point, real, point, point, point, point, points) is_circle(point, real)

is_trapezoid(point, point, point, point) is_trapezoid_aux(point, point, point, point) is_parallel(point, point, point, point)

find_intersections(point, real, point, point, point, point, point) find_intersection(point, real, point, point, point) check_boundaries(real, real, real)

get_roots(real, real, real, real, real, real, real, point, point) distance(point, point, real)

jarvis(points, points) jarvis_1(points, point, point, points)

jarvis_2(points, point, point, points, points, point) jarvis_3(symbol, points, point, point, point, points, points, point) min(points, point)

min_1(points, point, point) lt(point, point)

direction(point, point, point, symbol) direction_1(real, symbol) is_nearer(point, point, point) quicksort(points, points) partition(points, real, points, points) merge(points, points, points) distinct_p(points, points) point_equals(point, point) output(points)

output_action(points, integer) write_data(points)

% Раздел описания внутренней цели

GOAL

clearwindow(), % Очистка текущего окна

input(PointC, Radius, Point1, Point2, Point3, Point4), % Ввод исходных данных

main(PointC, Radius, Point1, Point2, Point3, Point4, Solutions), % Запуск основного алгоритма quicksort(Solutions, SortedSolutions), % Сортировка результирующего списка точек по X distinct_p(SortedSolutions, SortedSolutionsWithoutDuplicates), % Удаление дубликатов точек output(SortedSolutionsWithoutDuplicates), % Вывод результата

readchar(_).

CONSTANTS

epsilon = 1e-6

CLAUSES

% Ввод исходных данных

input(PC, Radius, P1, P2, P3, P4) :- write("-== MENU ==-"), nl, write("1. Read from console;"), nl, write("2. Read from file."), nl, write("Another button to exit"), nl,

readint(C), % Считывание целого числа input_action(PC, Radius, P1, P2, P3, P4, C), !; write("Error input."), fail.

% Ввод из диалогового окна

input_action(PC, Radius, P1, P2, P3, P4, 1) :- read_data_from_console(PC, Radius, P1, P2, P3, P4).

% Ввод из файла

input_action(PC, Radius, P1, P2, P3, P4, 2) :- write("File name: "),

readln(FileName), !, % Ввод названия файла exist_file(FileName), % Существует ли файл openread(datafile, FileName), % Открытие файла для чтения readdevice(datafile), % Перенаправление ввода на файл

read_data_from_file(PC, Radius, P1, P2, P3, P4), % Чтение данных из файла closefile(datafile), !; % Закрытие файла

write("Error reading file!"), nl, fail.

% Проверка существования файла и вывод ошибки, если отсутствует exist_file(FileName) :-

existfile(FileName), !;

write("File not found!"), nl, !, fail.

4

% Чтение данных с консоли

read_data_from_console(point(CX, CY), Radius, point(X1, Y1), point(X2, Y2), point(X3, Y3), point(X4, Y4)) :-

write("1. Input circle"), nl, write("- Center X: "), readreal(CX), write("- Center Y: "), readreal(CY), write("- Radius: "), readreal(Radius), write("2. Input trapezoid"), nl, write("- X1: "), readreal(X1), write("- Y1: "), readreal(Y1), write("- X2: "), readreal(X2), write("- Y2: "), readreal(Y2), write("- X3: "), readreal(X3), write("- Y3: "), readreal(Y3), write("- X4: "), readreal(X4), write("- Y4: "), readreal(Y4), nl.

% Чтение данных с файла

read_data_from_file(PointC, Radius, P1, P2, P3, P4) :- readterm(point, PointC),

readreal(Radius), readterm(point, P1), readterm(point, P2), readterm(point, P3), readterm(point, P4).

% Запуск основного алгоритма

main(PointC, R, P1, P2, P3, P4, Solutions) :- is_circle(PointC, R), % Проверка на круг is_trapezoid(P1, P2, P3, P4), % Проверка на трапецию

jarvis([P1, P2, P3, P4], [NP1, NP2, NP3, NP4, _]), % Алгоритм обхода Джарвиса

% Поиск всех решений-пересечений

findall(Point, find_intersections(PointC, R, NP1, NP2, NP3, NP4, Point), Solutions).

%Проверка на круг (радиус > 0) is_circle(_, R) :-

R > 0, !;

write("Circle radius <= 0!"), !, fail.

%Проверка на трапецию

%1. Две любые точки трапеции не могут совпадать.

%2. Две стороны параллельны и две другие стороны не параллельны. is_trapezoid(P1, P2, P3, P4) :-

not(point_equals(P1, P2)), not(point_equals(P1, P3)), not(point_equals(P1, P4)), not(point_equals(P2, P3)), not(point_equals(P2, P4)), not(point_equals(P3, P4)), is_trapezoid_aux(P1, P2, P3, P4), !;

write("Not trapezoid!"), !, fail.

%Проверка на трапецию (вспомогательный предикат)

is_trapezoid_aux(P1, P2, P3, P4) :- is_parallel(P1, P2, P3, P4), not(is_parallel(P1, P3, P2, P4)), not(is_parallel(P2, P3, P1, P4)), !; is_parallel(P1, P3, P2, P4), not(is_parallel(P1, P2, P3, P4)), not(is_parallel(P2, P3, P1, P4)), !; is_parallel(P2, P3, P1, P4), not(is_parallel(P1, P3, P2, P4)), not(is_parallel(P1, P2, P3, P4)).

% Проверка параллельности двух прямых, заданных точками P1-P2 и P3-P4 is_parallel(point(X1, Y1), point(X2, Y2), point(X3, Y3), point(X4, Y4)) :-

abs((Y2 - Y1) * (X4 - X3) - (Y4 - Y3) * (X2 - X1)) <= epsilon.

% Поиск всех пересечений

find_intersections(PC, R, P1, P2, P3, P4, Point) :- find_intersection(PC, R, P1, P2, Point); find_intersection(PC, R, P2, P3, Point); find_intersection(PC, R, P3, P4, Point); find_intersection(PC, R, P4, P1, Point).

% Поиск пересечения

find_intersection(point(CX, CY), R, point(X1, Y1), point(X2, Y2), point(RX, RY)) :- distance(point(X1, Y1), point(X2, Y2), Lab), abs(Lab) > epsilon,

DX = (X2 - X1) / Lab,

DY = (Y2 - Y1) / Lab,

T = DX * (CX - X1) + DY * (CY - Y1), EX = T * DX + X1,

EY = T * DY + Y1,

distance(point(EX, EY), point(CX, CY), LEC),

get_roots(LEC, R, DX, DY, T, X1, Y1, point(EX, EY), point(RX, RY)), check_boundaries(X1, X2, RX), check_boundaries(Y1, Y2, RY).

%Проверка границ решения

%(точка пересечения должна быть в пределах отрезка) check_boundaries(T1, T2, RT) :-

T1 <= RT, RT <= T2, !;

T2 <= RT, RT <= T1.

%Поиск всех корней

get_roots(LEC, R, DX, DY, T, X1, Y1, PointE, point(FX, FY)) :- LEC > R, !, fail; % Корней нет

5

LEC = R, !, PointE = point(FX, FY); % Один корень

DT = sqrt(R * R - LEC * LEC), % Два корня

FX = (T - DT) * DX + X1,

FY = (T - DT) * DY + Y1; % Также ещё один при помощи OR

DT = sqrt(R * R - LEC * LEC),

FX = (T + DT) * DX + X1,

FY = (T + DT) * DY + Y1.

%Расстояние Евклида между двумя точками distance(point(X1, Y1), point(X2, Y2), D) :-

D = sqrt((Y2 - Y1) * (Y2 - Y1) + (X2 - X1) * (X2 - X1)).

%Универсальный алгоритм Джарвиса

%Здесь используется для того, чтобы определить по четырем точкам трапецию

%Основная сложность определения трапеции — точки могут быть введены случайным образом

%Например, они могут быть введены диагональным образом

%Например, точки введены в порядке "A, C, B, D", но ребра: A-B-C-D-A

%Т. е. нужно как-то отделить диагонали от ребер

%Для этого алгоритм Джарвиса строит выпуклую оболочку так, будто точки были введены

%в порядке "A, B, C, D".

%Данный предикат всегда вставляет в конец начальную точку, что может быть лишним.

%Например, как в нашем случае. Однако это поведение стоит оставить таким.

jarvis(Points, [Pstart|ConvexHullVertices]) :- min(Points, Pstart),

jarvis_1([Pstart|Points], Pstart, Pstart, ConvexHullVertices). jarvis_1([P1|Ps], P0, Pstart, [Q|Qs]) :-

jarvis_2(Ps, P1, P0, [], Ps1, Q), not(Q = Pstart), !, jarvis_1(Ps1, Q, Pstart, Qs).

jarvis_1(_, _, Pstart, [Pstart]). jarvis_2([], P, _, Ps, Ps, P). jarvis_2([P0|Ps], P1, P0, Ps0, Ps1, Q) :- !,

jarvis_2(Ps, P1, P0, [P0|Ps0], Ps1, Q). jarvis_2([P2|Ps], P1, P0, Ps0, Ps1, Q) :-

direction(P2, P0, P1, Direction), jarvis_3(Direction, Ps, P2, P1, P0, Ps0, Ps1, Q).

jarvis_3(left, Ps, P2, P1, P0, Ps0, Ps1, Q) :- !, jarvis_2(Ps, P2, P0, [P1|Ps0], Ps1, Q).

jarvis_3(right, Ps, P2, P1, P0, Ps0, Ps1, Q) :- !, jarvis_2(Ps, P1, P0, [P2|Ps0], Ps1, Q).

jarvis_3(collinear, Ps, P2, P1, P0, Ps0, Ps1, Q):- is_nearer(P2, P1, P0), !,

% P2 = nearer to P0 than P1 jarvis_2(Ps, P1, P0, Ps0, Ps1, Q).

jarvis_3(collinear, Ps, P2, _, P0, Ps0, Ps1, Q):- % P1 = nearer to P0 than P2

jarvis_2(Ps, P2, P0, Ps0, Ps1, Q). min([X|Xs], Y) :- min_1(Xs, X, Y). min_1([], X, X).

min_1([Y|Ys], X, Z) :- lt(Y, X), !, min_1(Ys, Y, Z). min_1([_|Ys], X, Z) :- min_1(Ys, X, Z).

lt(point(X, _), point(X1, _)) :- X < X1, !. lt(point(X, Y), point(X, Y1)) :- Y < Y1.

direction(point(Xa, Ya), point(Xb, Yb), point(Xc, Yc), Dirn) :- Area = (Xb - Xa) * (Yc - Ya) - (Xc - Xa) * (Yb - Ya), direction_1(Area, Dirn).

direction_1(Area, left) :- Area > 0.0, !. direction_1(Area, right) :- Area < 0.0, !. direction_1(_, collinear).

is_nearer(point(Xa, Ya), point(Xb, Yb), point(Xc, Yc)) :- Xa_Xc = Xa - Xc,

Ya_Yc = Ya - Yc,

Xb_Xc = Xb - Xc,

Yb_Yc = Yb - Yc,

(Xa_Xc * Xa_Xc + Ya_Yc * Ya_Yc) < (Xb_Xc * Xb_Xc + Yb_Yc * Yb_Yc).

% Быстрая сортировка quicksort([point(X, Y)|Xs], Ys) :-

partition(Xs, X, Left, Right), quicksort(Left, Ls), quicksort(Right, Rs),

merge(Ls, [point(X, Y)|Rs], Ys), !. quicksort([], []).

% Разбиение списка

partition([point(X, Y)|Xs], Z, [point(X, Y)|Ls], Rs) :- X <= Z, !, partition(Xs, Z, Ls, Rs).

partition([point(X, Y)|Xs], Z, Ls, [point(X, Y)|Rs]) :- X > Z, partition(Xs, Z, Ls, Rs).

partition([], _, [], []).

% Объединение двух списков

merge([X|Xs], Ys, [X|Zs]) :- merge(Xs, Ys, Zs), !. merge([], Ys, Ys).

% Удаление дубликатов точек по X [O(N) - нужна предварительная сортировка] distinct_p([], []) :- !. % В пустом списке нет дубликатов distinct_p([Point], [Point]) :- !. % В списке из одной точки нет дубликатов distinct_p([Point1, Point2|Tail], Result) :- % Если точки примерно одинаковы

point_equals(Point1, Point2), !, distinct_p([Point1|Tail], Result).

distinct_p([Point1, Point2|Tail], [Point1|Result]) :- % Если точки разные distinct_p([Point2|Tail], Result).

6

point_equals(point(X1, Y1), point(X2, Y2)) :- % Проверка точек на примерное равенство abs(X1 - X2) <= epsilon, abs(Y1 - Y2) <= epsilon.

%Вывод результата output(Solutions) :-

not(Solutions = []),

write("1. Write to console;"), nl, write("2. Write to file."), nl, write("Another button to exit"), nl, readint(C), % Считывание числа output_action(Solutions, C), !; % Вывод

Solutions = [], !, write("No roots!"); write("Error output.").

%Вывод в диалоговое окно

output_action(Solutions, 1) :- write_data(Solutions).

% Вывод в файл output_action(Solutions, 2) :-

write("File name: "), readln(FileName), % Ввод названия файла

openwrite(datafile, FileName), % Открытие файла для записи writedevice(datafile), % Перенаправление вывода на файл write_data(Solutions), % Запись данных closefile(datafile). % Закрытие файла

% Вывод каждой точки пересечения write_data([]). write_data([point(X, Y)|Tail]) :-

writef("(%0.3f, %0.3f)", X, Y), nl, write_data(Tail).

7