Страница 1 из 2

Расстояние от точки до прямой

Добавлено: Сб дек 03, 2011 11:40 pm
Elena212
Всем здравствуйте.

Не получается решить следующую задачу.

Известны декартовы координаты 4х различных точек (xi,yi,zi), i=1,2,3,4, не лежащих в одной плоскости. Чему равно расстояние от центра сферы, проходящей через эти 4 точки, до прямой, проходящей через начало координат и точку (1,1,Z0)? При каком значении Z0 это расстояние будет минимальным?

И я пока все, чего я добилась:

f := (x, y, z)->(x-x0)^2+(y-y0)^2+(z-z0)^2;
expr := solve({f(x1, y1, z1) = r^2, f(x2, y2, z2) = r^2, f(x3, y3, z3) = r^2, f(x4, y4, z4) = r^2}, {r, x0, y0, z0});
assign(expr);
res:=sqrt((x0-y0)^(2)+(x0-z0)^(2)+(y0-z0)^(2)/3);
unassign('x0', 'y0', 'z0', 'r');


Но что делать дальше и как добиться рабочей программы, я не знаю.
Надеюсь на вашу помощь.

Re: Расстояние от точки до прямой

Добавлено: Вс дек 04, 2011 10:56 am
Kitonum
Elena212 писал(а):Всем здравствуйте.

Не получается решить следующую задачу.

[color=blue]Известны декартовы координаты 4х различных точек (xi,yi,zi), i=1,2,3,4, не лежащих в одной плоскости. Чему равно расстояние от центра сферы, проходящей через эти 4 точки, до прямой, проходящей через начало координат и точку (1,1,Z0)? При каком значении Z0 это расстояние будет минимальным?

И я пока все, чего я добилась:

f := (x, y, z)->(x-x0)^2+(y-y0)^2+(z-z0)^2;
expr := solve({f(x1, y1, z1) = r^2, f(x2, y2, z2) = r^2, f(x3, y3, z3) = r^2, f(x4, y4, z4) = r^2}, {r, x0, y0, z0});
assign(expr);
res:=sqrt((x0-y0)^(2)+(x0-z0)^(2)+(y0-z0)^(2)/3);
unassign('x0', 'y0', 'z0', 'r');


Но что делать дальше и как добиться рабочей программы, я не знаю.
Надеюсь на вашу помощь.

Несколько соображений:

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

2) Вначале желательно писать restart для очищения оперативной памяти перед каждой прогонкой.

3) В систему надо добавить ограничение r>0 , тогда она будет решаться однозначно.

4) Желательно в программу включить проверку непринадлежности точек одной плоскости, так чтобы выдавалась ошибка в случае принадлежности.

5) Не понял смысла последних двух строк Вашей программы.

Пример работы скорректированной программы:

restart:
x1:=5: y1:=-3: z1:=1:
x2:=0: y2:=-3: z2:=6:
x3:=4: y3:=6: z3:=1:
x4:=5: y4:=-2: z4:=3:
A:=Matrix([[x4-x1,y4-y1,z4-z1],[x2-x1,y2-y1,z2-z1],[x3-x1,y3-y1,z3-z1]]):
if LinearAlgebra[Determinant](A)=0 then error "Заданные точки лежат в одной плоскости"
fi;
f := (x, y, z)->(x-x0)^2+(y-y0)^2+(z-z0)^2;
expr := solve({f(x1, y1, z1) = r^2, f(x2, y2, z2) = r^2, f(x3, y3, z3) = r^2, f(x4, y4, z4) = r^2, r>0}, {r, x0, y0, z0});
assign(expr);


Итак центр и радиус сферы найдены. Продолжайте писать дальше! Успехов!

Добавлено: Вс дек 04, 2011 4:03 pm
Elena212
Спасибо за помощь :)
Буду пробовать.

Re: Расстояние от точки до прямой

Добавлено: Вс дек 04, 2011 4:35 pm
hirnyk
Kitonum писал(а):

Пример работы скорректированной программы:

restart:
x1:=5: y1:=-3: z1:=1:
x2:=0: y2:=-3: z2:=6:
x3:=4: y3:=6: z3:=1:
x4:=5: y4:=-2: z4:=3:
A:=Matrix([[x4-x1,y4-y1,z4-z1],[x2-x1,y2-y1,z2-z1],[x3-x1,y3-y1,z3-z1]]):
if LinearAlgebra[Determinant](A)=0 then error "Заданные точки лежат в одной плоскости"
fi;
f := (x, y, z)->(x-x0)^2+(y-y0)^2+(z-z0)^2;
expr := solve({f(x1, y1, z1) = r^2, f(x2, y2, z2) = r^2, f(x3, y3, z3) = r^2, f(x4, y4, z4) = r^2, r>0}, {r, x0, y0, z0});
assign(expr);


Итак центр и радиус сферы найдены. Продолжайте писать дальше! Успехов!

Посмотрите результат в случае:
x1 := 0; y1 := -3; z1 := 6;
x2 := 0; y2 := -3; z2 := 6;
x3 := 4; y3 := 6; z3 := 1;
x4 := 5; y4 := -2; z4 := 3

Re: Расстояние от точки до прямой

Добавлено: Вс дек 04, 2011 9:18 pm
Kitonum
hirnyk писал(а):
Kitonum писал(а):

Пример работы скорректированной программы:

restart:
x1:=5: y1:=-3: z1:=1:
x2:=0: y2:=-3: z2:=6:
x3:=4: y3:=6: z3:=1:
x4:=5: y4:=-2: z4:=3:
A:=Matrix([[x4-x1,y4-y1,z4-z1],[x2-x1,y2-y1,z2-z1],[x3-x1,y3-y1,z3-z1]]):
if LinearAlgebra[Determinant](A)=0 then error "Заданные точки лежат в одной плоскости"
fi;
f := (x, y, z)->(x-x0)^2+(y-y0)^2+(z-z0)^2;
expr := solve({f(x1, y1, z1) = r^2, f(x2, y2, z2) = r^2, f(x3, y3, z3) = r^2, f(x4, y4, z4) = r^2, r>0}, {r, x0, y0, z0});
assign(expr);


Итак центр и радиус сферы найдены. Продолжайте писать дальше! Успехов!

Посмотрите результат в случае:
x1 := 0; y1 := -3; z1 := 6;
x2 := 0; y2 := -3; z2 := 6;
x3 := 4; y3 := 6; z3 := 1;
x4 := 5; y4 := -2; z4 := 3

Уважаемый г-н hirnyk ! Спасибо за указанный пример. Я думал, что в случае наступления error программа прекращает свою работу, как это происходит в процедурах, но здесь сообщение об ошибке выводится, но программа продолжает работать дальше, естественно некорректно. Если Вы знаете, сообщите, пожалуйста, как прекратить работу программы после вывода сообщения об ошибке!

Re: Расстояние от точки до прямой

Добавлено: Вс дек 04, 2011 9:28 pm
hirnyk
Kitonum писал(а):Уважаемый г-н hirnyk ! Спасибо за указанный пример. Я думал, что в случае наступления error программа прекращает свою работу, как это происходит в процедурах, но здесь сообщение об ошибке выводится, но программа продолжает работать дальше, естественно некорректно. Если Вы знаете, сообщите, пожалуйста, как прекратить работу программы после вывода сообщения об ошибке!

Не знаю это.

Re: Расстояние от точки до прямой

Добавлено: Вс дек 04, 2011 10:44 pm
алексей_алексей
restart; U := 0;
x1 := 0; y1 := -3; z1 := 6;
x2 := 0; y2 := -3; z2 := 6;
x3 := 4; y3 := 6; z3 := 1;
x4 := 5; y4 := -2; z4 := 3;
A := Matrix([[x4-x1, y4-y1, z4-z1], [x2-x1, y2-y1, z2-z1], [x3-x1, y3-y1, z3-z1]]):
if LinearAlgebra[Determinant](A) = 0 then U := 1; error "Заданные точки лежат в одной плоскости" end if; if U = 1 then `quit`(1) else f := proc (x, y, z) options operator, arrow; (x-x0)^2+(y-y0)^2+(z-z0)^2 end proc; expr := solve({r > 0, f(x1, y1, z1) = r^2, f(x2, y2, z2) = r^2, f(x3, y3, z3) = r^2, f(x4, y4, z4) = r^2}, {r, x0, y0, z0}); assign(expr) end if;

Re: Расстояние от точки до прямой

Добавлено: Вс дек 04, 2011 10:52 pm
hirnyk
алексей_алексей писал(а):restart; U := 0;
x1 := 0; y1 := -3; z1 := 6;
x2 := 0; y2 := -3; z2 := 6;
x3 := 4; y3 := 6; z3 := 1;
x4 := 5; y4 := -2; z4 := 3;
A := Matrix([[x4-x1, y4-y1, z4-z1], [x2-x1, y2-y1, z2-z1], [x3-x1, y3-y1, z3-z1]]):
if LinearAlgebra[Determinant](A) = 0 then U := 1; error "Заданные точки лежат в одной плоскости" end if; if U = 1 then `quit`(1) else f := proc (x, y, z) options operator, arrow; (x-x0)^2+(y-y0)^2+(z-z0)^2 end proc; expr := solve({r > 0, f(x1, y1, z1) = r^2, f(x2, y2, z2) = r^2, f(x3, y3, z3) = r^2, f(x4, y4, z4) = r^2}, {r, x0, y0, z0}); assign(expr) end if;
Вы пробовали это исполнить?
См. результат в

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

> restart; U := 0; x1 := 0; y1 := -3; z1 := 6; x2 := 0; y2 := -3; z2 := 6; x3 := 4; y3 := 6; z3 := 1; x4 := 5; y4 := -2; z4 := 3; A := Matrix([[x4-x1, y4-y1, z4-z1], [x2-x1, y2-y1, z2-z1], [x3-x1, y3-y1, z3-z1]]); if LinearAlgebra[Determinant](A) = 0 then U := 1; error "Заданные точки лежат в одной плоскости" end if; if U = 1 then `quit`(1) else f := proc (x, y, z) options operator, arrow; (x-x0)^2+(y-y0)^2+(z-z0)^2 end proc; expr := solve({r > 0, f(x1, y1, z1) = r^2, f(x2, y2, z2) = r^2, f(x3, y3, z3) = r^2, f(x4, y4, z4) = r^2}, {r, x0, y0, z0}); assign(expr) end if;
%;
                                      0
                                      0
                                     -3
                                      6
                                      0
                                     -3
                                      6
                                      4
                                      6
                                      1
                                      5
                                     -2
                                      3
                                      1
Error, Заданные точки лежат в одной плоскости


Добавлено: Пн дек 05, 2011 7:59 am
Kitonum
У меня код Алексея работает без проблем!

Наверное, лучше с самого начала оформлять эту задачу как процедуру. Тогда и надобность в команде quit пропадает, код получается более простой и понятный и даже restart можно не писать, т.к. все переменные локализованы и при прогонках проблем не должно возникать.

Task:=proc(x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4)
local A,f,expr,r,x0,y0,z0;
A:=Matrix([[x4-x1,y4-y1,z4-z1],[x2-x1,y2-y1,z2-z1],[x3-x1,y3-y1,z3-z1]]);
if LinearAlgebra[Determinant](A)=0 then error "Заданные точки лежат в одной плоскости"
fi;
f := (x, y, z)->(x-x0)^2+(y-y0)^2+(z-z0)^2;
expr := solve({f(x1, y1, z1) = r^2, f(x2, y2, z2) = r^2, f(x3, y3, z3) = r^2, f(x4, y4, z4) = r^2, r>0}, {r, x0, y0, z0});
assign(expr);
[r, x0, y0, z0];
end proc:


Примеры работы:

Task(5,-3,1,5,-3,1,4,6,1,5,-2,3);
Error, (in Task) Заданные точки лежат в одной плоскости

Task(6,-3,1,5,-3,1,4,6,1,5,-2,3);
[1/18*7331^(1/2), 11/2, 29/18, -1/18]

Re: Расстояние от точки до прямой

Добавлено: Пн дек 05, 2011 9:31 am
алексей_алексей
hirnyk писал(а):...Вы пробовали это исполнить?
...

Увы, признаю я опять: мне шуток Ваших не понять…

try

Добавлено: Ср дек 07, 2011 8:24 pm
Markiyan Hirnyk
Kitonum писал(а):
Уважаемый г-н hirnyk ! Спасибо за указанный пример. Я думал, что в случае наступления error программа прекращает свою работу, как это происходит в процедурах, но здесь сообщение об ошибке выводится, но программа продолжает работать дальше, естественно некорректно. Если Вы знаете, сообщите, пожалуйста, как прекратить работу программы после вывода сообщения об ошибке!

Посмотрите команду ?try .

Ссылка

Добавлено: Пт дек 09, 2011 10:44 pm
Markiyan Hirnyk

Добавлено: Вт фев 28, 2012 3:38 pm
Edik
Всем здравствуйте.

Решаю точно такую же задачу.
Вроде все верно, но ответы получаются верными не всегда. Можете подсказать, в чем проблема?

вот мой код:

Sph:=(x,y,z)->(x-a)^2+(y-b)^2+(z-c)^2=r^2;
P1:=sqrt(2),2*sqrt(3),sqrt(2);
P2:=2*sqrt(2),2*sqrt(3),0;
P3:=sqrt(2),sqrt(3),sqrt(5);
P4:=sqrt(2),0,sqrt(2);

ex1:=expand(Sph(P1));
ex2:=expand(Sph(P2));
ex3:=expand(Sph(P3));
ex4:=expand(Sph(P4));
sol1:=solve({ex1-ex2,ex1-ex3,ex1-ex4},{a,b,c});
x0:=rhs(op(select(has,sol1,a)));
y0:=rhs(op(select(has,sol1,b)));
z0:=rhs(op(select(has,sol1,c)));
sol2:=solve({x1-1=y1-1,x1-1=z1-1,x1-x0+y1-y0+z1-z0 =0},{x1,y1,z1});
radnormal(sqrt((rhs(op(select(has,sol2,x1)))-x0)^2+(rhs(op(select(has,sol2,y1)))-y0)^2+(rhs(op(select(has,sol2,z1)))-z0)^2));

Добавлено: Вт фев 28, 2012 4:27 pm
Kitonum
Edik писал(а):Всем здравствуйте.

Решаю точно такую же задачу.
Вроде все верно, но ответы получаются верными не всегда. Можете подсказать, в чем проблема?

вот мой код:

Sph:=(x,y,z)->(x-a)^2+(y-b)^2+(z-c)^2=r^2;
P1:=sqrt(2),2*sqrt(3),sqrt(2);
P2:=2*sqrt(2),2*sqrt(3),0;
P3:=sqrt(2),sqrt(3),sqrt(5);
P4:=sqrt(2),0,sqrt(2);

ex1:=expand(Sph(P1));
ex2:=expand(Sph(P2));
ex3:=expand(Sph(P3));
ex4:=expand(Sph(P4));
sol1:=solve({ex1-ex2,ex1-ex3,ex1-ex4},{a,b,c});
x0:=rhs(op(select(has,sol1,a)));
y0:=rhs(op(select(has,sol1,b)));
z0:=rhs(op(select(has,sol1,c)));
sol2:=solve({x1-1=y1-1,x1-1=z1-1,x1-x0+y1-y0+z1-z0 =0},{x1,y1,z1});
radnormal(sqrt((rhs(op(select(has,sol2,x1)))-x0)^2+(rhs(op(select(has,sol2,y1)))-y0)^2+(rhs(op(select(has,sol2,z1)))-z0)^2));

1) Центр сферы найден верно, но все вычисления можно сильно сократить, если использовать команды пакета geom3d .

2) Смысла последних двух строк Вашей программы

sol2:=solve({x1-1=y1-1,x1-1=z1-1,x1-x0+y1-y0+z1-z0 =0},{x1,y1,z1});
radnormal(sqrt((rhs(op(select(has,sol2,x1)))-x0)^2+(rhs(op(select(has,sol2,y1)))-y0)^2+(rhs(op(select(has,sol2,z1)))-z0)^2));


я не понял! Что означают числа x1,y1,z1 ?

Добавлено: Вт фев 28, 2012 4:50 pm
Edik
Я пробую расстояние найти. x1,y1,z1 это числа из sol2.

За совет про пакет спасибо. Я правда ни разу им не пользовался, но попробую разобраться