|\^/| Maple 16 (X86 64 LINUX) ._|\| |/|_. Copyright (c) Maplesoft, a division of Waterloo Maple Inc. 2012 \ MAPLE / All rights reserved. Maple is a trademark of <____ ____> Waterloo Maple Inc. | Type ? for help. # ======================================================================== # # # Copyright 2012, Gabor Hegedus, Josef Schicho, and Hans-Peter Schroecker # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # # ======================================================================== # > # Maple implementation of Example 3 of Hegedus, Schicho, and # Schroecker: Factorization of Rational Curves in the Study Quadric. > > read "qf.mpl": > # Choose three rotation quaternions. > h1 := [1, 1, e, e]; h1 := [1, 1, epsilon, epsilon] > h2 := [1, 1-e, 1, 1+e]; h2 := [1, 1 - epsilon, 1, 1 + epsilon] > h3 := [1, 2,2*e, 1]; h3 := [1, 2, 2 epsilon, 1] > # Compute P = (t-h1)*(t-h2)*(t-h3), its conjugate polynomial Pb, and # multiply the two. The result is a real polynomial f of degree six # with three irreducible quadratic factors M1, M2, M3 that can be # computed as minimal polynomials of h1, h2, and h3, respectively. > P := PolMult(PolMult([-h1], [-h2]), [-h3]); P := [[-3, -4 + epsilon, -3 epsilon - 1, -2 - 2 epsilon], [-3 - 3 epsilon, 9 - 3 epsilon, 11 epsilon + 1, 3 + 5 epsilon], [6, 6 epsilon - 2, -2 - 4 epsilon, -2 - 2 epsilon]] > Pb := map(Cj, P); # conjugate quaternion Pb := [[-3, 4 - epsilon, 3 epsilon + 1, 2 + 2 epsilon], [-3 - 3 epsilon, -9 + 3 epsilon, -11 epsilon - 1, -3 - 5 epsilon], [6, -6 epsilon + 2, 2 + 4 epsilon, 2 + 2 epsilon]] > PPb := PolMult(P, Pb); # a real polynomial PPb := [[-6, 0, 0, 0], [24, 0, 0, 0], [-56, 0, 0, 0], [92, 0, 0, 0], [-88, 0, 0, 0], [48, 0, 0, 0]] > f := t^6: > for i from 1 to nops(PPb) do > f := f + t^(6-i) * op(i, PPb)[1]: > od: > f := factor(f); 2 2 2 f := (t - 2 t + 2) (t - 2 t + 4) (t - 2 t + 6) > # Computing f is actually not necessary. We can compute the factors # directly. > M[1] := MinPol(h1); M[1] := [[-2, 0, 0, 0], [2, 0, 0, 0]] > M[2] := MinPol(h2); M[2] := [[-2, 0, 0, 0], [4, 0, 0, 0]] > M[3] := MinPol(h3); M[3] := [[-2, 0, 0, 0], [6, 0, 0, 0]] > # Permutations of three elements. > p := [[1, 2, 3], [1, 3, 2], [2, 1, 3], > [2, 3, 1], [3, 1, 2], [3, 2, 1]]: > # Compute open 3R chains that generate the motion parametrized by P. > i := 1: > for q in p do > H3[i] := Solution(P, M[q[1]]): # first factor > Q := PolQuot(P, [-H3[i]]): # divide by (t-H3) > H2[i] := Solution(Q, M[q[2]]): # second factor > H1[i] := -PolQuot(Q, [-H2[i]])[1]: # divide by (t-H2) > # --> last factor > > # print solution and ... > print(H1[i], H2[i], H3[i]): > # ... check result > print(PolMult(PolMult([-H1[i]], [-H2[i]]), [-H3[i]]) - P): > i := i + 1: > od: 65 814 epsilon 16 1373 epsilon 1719 epsilon 18 [1, -- - -----------, -- + ------------, ------------ + --], 31 961 31 961 961 31 395 94035 epsilon 319 53380 epsilon 41995 epsilon 479 [1, --- - -------------, --- + -------------, ------------- + ---], 403 162409 403 162409 162409 403 12 72 epsilon 210 epsilon 8 epsilon [1, -- + ----------, ----------- - 4/13, 3/13 - ---------] 13 169 169 169 [[0, 0, 0, 0], [0, 0, 0, 0], [0, 0, 0, 0]] 5 epsilon 11 epsilon 14 epsilon [1, 5/3 - ---------, 1/3 + ----------, ---------- + 1/3], 9 9 9 55 1324 epsilon 38 814 epsilon 748 epsilon 56 [1, -- - ------------, -- + -----------, ----------- + --], 39 1521 39 1521 1521 39 12 72 epsilon 210 epsilon 8 epsilon [1, -- + ----------, ----------- - 4/13, 3/13 - ---------] 13 169 169 169 [[0, 0, 0, 0], [0, 0, 0, 0], [0, 0, 0, 0]] 65 814 epsilon 16 1373 epsilon 1719 epsilon 18 [1, -- - -----------, -- + ------------, ------------ + --], 31 961 31 961 961 31 72 16813 epsilon 136 7695 epsilon 14752 epsilon 153 [1, --- - -------------, --- - ------------, ------------- + ---], 217 47089 217 47089 47089 217 10 epsilon 85 epsilon 5 epsilon [1, 11/7 + ----------, ---------- - 1/7, 5/7 - ---------] 49 49 49 [[0, 0, 0, 0], [0, 0, 0, 0], [0, 0, 0, 0]] [1, 1, epsilon, epsilon], 59 epsilon 13 epsilon 54 epsilon [1, 10/7 - ----------, 8/7 + ----------, ---------- + 9/7], 49 49 49 10 epsilon 85 epsilon 5 epsilon [1, 11/7 + ----------, ---------- - 1/7, 5/7 - ---------] 49 49 49 [[0, 0, 0, 0], [0, 0, 0, 0], [0, 0, 0, 0]] 5 epsilon 11 epsilon 14 epsilon [1, 5/3 - ---------, 1/3 + ----------, ---------- + 1/3], 9 9 9 4 epsilon 2 epsilon 4 epsilon [1, 1/3 - ---------, 2/3 - ---------, 2/3 + ---------], 9 9 9 [1, 2, 2 epsilon, 1] [[0, 0, 0, 0], [0, 0, 0, 0], [0, 0, 0, 0]] [1, 1, epsilon, epsilon], [1, 1 - epsilon, 1, 1 + epsilon], [1, 2, 2 epsilon, 1] [[0, 0, 0, 0], [0, 0, 0, 0], [0, 0, 0, 0]] > # ================================================== # Overconstrained 6R-chains # ================================================== > # We compute the new overconstrained 6R-chains contained in the # complete linkage. First, we check the closure condition for every t. # Then we compute distances, offsets and cosine of angles. > # Pairings that give new overconstrained 6R-chains: > pairs := [[1, 6], [2, 4], [3, 5]]: > for p in pairs do > i := p[1]: j := p[2]: > L := [H3[i], H2[i], H1[i], > Cj(H1[j]), Cj(H2[j]), Cj(H3[j])]: > print("----------------------------------------"): > print(L); # linkage > print(Mulall(op(L))); # should be real number > print(ldists(L)): # distances > print(offsets(L)): # offsets > print(map(cos, langs(L))): # angles > od: "----------------------------------------" 12 72 epsilon 210 epsilon 8 epsilon [[1, -- + ----------, ----------- - 4/13, 3/13 - ---------], 13 169 169 169 395 94035 epsilon 319 53380 epsilon 41995 epsilon 479 [1, --- - -------------, --- + -------------, ------------- + ---], 403 162409 403 162409 162409 403 65 814 epsilon 16 1373 epsilon 1719 epsilon 18 [1, -- - -----------, -- + ------------, ------------ + --], 31 961 31 961 961 31 [1, -1, -epsilon, -epsilon], [1, -1 + epsilon, -1, -1 - epsilon], [1, -2, -2 epsilon, -1]] [48, 0, 0, 0] 1/2 1/2 1/2 1/2 1/2 1/2 16 29 1115179082 37 854 24 145 2 6 [--------, -------------, ---------, ---------, ----, ----] 377 63302 1586 899 2 6 1/2 1/2 1/2 1/2 7945 38174 3 545 5 2 3 11 5 [-----, ----------, --------, 7/58, ------, -------] 59218 62281 3538 3 58 1/2 1/2 1/2 1/2 1/2 1/2 27 5 29 3 41 15 13 5 3 15 [-------, -------, --------, -------, ----, -----] 65 93 195 31 3 5 "----------------------------------------" 12 72 epsilon 210 epsilon 8 epsilon [[1, -- + ----------, ----------- - 4/13, 3/13 - ---------], 13 169 169 169 55 1324 epsilon 38 814 epsilon 748 epsilon 56 [1, -- - ------------, -- + -----------, ----------- + --], 39 1521 39 1521 1521 39 5 epsilon 11 epsilon 14 epsilon [1, 5/3 - ---------, 1/3 + ----------, ---------- + 1/3], 9 9 9 [1, -1, -epsilon, -epsilon], 59 epsilon 13 epsilon 54 epsilon [1, - 10/7 + ----------, - 8/7 - ----------, - ---------- - 9/7], 49 49 49 10 epsilon 85 epsilon 5 epsilon [1, - 11/7 - ----------, - ---------- + 1/7, - 5/7 + ---------]] 49 49 49 [48, 0, 0, 0] 1/2 1/2 1/2 1/2 1/2 1/2 1115179082 8 29 37 854 2 12 145 6 [-------------, -------, ---------, ----, ---------, ----] 185822 87 1586 6 203 6 1/2 1/2 1/2 1/2 7945 1765 5 16 3 31 5 968 3 [-----, ---------, -------, 7/58, -------, --------] 59218 3538 61 58 3063 1/2 1/2 1/2 1/2 1/2 1/2 151 3 4 5 41 15 5 3 2 5 15 [--------, ------, --------, ------, ------, -----] 273 15 195 9 7 5 "----------------------------------------" 10 epsilon 85 epsilon 5 epsilon [[1, 11/7 + ----------, ---------- - 1/7, 5/7 - ---------], 49 49 49 72 16813 epsilon 136 7695 epsilon 14752 epsilon 153 [1, --- - -------------, --- - ------------, ------------- + ---], 217 47089 217 47089 47089 217 65 814 epsilon 16 1373 epsilon 1719 epsilon 18 [1, -- - -----------, -- + ------------, ------------ + --], 31 961 31 961 961 31 5 epsilon 11 epsilon 14 epsilon [1, - 5/3 + ---------, - 1/3 - ----------, - ---------- - 1/3], 9 9 9 4 epsilon 2 epsilon 4 epsilon [1, - 1/3 + ---------, - 2/3 + ---------, - 2/3 - ---------], 9 9 9 [1, -2, -2 epsilon, -1]] [48, 0, 0, 0] 1/2 1/2 1/2 1/2 1/2 1/2 6 1115179082 12 145 37 854 2 8 29 [----, -------------, ---------, ---------, ----, -------] 42 63302 203 11346 2 87 1/2 1/2 1/2 1/2 968 3 53315 545 5 16 3 53 11 5 [--------, -----, --------, -------, --, -------] 3063 59218 3538 61 58 58 1/2 1/2 1/2 1/2 1/2 1/2 9 15 29 3 2 5 359 15 3 4 5 [-------, -------, ------, ---------, ----, ------] 35 93 7 1395 3 15 > > > quit memory used=12.7MB, alloc=13.0MB, time=0.17