aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2025-06-11 20:16:52 -04:00
parent 72eb4943cb
commit 4d5544505c
2347 changed files with 62432 additions and 16731 deletions
Download patch file Download diff file Expand all files Collapse all files

83
Task/Quaternion-type/REXX/quaternion-type.rexx
View file

@ -1,41 +1,42 @@
/*REXX program performs some operations on quaternion type numbers and displays results*/
q = 1 2 3 4 ; q1 = 2 3 4 5
r = 7 ; q2 = 3 4 5 6
call qShow q , 'q'
call qShow q1 , 'q1'
call qShow q2 , 'q2'
call qShow r , 'r'
call qShow qNorm(q) , 'norm q' , "task 1:"
call qShow qNeg(q) , 'negative q' , "task 2:"
call qShow qConj(q) , 'conjugate q' , "task 3:"
call qShow qAdd( r, q ) , 'addition r+q' , "task 4:"
call qShow qAdd(q1, q2 ) , 'addition q1+q2' , "task 5:"
call qShow qMul( q, r ) , 'multiplication q*r' , "task 6:"
call qShow qMul(q1, q2 ) , 'multiplication q1*q2' , "task 7:"
call qShow qMul(q2, q1 ) , 'multiplication q2*q1' , "task 8:"
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
qConj: procedure; parse arg x; call qXY; return x.1 (-x.2) (-x.3) (-x.4)
qNeg: procedure; parse arg x; call qXY; return -x.1 (-x.2) (-x.3) (-x.4)
qNorm: procedure; parse arg x; call qXY; return sqrt(x.1**2 +x.2**2 +x.3**2 +x.4**2)
qAdd: procedure; parse arg x,y; call qXY 2; return x.1+y.1 x.2+y.2 x.3+y.3 x.4+y.4
/*──────────────────────────────────────────────────────────────────────────────────────*/
qMul: procedure; parse arg x,y; call qXY y
return x.1*y.1 -x.2*y.2 -x.3*y.3 -x.4*y.4 x.1*y.2 +x.2*y.1 +x.3*y.4 -x.4*y.3 ,
x.1*y.3 -x.2*y.4 +x.3*y.1 +x.4*y.2 x.1*y.4 +x.2*y.3 -x.3*y.2 +x.4*y.1
/*──────────────────────────────────────────────────────────────────────────────────────*/
qShow: procedure; parse arg x; call qXY; $=
do m=1 for 4; _= x.m; if _==0 then iterate; if _>=0 then _= '+'_
if m\==1 then _= _ || substr('∙ijk', m, 1); $= strip($ || _, , "+")
end /*m*/
say left(arg(3), 9) right(arg(2), 20) ' ──► ' $; return $
/*──────────────────────────────────────────────────────────────────────────────────────*/
qXY: do n=1 for 4; x.n= word( word(x, n) 0, 1)/1; end /*n*/
if arg()==1 then do m=1 for 4; y.m= word( word(y, m) 0, 1)/1; end /*m*/; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0; d= digits(); i=; m.=9; h=d+6
numeric digits; numeric form; if x<0 then parse value -x 'i' with x i
parse value format(x, 2, 1, , 0) 'E0' with g "E" _ .; g= g *.5'e'_ % 2
do j=0 while h>9; m.j=h; h= h % 2 + 1; end /*j*/
do k=j+5 to 0 by -1; numeric digits m.k; g= (g + x/g)* .5; end /*k*/
numeric digits d; return (g/1)i /*make complex if X<0 */
-- 19 May 2025
include Settings
say 'QUATERNION TYPE'
say version
say
i = '0 1'; j = '0 0 1'; k = '0 0 0 1'
q = '1 2 3 4'; q1 = '2 3 4 5'; q2 = '3 4 5 6'; r = 7
say 'VALUES'
say 'i =' Hlst2Form(i)
say 'j =' Hlst2Form(j)
say 'k =' Hlst2Form(k)
say 'q =' Hlst2Form(q)
say 'q1 =' Hlst2Form(q1)
say 'q2 =' Hlst2Form(q2)
say 'r =' Hlst2Form(r)
say
say 'BASICS'
say 'i*i =' Hlst2Form(Hsquare(i))
say 'j*j =' Hlst2Form(Hsquare(j))
say 'k*k =' Hlst2Form(Hsquare(k))
say 'i*j*k =' Hlst2Form(Hmul(i,j,k))
say '||q|| =' Std(Hnorm(q))
say '-q =' Hlst2Form(Hneg(q))
say 'q* =' Hlst2Form(Hconj(q))
say 'q+r =' Hlst2Form(Hadd(q,r))
say 'r+q =' Hlst2Form(Hadd(r,q))
say 'q1+q2 =' Hlst2Form(Hadd(q1,q2))
say 'q2+q1 =' Hlst2Form(Hadd(q2,q1))
say 'q*r =' Hlst2Form(Hmul(q,r))
say 'r*q =' Hlst2Form(Hmul(r,q))
say 'q1*q2 =' Hlst2Form(Hmul(q1,q2))
say 'q2*q1 =' Hlst2Form(Hmul(q2,q1))
say
say 'BONUS'
say 'q/r =' Hlst2Form(Hdiv(q,r))
say '1/q =' Hlst2Form(Hinv(q))
exit
include Quaternion
include Functions
include Abend