Решение алгебраических уравнений

Форум пользователей пакета Maple

Модератор: Admin

алексей_алексей
Сообщения: 1776
Зарегистрирован: Вс май 01, 2005 9:02 pm

Решение алгебраических уравнений

Сообщение алексей_алексей » Пт мар 25, 2011 11:14 pm

Иногда немного просматриваю что-нибудь о решении алгебраических уравнений. Скачал работу Аржанцева И.В. А80 Базисы Грёбнера и системы алгебраических уравнений.—М.:МЦНМО, 2003.—68 с. Есть там два примера, на стр. 40, которые, думаю, можно решить, особо не вдаваясь в теорию. Решение последнего попытался изобразить графически.
система:
ab =c^2 + c
a^2 = a+ bc
ac = b^2 + b в книге ответ {(0, 0, 0); (1, 0, 0); (0, −1, 0); (0, 0, −1)}

и система:

ab =c^2 + c
a^2 + a= bc
ac = b^2 + b ответ в книге: переменная c может принимать бесконечно много
значений.
В первом примере в ответе должно быть ещё четыре нулевых решения, а во втором 8, но все нулевые. Что и видно на картинке. Прошу опровергнуть…


Код: Выделить всё

> ab = c^2+c, a^2+a = bc, ac = b^2+b;
 with(plots):
 implicitplot3d([a*b = c^2+c, a^2+a = b*c, a*c = b^2+b], a = -5 .. 5, b = -5 .. 5, c = -5 .. 5, color = [blue, green, red], scaling = constrained, axes = boxed, numpoints = 3000);



hirnyk
Сообщения: 438
Зарегистрирован: Пт апр 08, 2005 1:41 pm

Сообщение hirnyk » Сб мар 26, 2011 11:14 am

> solve({a*b = c^2+c, a*c = b^2+b, a^2+a = b*c}, [a, b, c]);

[[ 1 -2 -2] [ / 2 2 \
[[a = -, b = --, c = --], [a = -RootOf\_Z + (1 + c) _Z + c + c/ - c - 1,
[[ 3 3 3 ]

/ 2 2 \ ]
b = RootOf\_Z + (1 + c) _Z + c + c/, c = c], [a = -1, b = 0, c = 0],

]
[a = 0, b = 0, c = 0], [a = 0, b = -1, c = 0]]
]
> allvalues(%);

[ [ (1/2)
[[ 1 -2 -2] [ 1 1 1 / 2\
[[a = -, b = --, c = --], [a = - - - - c - - \1 - 2 c - 3 c / ,
[[ 3 3 3 ] [ 2 2 2

(1/2) ]
1 1 1 / 2\ ]
b = - - - - c + - \1 - 2 c - 3 c / , c = c], [a = -1, b = 0, c = 0],
2 2 2 ]

] [ [
] [[ 1 -2 -2] [
[a = 0, b = 0, c = 0], [a = 0, b = -1, c = 0]], [[a = -, b = --, c = --], [
] [[ 3 3 3 ] [

(1/2)
1 1 1 / 2\
a = - - - - c + - \1 - 2 c - 3 c / ,
2 2 2

(1/2) ]
1 1 1 / 2\ ]
b = - - - - c - - \1 - 2 c - 3 c / , c = c], [a = -1, b = 0, c = 0],
2 2 2 ]

]
]
[a = 0, b = 0, c = 0], [a = 0, b = -1, c = 0]]
]

алексей_алексей
Сообщения: 1776
Зарегистрирован: Вс май 01, 2005 9:02 pm

Сообщение алексей_алексей » Сб мар 26, 2011 1:51 pm

hirnyk писал(а):...

Выходит, теории можно доверять. Мои неаккуратные надежды на визуализацию не оправдались. Мэпл о первом и о втором примере говорит, то же самое, что и в книге. Спасибо, что не дали увязнуть в заблуждении. Остаётся только непонятным момент с кратностью 0-го решения первого примера…

hirnyk
Сообщения: 438
Зарегистрирован: Пт апр 08, 2005 1:41 pm

Сообщение hirnyk » Сб мар 26, 2011 2:05 pm

> SolveTools[PolynomialSystem]({a^2 = a+b*c, a*b = c^2+c, a*c = b^2+b}, {a, b, c}, 8)

{a = 0, b = 0, c = -1}, {a = 1, b = 0, c = 0}, {a = 0, b = 0, c = 0}, {a = 0, b = -1, c = 0}

алексей_алексей
Сообщения: 1776
Зарегистрирован: Вс май 01, 2005 9:02 pm

Сообщение алексей_алексей » Сб мар 26, 2011 3:19 pm

hirnyk писал(а):> SolveTools[PolynomialSystem]({a^2 = a+b*c, a*b = c^2+c, a*c = b^2+b}, {a, b, c}, 8)

{a = 0, b = 0, c = -1}, {a = 1, b = 0, c = 0}, {a = 0, b = 0, c = 0}, {a = 0, b = -1, c = 0}


Математика и её Solve дают немного больше корней: {{0,-1,0},{0,-1,0},{0,0,-1},{0,0,0},{0,0,0},{1,0,0},{1,0,0}, но до 8 одного не хватает. Численное же её решение (Nsolve) даёт кратность 2 только для (1,0,0). Похоже, все корни имеют кратность 2, и тогда всё сходится. Но это на словах, а проверять, конечно, надо как положено.
Есть нормальная идея, как решать системы с конечным числом корней, независимо от их кратности. Но вот, как определять наличие бесконечного числа решений при n=m пока в голову никак не приходит. Теория работает, но её реализация, похоже, сложна сама по себе, что мы и наблюдаем в обоих пакетах. В полиномах от одной переменной таких проблем нет, и пакеты и параллельная идея с ними нормально работают. Но с системами возникают ситуации…

hirnyk
Сообщения: 438
Зарегистрирован: Пт апр 08, 2005 1:41 pm

Сообщение hirnyk » Сб мар 26, 2011 3:49 pm

алексей_алексей писал(а):Математика и её Solve дают немного больше корней: {{0,-1,0},{0,-1,0},{0,0,-1},{0,0,0},{0,0,0},{1,0,0},{1,0,0}, но до 8 одного не хватает. Численное же её решение (Nsolve) даёт кратность 2 только для (1,0,0). Похоже, все корни имеют кратность 2, и тогда всё сходится. Но это на словах, а проверять, конечно, надо как положено.

a=b=c=infinity

алексей_алексей
Сообщения: 1776
Зарегистрирован: Вс май 01, 2005 9:02 pm

Сообщение алексей_алексей » Сб мар 26, 2011 4:06 pm

hirnyk писал(а):...a=b=c=infinity

В первом примере число корней конечно. Последнее Ваше решение было решение первого примера…

Kitonum
Сообщения: 2077
Зарегистрирован: Ср дек 31, 2008 1:55 pm
Откуда: г. Пенза

Сообщение Kitonum » Сб мар 26, 2011 10:50 pm

Остались невыясненными 2 вопроса: геометрическая структура множества решений 2-ой системы и его визуализация. Попробовал ответить на оба этих вопроса.

Решаем 2-ую систему:

solve({a*b=c^2+c, a^2+a=b*c, a*c=b^2+b});
{a = 1/3, b = -2/3, c = -2/3}, {a = -RootOf(_Z^2+(1+c)*_Z+c^2+c)-c-1, b = RootOf(_Z^2+(1+c)*_Z+c^2+c), c = c}, {a = -1, b = 0, c = 0}, {a = 0, b = 0, c = 0}, {a = 0, b = -1, c = 0}

Уточняем структуру решений, выраженных через RootOf:

allvalues({a = -RootOf(_Z^2+(1+c)*_Z+c^2+c)-c-1, b = RootOf(_Z^2+(1+c)*_Z+c^2+c), c = c});
{a = -1/2-1/2*c-1/2*(1-2*c-3*c^2)^(1/2), b = -1/2-1/2*c+1/2*(1-2*c-3*c^2)^(1/2), c = c}, {a = -1/2-1/2*c+1/2*(1-2*c-3*c^2)^(1/2), b = -1/2-1/2*c-1/2*(1-2*c-3*c^2)^(1/2), c = c}

Легко проверить, что все отдельные найденные выше решения входят в это бесконечное семейство решений при отдельных значениях параметра с. Особняком стоит только решение {a = 0, b = 0, c = 0}.
Строим полученное множество решений как пространственную кривую. На графике хорошо видно, что эта линия представляет собой окружность, проходящую через точки [-1,0,0], [0,-1,0], [0,0,-1]:

plots[spacecurve]({[-1/2-1/2*c-1/2*(1-2*c-3*c^2)^(1/2), -1/2-1/2*c+1/2*(1-2*c-3*c^2)^(1/2),c],[-1/2-1/2*c+1/2*(1-2*c-3*c^2)^(1/2),-1/2-1/2*c-1/2*(1-2*c-3*c^2)^(1/2), c]}, c=-1..2/3, color=red, thickness=3,axes=normal,labels= [a,b,c],numpoints=10000, view=[-3/2..7/2,-3/2..3/2,-3/2..3/2],orientation=[25,65]);

Наконец, строим всё вместе на одном чертеже.Красным цветом выделены все решения: точка [0,0,0] и упомянутая окружность. Хорошо видно, что каждая из трёх поверхностей представляет собой однополостной гиперболоид. Все эти 3 гиперболоида проходят через начало координат и пересекаются по упомянутой окружности:

A:=plots[spacecurve]({[-1/2-1/2*c-1/2*(1-2*c-3*c^2)^(1/2), -1/2-1/2*c+1/2*(1-2*c-3*c^2)^(1/2),c],[-1/2-1/2*c+1/2*(1-2*c-3*c^2)^(1/2),-1/2-1/2*c-1/2*(1-2*c-3*c^2)^(1/2), c]}, c=-1..2/3, color=red, thickness=10,numpoints=10000):
B:=plots[implicitplot3d]([a*b=c^2+c,a^2+a=b*c,a*c=b^2+b],a=-3/2..3/2,b=-3/2..3/2,c=-3/2..3/2,color=[grey,"LightGreen",pink],numpoints=10000):
C:=plottools[sphere]([0,0,0],0.04,style=surface,color=red):
plots[display](A,B,C,axes=box,orientation=[-50,50]);

hirnyk
Сообщения: 438
Зарегистрирован: Пт апр 08, 2005 1:41 pm

Сообщение hirnyk » Пн мар 28, 2011 10:46 am

алексей_алексей писал(а):Математика и её Solve дают немного больше корней: {{0,-1,0},{0,-1,0},{0,0,-1},{0,0,0},{0,0,0},{1,0,0},{1,0,0}, но до 8 одного не хватает.
with(Groebner):
S := {a^2-a-b*c, a*b-c^2-c, a*c-b^2-b}:
GB := Basis(S, lexdeg([a], [b, c]));

[b*c, -c^2+b^2-c+b, c^2+c^3, -c^2-c+a*c, a*b-c^2-c, a^2-a]
GB1 := remove(has, GB, a);
[b*c, -c^2+b^2-c+b, c^2+c^3]
GB2 := Basis(GB1, lexdeg([b], [c]));
[c^2+c^3, b*c, -c^2+b^2-c+b]
op(remove(has, GB2, {b}));
c^2+c^3
sol[c] := solve(c^2+c^3);
0, 0, -1
[seq(map(`union`, [solve(eval(GB, c = i), {a, b})], {c = i}), i = sol[c])];
[[{a = 0, b = 0, c = 0}, {a = 1, b = 0, c = 0}, {a = 0, b = -1, c = 0}], [{a = 0, b = 0, c = 0}, {a = 1, b = 0, c = 0}, {a = 0, b = -1, c = 0}], [{a = 0, b = 0, c = -1}]]

алексей_алексей
Сообщения: 1776
Зарегистрирован: Вс май 01, 2005 9:02 pm

Сообщение алексей_алексей » Пн мар 28, 2011 12:00 pm

hirnyk писал(а):c^2+c^3
sol[c] := solve(c^2+c^3);
0, 0, -1
[seq(map(`union`, [solve(eval(GB, c = i), {a, b})], {c = i}), i = sol[c])];
[[{a = 0, b = 0, c = 0}, {a = 1, b = 0, c = 0}, {a = 0, b = -1, c = 0}], [{a = 0, b = 0, c = 0}, {a = 1, b = 0, c = 0}, {a = 0, b = -1, c = 0}], [{a = 0, b = 0, c = -1}]]

В уравнении c^2+c^3=0 три решения : -1 и два нулевых. В исходной системе должно быть 8. Один корень пакетами не додаётся. (Говорят, есть проблема кратности корней даже для одного уравнения.) Думается, это связано с существующими алгоритмами…

алексей_алексей
Сообщения: 1776
Зарегистрирован: Вс май 01, 2005 9:02 pm

Сообщение алексей_алексей » Вт мар 29, 2011 3:37 pm

алексей_алексей писал(а):В уравнении c^2+c^3=0 три решения : -1 и два нулевых.

Изображение
(Примерно так же, только в соответствующих пространствах выглядят системы алгебраических уравнений.) А это “наше” уравнение c^3+c^2=0 после замены “c” на сумму вещественной и мнимой части. Синий график соответствует вещественной части получившегося после замены уравнения, а красный – мнимой. Точки их пересечений доставляют корни исходного уравнения. Хочется реализовать алгоритм на Мэпле для систем…

алексей_алексей
Сообщения: 1776
Зарегистрирован: Вс май 01, 2005 9:02 pm

система от UMP-а

Сообщение алексей_алексей » Пн ноя 21, 2011 9:48 pm

f1 := (4*(1-2*cos(x1)+2*cos(x2)-2*cos(x3)))/Pi-x4 = 0;
f2 := (4*(1-2*cos(5*x1)+2*cos(5*x2)-2*cos(5*x3)))/(5*Pi) = 0;
f3 := (4*(1-2*cos(7*x1)+2*cos(7*x2)-2*cos(7*x3)))/(7*Pi) = 0;

(Пока не способен самостоятельно применить пакет оптимизации mois-а к решению краевых задач, а потому решил немного отступить в прошлое, но уже с помощью Maple.) Это система от UMP-а. Как-то очень давно автора удовлетворили результаты её решения, но выявленное тогда множество было довольно “слабеньким”. Недавнее общение в теме “сфера nd” простимулировало заглянуть в книгу по Maple и хоть немного довести до ума старые недоделки. По-моему, очень даже неплохой примерчик, тем более, не из пальца высосан.
Maple до 13 версии включительно самостоятельно его решить, естественно, не может, Математика 7 неплохо справляется при одной фиксированной переменной, но только когда система преобразована к алгебраическому виду… Насколько помню, автора интересовали только вещественные положительные решения, но, думаю, пусть будут просто вещественные…

алексей_алексей
Сообщения: 1776
Зарегистрирован: Вс май 01, 2005 9:02 pm

Re: система от UMP-а

Сообщение алексей_алексей » Вт ноя 22, 2011 9:25 am

алексей_алексей писал(а):f1 := (4*(1-2*cos(x1)+2*cos(x2)-2*cos(x3)))/Pi-x4 = 0;
f2 := (4*(1-2*cos(5*x1)+2*cos(5*x2)-2*cos(5*x3)))/(5*Pi) = 0;
f3 := (4*(1-2*cos(7*x1)+2*cos(7*x2)-2*cos(7*x3)))/(7*Pi) = 0;


Вот алгебраический аналог системы после замены cos(xi)=xi,i=1..3

f1 := 4-8*x1+8*x2-8*x3-Pi*x4=0;
f2 := 4/5-(128/5)*x1^5+32*x1^3-8*x1+(128/5)*x2^5-32*x2^3+8*x2-(128/5)*x3^5+32*x3^3-8*x3=0;
f3 := 4/7-(512/7)*x1^7+128*x1^5-64*x1^3+8*x1+(512/7)*x2^7-128*x2^5+64*x2^3-8*x2-(512/7)*x3^7+128*x3^5-64*x3^3+8*x3=0;

hirnyk
Сообщения: 438
Зарегистрирован: Пт апр 08, 2005 1:41 pm

Бесконечное множество решений

Сообщение hirnyk » Вс ноя 27, 2011 12:40 am

Код: Выделить всё

> eval([4-8*x1+8*x2-8*x3-Pi*x4 = 0, 4/5-(128/5)*x1^5+32*x1^3-8*x1+(128/5)*x2^5-32*x2^3+8*x2-(128/5)*x3^5+32*x3^3-8*x3 = 0, 4/7-(512/7)*x1^7+128*x1^5-64*x1^3+8*x1+(512/7)*x2^7-128*x2^5+64*x2^3-8*x2-(512/7)*x3^7+128*x3^5-64*x3^3+8*x3 = 0], [x1 = x2, x3 = 1/2, x4 = 0]);

                            [0 = 0, 0 = 0, 0 = 0]

Я понимаю шутки, а Вы?