|\^/| Maple 15 (IBM INTEL LINUX) ._|\| |/|_. Copyright (c) Maplesoft, a division of Waterloo Maple Inc. 2011 \ 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 . # # ======================================================================== # > > read("bonds.mpl"): > # define a Bennett linkage # ======================== > h1 := [0, 1, 0, 0]: > h2 := [0, 9*e, 1, -9*e]: > h3 := [0, -1/3-4*e, -2/3+4*e, 2/3+2*e]: > h4 := [0, 2/3+5*e, 1/3+4*e, 2/3-7*e]: > # sanity checks of input data > for i from 1 to 4 do > if Mul(h||i, Cj(h||i)) <> [1, 0, 0, 0] then > print("Error: Input quaternions are not normalized!"): > stop: > end if: > if h||i + Cj(h||i) <> [0, 0, 0, 0] then > print("Error: Input quaternions are not rotations quaternions!"): > stop: > end if: > od: > # Ideal of configuration curve # ============================ > > for i from 1 to 4 do > u||i := [t||i, 0, 0, 0] - h||i: > od: > eqs := RVec(Mulall(u1, u2, u3, u4)): > > es := {op(eqs[2..-1]), eqs[1]*u-1}: > vars := [t1, t2, u, t3, t4]: > Gb1 := Groebner[Basis]([op(es)], tdeg(t1, t2, u, t3, t4)): > egb := select(T->not (u in indets(T)), Gb1): > egb := Groebner[Basis]({op(egb)}, plex(t4, t3, t2, t1)): > configcurve := solve(egb, [t1, t2, t3, t4]); configcurve := [[t1 = -1 - t4, t2 = -t4, t3 = -1 - t4, t4 = t4]] > # parametrized equation of configuration curve > C := subs(t4 = -t, [rhs(configcurve[1][1]), > rhs(configcurve[1][2]), > rhs(configcurve[1][3]), > rhs(configcurve[1][4])]); C := [-1 + t, t, -1 + t, -t] > > for i from 1 to 4 do > U||i := [C[i], 0, 0, 0] - h||i: > od: > factor(Mulall(U1, U2, U3, U4)[1]); 2 2 -(t + 1) (-2 t + 2 + t ) > sol := [solve(%, t)]; sol := [I, -I, 1 + I, 1 - I] > > bonds := [seq(subs(t = sol[i], C), i=1..4)]; bonds := [[-1 + I, I, -1 + I, -I], [-1 - I, -I, -1 - I, I], [I, 1 + I, I, -1 - I], [-I, 1 - I, -I, -1 + I]] > # Verify vanishing of certain coupler polynomials: > u5 := u1: u6 := u2: u7 := u3: u8 := u4: > for j from 1 to nops(bonds) do > # assign(bonds[j]): > t1 := bonds[j][1]: > t2 := bonds[j][2]: > t3 := bonds[j][3]: > t4 := bonds[j][4]: > i := 1: > while (t||i^2 <> -1) do i := i + 1: od: > printf(" F_{%d,%d}(%a, %a, %a, %a) = %a\n\n", i, cc(i+2, 4), t1, t2, t3, t4, Mulall(seq(u||k, k=i..i+2))): > printf(" F_{%d,%d}(%a, %a, %a, %a) = %a\n\n", cc(i+2, 4), cc(i+4, 4), t1, t2, t3, t4, Mulall(seq(u||k, k=i+2..i+4))): > unassign('t1', 't2', 't3', 't4'): > od: F_{2,4}(-1+I, I, -1+I, -I) = [0, 0, 0, 0] F_{4,2}(-1+I, I, -1+I, -I) = [0, 0, 0, 0] F_{2,4}(-1-I, -I, -1-I, I) = [0, 0, 0, 0] F_{4,2}(-1-I, -I, -1-I, I) = [0, 0, 0, 0] F_{1,3}(I, 1+I, I, -1-I) = [0, 0, 0, 0] F_{3,1}(I, 1+I, I, -1-I) = [0, 0, 0, 0] F_{1,3}(-I, 1-I, -I, -1+I) = [0, 0, 0, 0] F_{3,1}(-I, 1-I, -I, -1+I) = [0, 0, 0, 0] > # Compute all local distances # =========================== > for j from 1 to nops(bonds) do > t1 := bonds[j][1]: > t2 := bonds[j][2]: > t3 := bonds[j][3]: > t4 := bonds[j][4]: > t0 := -t4: > printf("\n %a\n", map(simplify, subs(t = t0, C))): > for k from 1 to 4 do > for l from k+1 to 4 do > F||k||l := map(simplify, Mulall(seq([C[m], 0, 0, 0] - h||m, m=k+1..l))): > v||k||l := min(map(vanishingOrder, F||k||l, t, t0)): > d||k||l := 1/2*vanishingOrder(simplify(pNorm(F||k||l)), t, t0) - v||k||l: > printf(" d(%d,%d) = %a (v_{%d,%d}=%a)\n", k, l, d||k||l, k, l, v||k||l): > od: > od: > unassign('t0', 't1', 't2', 't3', 't4'): > od: [-1+I, I, -1+I, -I] d(1,2) = 1/2 (v_{1,2}=0) d(1,3) = 1/2 (v_{1,3}=0) d(1,4) = 0 (v_{1,4}=1) d(2,3) = 0 (v_{2,3}=0) d(2,4) = 1/2 (v_{2,4}=0) d(3,4) = 1/2 (v_{3,4}=0) [-1-I, -I, -1-I, I] d(1,2) = 1/2 (v_{1,2}=0) d(1,3) = 1/2 (v_{1,3}=0) d(1,4) = 0 (v_{1,4}=1) d(2,3) = 0 (v_{2,3}=0) d(2,4) = 1/2 (v_{2,4}=0) d(3,4) = 1/2 (v_{3,4}=0) [I, 1+I, I, -1-I] d(1,2) = 0 (v_{1,2}=0) d(1,3) = 1/2 (v_{1,3}=0) d(1,4) = 1/2 (v_{1,4}=0) d(2,3) = 1/2 (v_{2,3}=0) d(2,4) = 1/2 (v_{2,4}=0) d(3,4) = 0 (v_{3,4}=0) [-I, 1-I, -I, -1+I] d(1,2) = 0 (v_{1,2}=0) d(1,3) = 1/2 (v_{1,3}=0) d(1,4) = 1/2 (v_{1,4}=0) d(2,3) = 1/2 (v_{2,3}=0) d(2,4) = 1/2 (v_{2,4}=0) d(3,4) = 0 (v_{3,4}=0) > # Details of computation of d13 and bond (-1-I, -I, -1-I, I) # ========================================================== > t0 := -I: > for i from 1 to 4 do > t||i := subs(t = t0, C[i]): > od: > > F13 := map(factor, Mulall([C[2], 0, 0, 0] - h2, [C[3], 0, 0, 0] - h3)); 2 F13 := [-t + t + 5 epsilon + 2/3, 1/3 t - 5 epsilon t + 5 epsilon + 2/3, -1/3 t - 4 epsilon t - 3 epsilon + 1, -2/3 t + 7 epsilon t - 11 epsilon + 1/3] > map(simplify, subs(t = t0, F13)); [-1/3 + I + 5 epsilon, 2/3 - 1/3 I + 5 epsilon + 5 I epsilon, 1 + 1/3 I - 3 epsilon + 4 I epsilon, 1/3 + 2/3 I - 11 epsilon - 7 I epsilon ] > factor(pNorm(F13)); 2 2 (t + 1) (-2 t + 2 + t ) > v13 := min(map(vanishingOrder, F13, t, t0)); v13 := 0 > d13 := 1/2*vanishingOrder(simplify(pNorm(F13)), t, t0); d13 := 1/2 > d13 := d13 - v13; d13 := 1/2 > quit memory used=6.4MB, alloc=5.1MB, time=0.23