Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Решение уравнения четвёртой степени на Prolog.docx
Скачиваний:
0
Добавлен:
02.01.2026
Размер:
1.12 Mб
Скачать

Код программы

NOWARNINGS

DOMAINS

realnum = real

file = file_pointer

int = integer

PREDICATES

go

process_file

read_number(realnum)

printEq(realnum, realnum, realnum, realnum, realnum)

chord_method(realnum, realnum, realnum, realnum, realnum, realnum, realnum, realnum)

chord_method_iter(realnum, realnum, realnum, realnum, realnum, realnum, realnum, realnum, int)

horner_scheme(realnum, realnum, realnum, realnum, realnum, realnum, realnum, realnum, realnum, realnum)

evaluate_polynomial(realnum, realnum, realnum, realnum, realnum, realnum, realnum)

find_root(realnum, realnum, realnum, realnum, realnum, realnum)

try_interval(realnum, realnum, realnum, realnum, realnum, realnum, realnum, realnum)

print_cubic(realnum, realnum, realnum, realnum)

solve_cubic_cardano(realnum, realnum, realnum, realnum)

solve_quadratic(realnum, realnum, realnum)

solve_linear(realnum, realnum)

cube_root(realnum, realnum)

process_equation(realnum, realnum, realnum, realnum, realnum)

solve_by_discriminant(realnum, realnum, realnum, realnum, realnum)

my_acos(realnum, realnum)

CLAUSES

% Чтение одного вещественного числа (реального коэффициента)

read_number(X) :-

readreal(X), !.

read_number(X) :-

write("Warning: failed to read real, using 0.0"), nl,

X = 0.0.

% Процедура чтения файла coeff.txt

process_file :-

existfile("coeff.txt"),

!,

write("File coeff.txt found, opening..."), nl,

openread(file_pointer, "coeff.txt"),

readdevice(file_pointer),

read_number(A),

read_number(B),

read_number(C),

read_number(D),

read_number(K),

readdevice(keyboard),

closefile(file_pointer),

write("Read coefficients: "),

write(A), write(" "),

write(B), write(" "),

write(C), write(" "),

write(D), write(" "),

write(K), nl, nl,

process_equation(A, B, C, D, K).

process_file :-

write("Error: file coeff.txt not found"), nl.

go :-

process_file.

% a=0,b=0,c=0,d=0,k=0 -> любое число

process_equation(0, 0, 0, 0, 0) :-

write("Any number"), nl.

% a=0,b=0,c=0,d=0,k<>0 -> решений нет

process_equation(0, 0, 0, 0, K) :-

K <> 0,

write("Constant equation: "), write(K), write(" = 0"), nl,

write("No solution"), nl.

% a=0,b=0,c=0,d<>0 -> линейное

process_equation(0, 0, 0, D, K) :-

D <> 0,

write("Linear equation found (a=0, b=0, c=0, d<>0)"), nl,

printEq(0, 0, 0, D, K),

solve_linear(D, K).

% a=0,b=0,c<>0 -> квадратное

process_equation(0, 0, C, D, K) :-

C <> 0,

write("Quadratic equation found (a=0, b=0, c<>0)"), nl,

printEq(0, 0, C, D, K),

solve_quadratic(C, D, K).

% a=0,b<>0 -> кубическое по Кардано

process_equation(0, B, C, D, K) :-

B <> 0,

write("Cubic equation found (a=0, b<>0)"), nl,

printEq(0, B, C, D, K),

solve_cubic_cardano(B, C, D, K).

% a<>0 -> уравнение 4-й степени

process_equation(A, B, C, D, K) :-

A <> 0,

write("Fourth degree equation found"), nl,

printEq(A, B, C, D, K),

% сначала находим один корень методом хорд

find_root(A, B, C, D, K, Root),

write("First root found: x = "), write(Root), nl,

% понижаем степень по схеме Горнера

horner_scheme(A, B, C, D, K, Root, A1, B1, C1, D1),

write("After Horner's scheme we get cubic equation:"), nl,

print_cubic(A1, B1, C1, D1),

% решаем кубическое уравнение по Кардано

solve_cubic_cardano(A1, B1, C1, D1).

printEq(A, B, C, D, K) :-

write("Equation: "),

write(A), write("*x^4 + "),

write(B), write("*x^3 + "),

write(C), write("*x^2 + "),

write(D), write("*x + "),

write(K), write(" = 0"), nl.

print_cubic(A, B, C, D) :-

write("Cubic equation: "),

write(A), write("*x^3 + "),

write(B), write("*x^2 + "),

write(C), write("*x + "),

write(D), write(" = 0"), nl.

evaluate_polynomial(A, B, C, D, K, X, Value) :-

Value = A*X*X*X*X + B*X*X*X + C*X*X + D*X + K.

find_root(A, B, C, D, K, Root) :-

try_interval(A, B, C, D, K, -10.0, 10.0, Root), !.

find_root(A, B, C, D, K, Root) :-

try_interval(A, B, C, D, K, -5.0, 5.0, Root), !.

find_root(A, B, C, D, K, Root) :-

try_interval(A, B, C, D, K, -2.0, 2.0, Root), !.

find_root(A, B, C, D, K, Root) :-

try_interval(A, B, C, D, K, -1.0, 1.0, Root), !.

% если ни один интервал не подошёл

find_root(_, _, _, _, _, Root) :-

write("Warning: failed to find root with chord method, using 0.0"), nl,

Root = 0.0.

try_interval(A, B, C, D, K, X0, X1, Root) :-

evaluate_polynomial(A, B, C, D, K, X0, F0),

evaluate_polynomial(A, B, C, D, K, X1, F1),

F0*F1 <= 0.0, % есть смена знака или очень близко

chord_method(A, B, C, D, K, X0, X1, Root).

chord_method(A, B, C, D, K, X0, X1, Root) :-

chord_method_iter(A, B, C, D, K, X0, X1, Root, 0).

% 1) если знаменатель почти 0 — считаем, что дальше нельзя продолжать, возвращаем X1

chord_method_iter(A, B, C, D, K, X0, X1, Root, Iter) :-

Iter < 1000000000,

evaluate_polynomial(A, B, C, D, K, X0, F0),

evaluate_polynomial(A, B, C, D, K, X1, F1),

Den = F1 - F0,

abs(Den) < 1e-12,

!,

write("Warning: chord_method denominator ~ 0, using current X1 as root"), nl,

Root = X1.

% 2) нормальный шаг — проверяем критерий точности

chord_method_iter(A, B, C, D, K, X0, X1, Root, Iter) :-

Iter < 1000000000,

evaluate_polynomial(A, B, C, D, K, X0, F0),

evaluate_polynomial(A, B, C, D, K, X1, F1),

Den = F1 - F0,

abs(Den) >= 1e-12,

X2 = X1 - F1*(X1 - X0)/Den,

evaluate_polynomial(A, B, C, D, K, X2, F2),

abs(F2) < 1e-6,

!,

Root = X2.

% 3) если ещё не достигнута точность — рекурсия с увеличением счётчика

chord_method_iter(A, B, C, D, K, X0, X1, Root, Iter) :-

Iter < 1000000000,

evaluate_polynomial(A, B, C, D, K, X0, F0),

evaluate_polynomial(A, B, C, D, K, X1, F1),

Den = F1 - F0,

abs(Den) >= 1e-12,

X2 = X1 - F1*(X1 - X0)/Den,

NextIter = Iter + 1,

chord_method_iter(A, B, C, D, K, X1, X2, Root, NextIter).

% 4) достигнут лимит итераций — выходим, чтобы не повиснуть

chord_method_iter(_, _, _, _, _, _, X1, Root, Iter) :-

Iter >= 1000000000,

write("Warning: chord_method did not converge within 1000000000 iterations, using approximate root"), nl,

Root = X1.

horner_scheme(A, B, C, D, K, Root, A1, B1, C1, D1) :-

A1 = A,

B1 = B + A1*Root,

C1 = C + B1*Root,

D1 = D + C1*Root,

Remainder = K + D1*Root,

write("Remainder: "), write(Remainder), nl,

abs(Remainder) < 1e-6.

solve_linear(D, K) :-

Root = -K / D,

write("Linear equation root (x = -K/D): x = "),

write(Root), nl.

solve_quadratic(C, D, K) :-

Discriminant = D*D - 4.0*C*K,

Discriminant >= 0.0,

Root1 = (-D + sqrt(Discriminant)) / (2.0*C),

Root2 = (-D - sqrt(Discriminant)) / (2.0*C),

write("Quadratic equation roots:"), nl,

write("x1 = "), write(Root1), nl,

write("x2 = "), write(Root2), nl.

solve_quadratic(C, D, K) :-

Discriminant = D*D - 4.0*C*K,

Discriminant < 0.0,

RealPart = -D / (2.0*C),

ImagPart = sqrt(-Discriminant) / (2.0*C),

write("Quadratic equation complex roots:"), nl,

write("x1 = "), write(RealPart), write(" + "), write(ImagPart), write("i"), nl,

write("x2 = "), write(RealPart), write(" - "), write(ImagPart), write("i"), nl.

solve_cubic_cardano(A, B, C, D) :-

P = (3.0*A*C - B*B) / (3.0*A*A),

Q = (2.0*B*B*B - 9.0*A*B*C + 27.0*A*A*D) / (27.0*A*A*A),

write("Depressed cubic parameters: p = "), write(P),

write(", q = "), write(Q), nl,

Discriminant = (Q*Q) / 4.0 + (P*P*P) / 27.0,

write("Discriminant: "), write(Discriminant), nl,

solve_by_discriminant(A, B, P, Q, Discriminant).

% Δ > 0

solve_by_discriminant(A, B, P, Q, Discriminant) :-

Discriminant > 0.0,

write("One real and two complex roots"), nl,

Temp1 = -Q/2.0 + sqrt(Discriminant),

Temp2 = -Q/2.0 - sqrt(Discriminant),

cube_root(Temp1, U),

cube_root(Temp2, V),

T = U + V,

Shift = B / (3.0*A),

RealRoot = T - Shift,

write("Real root x1 = "), write(RealRoot), nl,

Sqrt3 = sqrt(3.0),

ImagCoeff = Sqrt3 / 2.0,

ImagPart = ImagCoeff * (U - V),

RealPartComplex = -T/2.0 - Shift,

write("Complex root x2 = "),

write(RealPartComplex), write(" + "),

write(ImagPart), write("i"), nl,

write("Complex root x3 = "),

write(RealPartComplex), write(" - "),

write(ImagPart), write("i"), nl.

% Δ = 0

solve_by_discriminant(A, B, P, Q, Discriminant) :-

Discriminant = 0.0,

write("Three real roots (at least two equal)"), nl,

Temp = -Q / 2.0,

cube_root(Temp, U),

Root1 = 2.0*U - B/(3.0*A),

Root2 = -U - B/(3.0*A),

Root3 = Root2,

write("Root x1 = "), write(Root1), nl,

write("Root x2 = "), write(Root2), nl,

write("Root x3 = "), write(Root3), nl.

% Δ < 0

solve_by_discriminant(A, B, P, Q, Discriminant) :-

Discriminant < 0.0,

write("Three distinct real roots"), nl,

Temp1 = P*P*P,

Temp2 = -Temp1 / 27.0,

R = sqrt(Temp2),

Temp3 = -Q / (2.0*R),

my_acos(Temp3, Phi),

cube_root(R, R3),

Root1 = 2.0*R3*cos(Phi/3.0) - B/(3.0*A),

Root2 = 2.0*R3*cos((Phi + 2.0*3.14159)/3.0) - B/(3.0*A),

Root3 = 2.0*R3*cos((Phi + 4.0*3.14159)/3.0) - B/(3.0*A),

write("Root x1 = "), write(Root1), nl,

write("Root x2 = "), write(Root2), nl,

write("Root x3 = "), write(Root3), nl.

cube_root(0.0, 0.0) :- !.

cube_root(X, Result) :-

X > 0.0,

Result = exp(ln(X)/3.0).

cube_root(X, Result) :-

X < 0.0,

Result = -exp(ln(-X)/3.0).

my_acos(X, Result) :-

X >= -1.0,

X <= 1.0,

X2 = X*X,

X3 = X2*X,

X5 = X2*X3,

Result = 1.570796 - X - X3/6.0 - 3.0*X5/40.0.

GOAL

clearwindow,

write("Reading coefficients from file coeff.txt"), nl, nl,

go.

Выводы

В ходе лабораторной работы была разработана программа на Turbo Prolog 2.0, автоматически решающая уравнения от первой до четвёртой степени. Программа считывает коэффициенты из файла, определяет тип уравнения и выбирает подходящий метод решения. Для уравнения четвёртой степени реализован полный алгоритм: поиск первого корня методом хорд, понижение степени по схеме Горнера и решение полученного кубического уравнения по формуле Кардано. Для кубических, квадратных и линейных уравнений используются соответствующие аналитические методы. Программа корректно обрабатывает все возможные случаи. Результаты тестирования на различных наборах коэффициентов подтверждают работоспособность и правильность реализованных алгоритмов.