NORMFORM.LOG 35 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301
  1. REDUCE 3.6, 15-Jul-95, patched to 6 Mar 96 ...
  2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3. % %
  4. % Examples of calculations of matrix normal forms using the REDUCE %
  5. % NORMFORM package. %
  6. % %
  7. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  8. load_package normform;
  9. on errcont;
  10. % So that computation continues after an error.
  11. %
  12. % If using xr, the X interface for REDUCE, then turn on looking_good to
  13. % improve the appearance of the output.
  14. %
  15. fluid '(options!*);
  16. lisp if memq('fmprint ,options!*) then on looking_good;
  17. procedure test(tmp,A);
  18. %
  19. % Checks that P * N * P^-1 = A where tmp is the output {P,N,P^-1}
  20. % of the Normal form calculation on A.
  21. %
  22. begin
  23. if second tmp * first tmp * third tmp = A then
  24. write "Seems O.K." else rederr "something isn't working.";
  25. end;
  26. test
  27. %%%%%%%%%%%%%%%%%%%%%%%%%%%% Smithex %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  28. A := mat((3*x,x^2+x),(0,x^2));
  29. [3*x x*(x + 1)]
  30. [ ]
  31. a := [ 2 ]
  32. [ 0 x ]
  33. answer := smithex(A,x);
  34. answer := {
  35. [x 0 ]
  36. [ ]
  37. [ 2]
  38. [0 x ]
  39. ,
  40. [1 0]
  41. [ ]
  42. [x 1]
  43. ,
  44. [3 x + 1]
  45. [ ]
  46. [-3 - x ]
  47. }
  48. test(answer,A);
  49. Seems O.K.
  50. %
  51. % Extend algebraic field to include sqrt2.
  52. %
  53. load_package arnum;
  54. defpoly sqrt2**2-2;
  55. A := mat((sqrt2*y^2,y+1),(3*sqrt2,y^3+y*sqrt2));
  56. [ 2 ]
  57. [sqrt2*y y + 1 ]
  58. a := [ ]
  59. [ 2 ]
  60. [3*sqrt2 y*(y + sqrt2)]
  61. answer := smithex(A,y);
  62. answer := {
  63. [1 0 ]
  64. [ ]
  65. [ 5 3 ]
  66. [0 y + sqrt2*y - 3*y - 3]
  67. ,
  68. [ 2 1 ]
  69. [sqrt2*y ---*sqrt2]
  70. [ 6 ]
  71. [ ]
  72. [3*sqrt2 0 ]
  73. ,
  74. [ 1 2 ]
  75. [1 ---*sqrt2*y*(y + sqrt2)]
  76. [ 6 ]
  77. [ ]
  78. [0 - sqrt2 ]
  79. }
  80. test(answer,A);
  81. Seems O.K.
  82. off arnum;
  83. %
  84. % smithex will compute the Smith normal form of matrices containing
  85. % only integer entries but the integers are regarded as univariate
  86. % polynomials in x over a field F (the rationals unless the field has
  87. % been extended). For calculations over the integers use smithex_int.
  88. %
  89. A := mat((9,-36,30),(-36,192,-180),(30,-180,180));
  90. [ 9 -36 30 ]
  91. [ ]
  92. a := [-36 192 -180]
  93. [ ]
  94. [30 -180 180 ]
  95. answer := smithex(A,x);
  96. *** WARNING: all matrix entries are integers.
  97. If calculations in Z(the integers) are required, use smithex_int.
  98. answer := {
  99. [1 0 0]
  100. [ ]
  101. [0 1 0]
  102. [ ]
  103. [0 0 1]
  104. ,
  105. [ 1 ]
  106. [ 9 18 -----]
  107. [ 720 ]
  108. [ ]
  109. [-36 -24 0 ]
  110. [ ]
  111. [30 0 0 ]
  112. ,
  113. [1 -6 6 ]
  114. [ ]
  115. [ - 3 ]
  116. [0 1 ------]
  117. [ 2 ]
  118. [ ]
  119. [0 0 2160 ]
  120. }
  121. test(answer,A);
  122. Seems O.K.
  123. %%%%%%%%%%%%%%%%%%%%%%%%%%%% Smithex_int %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  124. A := mat((1,2,3),(4,5,6),(7,8,x));
  125. [1 2 3]
  126. [ ]
  127. a := [4 5 6]
  128. [ ]
  129. [7 8 x]
  130. answer := smithex_int(A);
  131. ***** ERROR: matrix contains non_integer entries. Try smithex.
  132. A := mat((9,-36,30),(-36,192,-180),(30,-180,180));
  133. [ 9 -36 30 ]
  134. [ ]
  135. a := [-36 192 -180]
  136. [ ]
  137. [30 -180 180 ]
  138. answer := smithex_int(A);
  139. answer := {
  140. [3 0 0 ]
  141. [ ]
  142. [0 12 0 ]
  143. [ ]
  144. [0 0 60]
  145. ,
  146. [-17 -5 -4 ]
  147. [ ]
  148. [64 19 15 ]
  149. [ ]
  150. [-50 -15 -12]
  151. ,
  152. [1 -24 30 ]
  153. [ ]
  154. [-1 25 -30]
  155. [ ]
  156. [0 -1 1 ]
  157. }
  158. test(answer,A);
  159. Seems O.K.
  160. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Frobenius %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  161. A := mat(((y+y^2-x^2)/y,(x-x^2-y+y^2)/y,(x^2-y^2)/y),(1+x+y,
  162. (x-y+y^2+x*y)/y,-x-y),((y-x+y^2-x^2)/y,(x-y+y^2-x^2)/y,
  163. (x+x^2-y^2)/y));
  164. [ 2 2 2 2 2 2 ]
  165. [ - x + y + y - x + x + y - y x - y ]
  166. [ ---------------- -------------------- --------- ]
  167. [ y y y ]
  168. [ ]
  169. [ 2 ]
  170. [ x*y + x + y - y ]
  171. a := [ x + y + 1 ------------------ - (x + y) ]
  172. [ y ]
  173. [ ]
  174. [ 2 2 2 2 2 2 ]
  175. [ - x - x + y + y - x + x + y - y x + x - y ]
  176. [-------------------- -------------------- -------------]
  177. [ y y y ]
  178. answer := frobenius(A);
  179. answer := {
  180. [ x ]
  181. [--- 0 0 ]
  182. [ y ]
  183. [ ]
  184. [ - x*(x + y) ]
  185. [ 0 0 --------------]
  186. [ y ]
  187. [ ]
  188. [ 2 ]
  189. [ x*y + x + y ]
  190. [ 0 1 --------------]
  191. [ y ]
  192. ,
  193. 3 2 2 2 2 2 2
  194. - x - 2*x *y - x - x*y + x*y + 2*y + y x - y - y
  195. mat((---------------------------------------------,-1,-------------),
  196. y*(x + y + 1) y
  197. (x + y + 1,0, - (x + y + 1)),
  198. 2 2 2 2
  199. - x - x + y + 2*y x + x - y - y
  200. (----------------------,0,-----------------))
  201. y y
  202. ,
  203. [ x - y ]
  204. [0 ------- 1 ]
  205. [ y ]
  206. [ ]
  207. [ 3 2 2 2 3 2 2 2 ]
  208. [ - x - x *y - x + x*y + y + y + y - x - 2*x*y - y ]
  209. [-1 ---------------------------------------- --------------------]
  210. [ y*(x + y + 1) x + y + 1 ]
  211. [ ]
  212. [ 2 2 ]
  213. [ x + x - y - 2*y ]
  214. [0 ------------------- 1 ]
  215. [ y*(x + y + 1) ]
  216. }
  217. test(answer,A);
  218. Seems O.K.
  219. %
  220. % Extend algebraic field to include i.
  221. %
  222. load_package arnum;
  223. defpoly i^2+1;
  224. A := mat((-3-i,1,2+i,7-9*i),(-2,1,1,5-i),(-2-2*i,1,2+2*i,4-2*i),
  225. (2,0,-1,-2+8*i));
  226. [ - (i + 3) 1 i + 2 - (9*i - 7)]
  227. [ ]
  228. [ -2 1 1 - (i - 5) ]
  229. a := [ ]
  230. [ - (2*i + 2) 1 2*i + 2 - (2*i - 4)]
  231. [ ]
  232. [ 2 0 -1 8*i - 2 ]
  233. answer := frobenius(A);
  234. answer := {
  235. [i + 1 0 0 0 ]
  236. [ ]
  237. [ 0 0 0 7*i - 3 ]
  238. [ ]
  239. [ 0 1 0 - (8*i - 9)]
  240. [ ]
  241. [ 0 0 1 8*i - 3 ]
  242. ,
  243. [ 425 189 ]
  244. [-----*i + ----- -1 i + 3 18*i - 18 ]
  245. [ 106 106 ]
  246. [ ]
  247. [ 634 258 ]
  248. [-----*i + ----- 0 2 2*i - 12 ]
  249. [ 53 53 ]
  250. [ ]
  251. [ 150 588 ]
  252. [-----*i - ----- 0 2*i + 2 4*i - 10 ]
  253. [ 53 53 ]
  254. [ ]
  255. [ 108 7 ]
  256. [-----*i + ---- 0 -2 - (16*i - 8)]
  257. [ 53 53 ]
  258. ,
  259. mat((0, - i,1,1),
  260. 143 268 263 152 491 155
  261. (-1, - (-----*i - -----),-----*i + -----,-----*i + -----),
  262. 53 53 53 53 106 106
  263. 339 368 392 383 370 189
  264. (0, - (-----*i + -----), - (-----*i - -----), - (-----*i - -----)
  265. 106 53 53 106 53 53
  266. ),
  267. 101 9 7 54
  268. (0, - (-----*i + -----), - (-----*i - ----),1))
  269. 106 106 106 53
  270. }
  271. off arnum;
  272. A := mat((10,-5,-5,8,3,0),(-4,2,-10,-7,-5,-5),(-8,2,7,3,7,5),
  273. (-6,-7,-7,-7,10,7),(-4,-3,-3,-6,8,-9),(-2,5,-5,9,7,-4));
  274. [10 -5 -5 8 3 0 ]
  275. [ ]
  276. [-4 2 -10 -7 -5 -5]
  277. [ ]
  278. [-8 2 7 3 7 5 ]
  279. a := [ ]
  280. [-6 -7 -7 -7 10 7 ]
  281. [ ]
  282. [-4 -3 -3 -6 8 -9]
  283. [ ]
  284. [-2 5 -5 9 7 -4]
  285. F := first frobenius(A);
  286. [0 0 0 0 0 -867960]
  287. [ ]
  288. [1 0 0 0 0 -466370]
  289. [ ]
  290. [0 1 0 0 0 47845 ]
  291. f := [ ]
  292. [0 0 1 0 0 -712 ]
  293. [ ]
  294. [0 0 0 1 0 -95 ]
  295. [ ]
  296. [0 0 0 0 1 16 ]
  297. %
  298. % Calculate in Z\23Z...
  299. %
  300. on modular;
  301. setmod 23;
  302. 1
  303. F_mod := first frobenius(A);
  304. [0 17 0 0 0 0 ]
  305. [ ]
  306. [1 19 0 0 0 0 ]
  307. [ ]
  308. [0 0 0 0 0 10]
  309. f_mod := [ ]
  310. [0 0 1 0 0 5 ]
  311. [ ]
  312. [0 0 0 1 0 15]
  313. [ ]
  314. [0 0 0 0 1 20]
  315. %
  316. % ...and with a balanced modular representation.
  317. %
  318. on balanced_mod;
  319. F_bal_mod := first frobenius(A);
  320. [0 - 6 0 0 0 0 ]
  321. [ ]
  322. [1 - 4 0 0 0 0 ]
  323. [ ]
  324. [0 0 0 0 0 10 ]
  325. f_bal_mod := [ ]
  326. [0 0 1 0 0 5 ]
  327. [ ]
  328. [0 0 0 1 0 - 8]
  329. [ ]
  330. [0 0 0 0 1 - 3]
  331. off balanced_mod;
  332. off modular;
  333. %%%%%%%%%%%%%%%%%%%%%%%%%%% Ratjordan %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  334. A := mat(((y+y^2-x^2)/y,(x-x^2-y+y^2)/y,(x^2-y^2)/y),(1+x+y,
  335. (x-y+y^2+x*y)/y,-x-y),((y-x+y^2-x^2)/y,(x-y+y^2-x^2)/y,
  336. (x+x^2-y^2)/y));
  337. [ 2 2 2 2 2 2 ]
  338. [ - x + y + y - x + x + y - y x - y ]
  339. [ ---------------- -------------------- --------- ]
  340. [ y y y ]
  341. [ ]
  342. [ 2 ]
  343. [ x*y + x + y - y ]
  344. a := [ x + y + 1 ------------------ - (x + y) ]
  345. [ y ]
  346. [ ]
  347. [ 2 2 2 2 2 2 ]
  348. [ - x - x + y + y - x + x + y - y x + x - y ]
  349. [-------------------- -------------------- -------------]
  350. [ y y y ]
  351. answer := ratjordan(A);
  352. answer := {
  353. [ x ]
  354. [--- 0 0 ]
  355. [ y ]
  356. [ ]
  357. [ x ]
  358. [ 0 --- 0 ]
  359. [ y ]
  360. [ ]
  361. [ 0 0 x + y]
  362. ,
  363. 3 2 2 2 2 2
  364. - x - 2*x *y - x - x*y + x*y + 2*y + y - x - x*y + y
  365. mat((---------------------------------------------,-----------------,
  366. y*(x + y + 1) 2
  367. x*y - x + y
  368. 2 2
  369. x + x - y - y
  370. -----------------),
  371. 2
  372. x*y - x + y
  373. y*(x + y + 1) - y*(x + y + 1)
  374. (x + y + 1,---------------,------------------),
  375. 2 2
  376. x*y - x + y x*y - x + y
  377. 2 2 2 2 2 2
  378. - x - x + y + 2*y - x - x + y + y x + x - y - y
  379. (----------------------,--------------------,-----------------))
  380. y 2 2
  381. x*y - x + y x*y - x + y
  382. ,
  383. x - y
  384. mat((0,-------,1),
  385. y
  386. 3 3 2 2 2 2 3 2 4 3 2
  387. - x *y + x - x *y - x *y + x + x*y - x*y - 2*x*y + y + y + y
  388. (-1,-----------------------------------------------------------------------,
  389. 2
  390. y *(x + y + 1)
  391. 2 2 2 3
  392. - x *y + x - 2*x*y + x*y + x - y
  393. --------------------------------------),
  394. y*(x + y + 1)
  395. - x - y + 1 x + y
  396. (-1,--------------,-----------))
  397. x + y + 1 x + y + 1
  398. }
  399. test(answer,A);
  400. Seems O.K.
  401. %
  402. % Extend algebraic field to include sqrt(2).
  403. %
  404. load_package arnum;
  405. defpoly sqrt2**2-2;
  406. A:= mat((4*sqrt2-6,-4*sqrt2+7,-3*sqrt2+6),(3*sqrt2-6,-3*sqrt2+7,
  407. -3*sqrt2+6),(3*sqrt2,1-3sqrt2,-2*sqrt2));
  408. [4*sqrt2 - 6 - (4*sqrt2 - 7) - (3*sqrt2 - 6)]
  409. [ ]
  410. a := [3*sqrt2 - 6 - (3*sqrt2 - 7) - (3*sqrt2 - 6)]
  411. [ ]
  412. [ 3*sqrt2 - (3*sqrt2 - 1) - 2*sqrt2 ]
  413. answer := ratjordan(A);
  414. answer := {
  415. [sqrt2 0 0 ]
  416. [ ]
  417. [ 0 sqrt2 0 ]
  418. [ ]
  419. [ 0 0 - (3*sqrt2 - 1)]
  420. ,
  421. [ 21 49 21 18 ]
  422. [7*sqrt2 - 6 ----*sqrt2 - ---- - (----*sqrt2 - ----)]
  423. [ 31 31 31 31 ]
  424. [ ]
  425. [ 21 18 21 18 ]
  426. [3*sqrt2 - 6 ----*sqrt2 - ---- - (----*sqrt2 - ----)]
  427. [ 31 31 31 31 ]
  428. [ ]
  429. [ 3 24 3 24 ]
  430. [3*sqrt2 + 1 - (----*sqrt2 + ----) ----*sqrt2 + ---- ]
  431. [ 31 31 31 31 ]
  432. ,
  433. [0 sqrt2 + 1 1 ]
  434. [ ]
  435. [-1 4*sqrt2 + 9 4*sqrt2]
  436. [ ]
  437. [ 1 ]
  438. [-1 - (---*sqrt2 - 1) 1 ]
  439. [ 6 ]
  440. }
  441. test(answer,A);
  442. Seems O.K.
  443. off arnum;
  444. A := mat((-12752,-6285,-9457,-7065,-4939,-5865,-3769),(13028,6430,
  445. 9656, 7213,5041,5984,3841),(16425,8080,12192,9108,6370,7569,
  446. 4871), (-6065,-2979,-4508,-3364,-2354,-2801,-1803),(2968,
  447. 1424,2231, 1664,1171,1404,919),(-22762,-11189,-16902,-12627,
  448. -8833, -10498,-6760),(23112,11400,17135,12799,8946,10622,
  449. 6821));
  450. [-12752 -6285 -9457 -7065 -4939 -5865 -3769]
  451. [ ]
  452. [13028 6430 9656 7213 5041 5984 3841 ]
  453. [ ]
  454. [16425 8080 12192 9108 6370 7569 4871 ]
  455. [ ]
  456. a := [-6065 -2979 -4508 -3364 -2354 -2801 -1803]
  457. [ ]
  458. [ 2968 1424 2231 1664 1171 1404 919 ]
  459. [ ]
  460. [-22762 -11189 -16902 -12627 -8833 -10498 -6760]
  461. [ ]
  462. [23112 11400 17135 12799 8946 10622 6821 ]
  463. R := first ratjordan(A);
  464. [0 2 0 0 0 0 0 ]
  465. [ ]
  466. [1 0 0 0 0 0 0 ]
  467. [ ]
  468. [0 0 0 0 0 0 5 ]
  469. [ ]
  470. r := [0 0 1 0 0 0 0 ]
  471. [ ]
  472. [0 0 0 1 0 0 -2]
  473. [ ]
  474. [0 0 0 0 1 0 3 ]
  475. [ ]
  476. [0 0 0 0 0 1 0 ]
  477. %
  478. % Calculate in Z/23Z...
  479. %
  480. on modular;
  481. setmod 23;
  482. 23
  483. R_mod := first ratjordan(A);
  484. [19 0 0 0 0 0 0 ]
  485. [ ]
  486. [0 18 0 0 0 0 0 ]
  487. [ ]
  488. [0 0 17 0 0 0 0 ]
  489. [ ]
  490. r_mod := [0 0 0 5 0 0 0 ]
  491. [ ]
  492. [0 0 0 0 0 0 5 ]
  493. [ ]
  494. [0 0 0 0 1 0 19]
  495. [ ]
  496. [0 0 0 0 0 1 10]
  497. %
  498. % ...and with a balanced modular representation.
  499. %
  500. on balanced_mod;
  501. R_bal_mod := first ratjordan(A);
  502. [ - 4 0 0 0 0 0 0 ]
  503. [ ]
  504. [ 0 - 5 0 0 0 0 0 ]
  505. [ ]
  506. [ 0 0 - 6 0 0 0 0 ]
  507. [ ]
  508. r_bal_mod := [ 0 0 0 5 0 0 0 ]
  509. [ ]
  510. [ 0 0 0 0 0 0 5 ]
  511. [ ]
  512. [ 0 0 0 0 1 0 - 4]
  513. [ ]
  514. [ 0 0 0 0 0 1 10 ]
  515. off balanced_mod;
  516. off modular;
  517. %%%%%%%%%%%%%%%%%%%%%%%%%%% jordansymbolic %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  518. A := mat(((y+y^2-x^2)/y,(x-x^2-y+y^2)/y,(x^2-y^2)/y),(1+x+y,
  519. (x-y+y^2+x*y)/y,-x-y),((y-x+y^2-x^2)/y,(x-y+y^2-x^2)/y,
  520. (x+x^2-y^2)/y));
  521. [ 2 2 2 2 2 2 ]
  522. [ - x + y + y - x + x + y - y x - y ]
  523. [ ---------------- -------------------- --------- ]
  524. [ y y y ]
  525. [ ]
  526. [ 2 ]
  527. [ x*y + x + y - y ]
  528. a := [ x + y + 1 ------------------ - (x + y) ]
  529. [ y ]
  530. [ ]
  531. [ 2 2 2 2 2 2 ]
  532. [ - x - x + y + y - x + x + y - y x + x - y ]
  533. [-------------------- -------------------- -------------]
  534. [ y y y ]
  535. answer := jordansymbolic(A);
  536. answer := {
  537. [ x ]
  538. [--- 0 0 ]
  539. [ y ]
  540. [ ]
  541. [ x ]
  542. [ 0 --- 0 ]
  543. [ y ]
  544. [ ]
  545. [ 0 0 x + y]
  546. ,
  547. lambda*y - x
  548. {{--------------,lambda - x - y},
  549. y
  550. lambda},
  551. 3 2 2 2 2 2
  552. - x - 2*x *y - x - x*y + x*y + 2*y + y - x - x*y + y
  553. mat((---------------------------------------------,-----------------,
  554. y*(x + y + 1) 2
  555. x*y - x + y
  556. 2 2
  557. x + x - y - y
  558. -----------------),
  559. 2
  560. x*y - x + y
  561. y*(x + y + 1) - y*(x + y + 1)
  562. (x + y + 1,---------------,------------------),
  563. 2 2
  564. x*y - x + y x*y - x + y
  565. 2 2 2 2 2 2
  566. - x - x + y + 2*y - x - x + y + y x + x - y - y
  567. (----------------------,--------------------,-----------------))
  568. y 2 2
  569. x*y - x + y x*y - x + y
  570. ,
  571. x - y
  572. mat((0,-------,1),
  573. y
  574. 3 3 2 2 2 2 3 2 4 3 2
  575. - x *y + x - x *y - x *y + x + x*y - x*y - 2*x*y + y + y + y
  576. (-1,-----------------------------------------------------------------------,
  577. 2
  578. y *(x + y + 1)
  579. 2 2 2 3
  580. - x *y + x - 2*x*y + x*y + x - y
  581. --------------------------------------),
  582. y*(x + y + 1)
  583. - x - y + 1 x + y
  584. (-1,--------------,-----------))
  585. x + y + 1 x + y + 1
  586. }
  587. %
  588. % Extend algebraic field.
  589. %
  590. load_package arnum;
  591. defpoly b^3-2*b+b-5;
  592. A := mat((1-b,2+b^2),(3+b-2*b^2,3));
  593. [ 2 ]
  594. [ - (b - 1) b + 2]
  595. a := [ ]
  596. [ 2 ]
  597. [ - (2*b - b - 3) 3 ]
  598. answer := jordansymbolic(A);
  599. answer := {
  600. [lambda11 0 ]
  601. [ ]
  602. [ 0 lambda12]
  603. ,
  604. 2 2
  605. {{lambda + (b - 4)*lambda + 3*b + 4*b - 8},lambda},
  606. [ lambda11 - 3 lambda12 - 3 ]
  607. [ ]
  608. [ 2 2 ]
  609. [ - (2*b - b - 3) - (2*b - b - 3)]
  610. ,
  611. 1966 2 3514 1054 1
  612. mat(( - (--------*b + --------*b - --------)*(lambda11 + ---*b - 2),
  613. 239891 239891 239891 2
  614. 127472 2 236383 82923
  615. (----------*b + ----------*b + ---------)
  616. 29986375 29986375 5997275
  617. 26 2 107 45
  618. *(lambda11 + ----*b - -----*b + ----)),
  619. 11 11 11
  620. 1966 2 3514 1054 1
  621. ( - (--------*b + --------*b - --------)*(lambda12 + ---*b - 2),
  622. 239891 239891 239891 2
  623. 127472 2 236383 82923
  624. (----------*b + ----------*b + ---------)
  625. 29986375 29986375 5997275
  626. 26 2 107 45
  627. *(lambda12 + ----*b - -----*b + ----)))
  628. 11 11 11
  629. }
  630. off arnum;
  631. A := mat((-9,21,-15,4,2,0),(-10,21,-14,4,2,0),(-8,16,-11,4,2,0),
  632. (-6,12,-9,3,3,0),(-4,8,-6,0,5,0),(-2,4,-3,0,1,3));
  633. [-9 21 -15 4 2 0]
  634. [ ]
  635. [-10 21 -14 4 2 0]
  636. [ ]
  637. [-8 16 -11 4 2 0]
  638. a := [ ]
  639. [-6 12 -9 3 3 0]
  640. [ ]
  641. [-4 8 -6 0 5 0]
  642. [ ]
  643. [-2 4 -3 0 1 3]
  644. answer := jordansymbolic(A);
  645. answer := {
  646. [3 0 0 0 0 0 ]
  647. [ ]
  648. [0 3 0 0 0 0 ]
  649. [ ]
  650. [0 0 1 1 0 0 ]
  651. [ ]
  652. [0 0 0 1 0 0 ]
  653. [ ]
  654. [0 0 0 0 lambda31 0 ]
  655. [ ]
  656. [0 0 0 0 0 lambda32]
  657. ,
  658. 2
  659. {{lambda - 3,lambda - 1,lambda - 4*lambda + 5},lambda},
  660. [ - 3 1 6*lambda31 - 17 6*lambda32 - 17 ]
  661. [3 ------ 1 --- ----------------- ----------------- ]
  662. [ 8 4 2 2 ]
  663. [ ]
  664. [ - 3 1 5*(lambda31 - 3) 5*(lambda32 - 3) ]
  665. [3 ------ 1 --- ------------------ ------------------]
  666. [ 8 4 2 2 ]
  667. [ ]
  668. [ - 3 1 ]
  669. [3 ------ 1 --- 2*(lambda31 - 3) 2*(lambda32 - 3) ]
  670. [ 8 4 ]
  671. [ ]
  672. [ - 3 3 3 3*(lambda31 - 3) 3*(lambda32 - 3) ]
  673. [3 ------ --- --- ------------------ ------------------]
  674. [ 8 4 8 2 2 ]
  675. [ ]
  676. [ - 3 1 1 ]
  677. [3 ------ --- --- lambda31 - 3 lambda32 - 3 ]
  678. [ 8 2 4 ]
  679. [ ]
  680. [ - 1 1 1 lambda31 - 3 lambda32 - 3 ]
  681. [2 ------ --- --- -------------- -------------- ]
  682. [ 8 4 8 2 2 ]
  683. ,
  684. [ - 1 ]
  685. [ 0 0 0 ------ 0 1]
  686. [ 3 ]
  687. [ ]
  688. [ 8 ]
  689. [ 0 0 0 --- -8 8]
  690. [ 3 ]
  691. [ ]
  692. [ 0 -4 6 0 -2 0]
  693. [ ]
  694. [ 0 0 -4 8 -4 0]
  695. [ ]
  696. [ - lambda31 + 3 lambda31 - 4 1 0 0 0]
  697. [ ]
  698. [ - lambda32 + 3 lambda32 - 4 1 0 0 0]
  699. }
  700. % Check to see if looking_good (*) is on as the choice of using
  701. % either lambda or xi is dependent upon this.
  702. % (* -> the use of looking_good is described in the manual.).
  703. if not lisp !*looking_good then
  704. <<
  705. %
  706. % NB: we use lambda_ in solve (instead of lambda) as lambda is used
  707. % for other purposes in REDUCE which mean it cannot be used with
  708. % solve.
  709. %
  710. solve(lambda_^2-4*lambda_+5,lambda_);
  711. J := sub({lambda31=i + 2,lambda32= - i + 2},first answer);
  712. P := sub({lambda31=i + 2,lambda32= - i + 2},third answer);
  713. Pinv :=sub({lambda31=i + 2,lambda32= - i + 2},third rest answer);
  714. >>
  715. else
  716. <<
  717. solve(xi^2-4*xi+5,xi);
  718. J := sub({xi(3,1)=i + 2,xi(3,2)= - i + 2},first answer);
  719. P := sub({xi(3,1)=i + 2,xi(3,2)= - i + 2},third answer);
  720. Pinv := sub({xi(3,1)=i + 2,xi(3,2)= - i + 2},third rest answer);
  721. >>;
  722. test({J,P,Pinv},A);
  723. Seems O.K.
  724. %
  725. % Calculate in Z/23Z...
  726. %
  727. on modular;
  728. setmod 23;
  729. 23
  730. answer := jordansymbolic(A)$
  731. J_mod := {first answer, second answer};
  732. j_mod := {
  733. [3 0 0 0 0 0 ]
  734. [ ]
  735. [0 3 0 0 0 0 ]
  736. [ ]
  737. [0 0 1 1 0 0 ]
  738. [ ]
  739. [0 0 0 1 0 0 ]
  740. [ ]
  741. [0 0 0 0 lambda31 0 ]
  742. [ ]
  743. [0 0 0 0 0 lambda32]
  744. ,
  745. 2
  746. {{lambda + 20,lambda + 22,lambda + 19*lambda + 5},lambda}}
  747. %
  748. % ...and with a balanced modular representation.
  749. %
  750. on balanced_mod;
  751. answer := jordansymbolic(A)$
  752. J_bal_mod := {first answer, second answer};
  753. j_bal_mod := {
  754. [3 0 0 0 0 0 ]
  755. [ ]
  756. [0 3 0 0 0 0 ]
  757. [ ]
  758. [0 0 1 1 0 0 ]
  759. [ ]
  760. [0 0 0 1 0 0 ]
  761. [ ]
  762. [0 0 0 0 lambda31 0 ]
  763. [ ]
  764. [0 0 0 0 0 lambda32]
  765. ,
  766. 2
  767. {{lambda - 3,lambda - 1,lambda - 4*lambda + 5},lambda}}
  768. off balanced_mod;
  769. off modular;
  770. %%%%%%%%%%%%%%%%%%%%%%%%%%%% jordan %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  771. A := mat((1,y),(y^2,3));
  772. [1 y]
  773. [ ]
  774. a := [ 2 ]
  775. [y 3]
  776. answer := jordan(A);
  777. answer := {
  778. [ 3 ]
  779. [sqrt(y + 1) + 2 0 ]
  780. [ ]
  781. [ 3 ]
  782. [ 0 - sqrt(y + 1) + 2]
  783. ,
  784. [ 3 3 ]
  785. [sqrt(y + 1) - 1 - (sqrt(y + 1) + 1)]
  786. [ ]
  787. [ 2 2 ]
  788. [ y y ]
  789. ,
  790. [ 3 3 3 ]
  791. [ sqrt(y + 1) sqrt(y + 1) + y + 1 ]
  792. [ -------------- ----------------------- ]
  793. [ 3 2 3 ]
  794. [ 2*(y + 1) 2*y *(y + 1) ]
  795. [ ]
  796. [ 3 3 3 ]
  797. [ - sqrt(y + 1) - sqrt(y + 1) + y + 1 ]
  798. [----------------- --------------------------]
  799. [ 3 2 3 ]
  800. [ 2*(y + 1) 2*y *(y + 1) ]
  801. }
  802. test(answer,A);
  803. Seems O.K.
  804. A := mat((-12752,-6285,-9457,-7065,-4939,-5865,-3769),(13028,6430,
  805. 9656, 7213,5041,5984,3841),(16425,8080,12192,9108,6370,7569,
  806. 4871), (-6065,-2979,-4508,-3364,-2354,-2801,-1803),(2968,
  807. 1424,2231, 1664,1171,1404,919),(-22762,-11189,-16902,-12627,
  808. -8833, -10498,-6760),(23112,11400,17135,12799,8946,10622,
  809. 6821));
  810. [-12752 -6285 -9457 -7065 -4939 -5865 -3769]
  811. [ ]
  812. [13028 6430 9656 7213 5041 5984 3841 ]
  813. [ ]
  814. [16425 8080 12192 9108 6370 7569 4871 ]
  815. [ ]
  816. a := [-6065 -2979 -4508 -3364 -2354 -2801 -1803]
  817. [ ]
  818. [ 2968 1424 2231 1664 1171 1404 919 ]
  819. [ ]
  820. [-22762 -11189 -16902 -12627 -8833 -10498 -6760]
  821. [ ]
  822. [23112 11400 17135 12799 8946 10622 6821 ]
  823. on rounded;
  824. J := first jordan(A);
  825. *** Domain mode rounded changed to rational
  826. *** Domain mode rational changed to complex-rational
  827. *** Domain mode complex-rational changed to rational
  828. *** Domain mode rational changed to rounded
  829. j := mat((1.41421356237,0,0,0,0,0,0),
  830. (0, - 1.41421356237,0,0,0,0,0),
  831. (0,0, - 1.80491973207,0,0,0,0),
  832. (0,0,0, - 1.12491094597,0,0,0),
  833. (0,0,0,0,1.03588656373*i + 0.620319270571,0,0),
  834. (0,0,0,0,0, - 1.03588656373*i + 0.620319270571,0),
  835. (0,0,0,0,0,0,1.6891921369))
  836. off rounded;
  837. %
  838. % Extend algebraic field.
  839. %
  840. load_package arnum;
  841. defpoly b^3-2*b+b-5;
  842. A := mat((1-b,2+b^2),(3+b-2*b^2,3));
  843. [ 2 ]
  844. [ - (b - 1) b + 2]
  845. a := [ ]
  846. [ 2 ]
  847. [ - (2*b - b - 3) 3 ]
  848. J := first jordan(A);
  849. 11 2 1
  850. j := mat((sqrt(----*b + 6*b - 12)*i - (---*b - 2),0),
  851. 4 2
  852. 11 2 1
  853. (0, - (sqrt(----*b + 6*b - 12)*i + ---*b - 2)))
  854. 4 2
  855. off arnum;
  856. END;
  857. (TIME: normform 55819 60469)