400 Reputation

6 years, 338 days

How to improve these procedures ?...

Maple 2018

Duo:=proc(a)  #a nombre congruent connu
local u,v,n,m,k,t:
t:=8000:
for m to t do
for n to m do
if (igcd(m,n)=1 and m>n) then
u:=(m^2-n^2-2*m*n)^2:v:=(m^2+n^2)^2:
k:=op(2,sqrt(v-u))^2: # k nombre congruent réduit
if k=a then return (m,n): break
elif n=t then break fi:
fi:
od:
od:
end:

Duo(30);
3, 2
Duo(1794);
26, 23
Duo(6);
2, 1
u, v, w sont des carrés en progression arithmétique dont la raison est un nombre congruent
Procédure permettant de trouver un triplet pythagoricien primitif correspondant au nombre congruent a connu
TriPy:=proc(m,n)# triangles pythagoriciens
local a,a1,b1,c1,d,k,q,u,v,w:
if (igcd(m,n)=1 and m>n) then
u:=(m^2-n^2-2*m*n)^2:v:=(m^2+n^2)^2:w:=(m^2-n^2+2*m*n)^2:
a:=(op(2,sqrt(v-u)))^2:#nombre congruent réduit
a1:=2*m*n:b1:=(m^2-n^2):c1:=m^2+n^2:
q:=sqrt((v-u)/a)/2:#rapport de réduction
print(a1/q,b1/q,c1/q):fi
end:
TriPy(Duo(34));
17  145
24, --, ---
6    6

TriPy(Duo(39));
156  5  313
---, -, ---
5   2  10

TriPy(Duo(111));
444  35  1513
---, --, ----
35   2    70
TriPy(Duo(1794));
1196      1205
----, 21, ----
7         7
TriPy(Duo(23));don't work, "part dans les choux"

How to draw Ford's circles ?...

Maple 2018

with(plottools):F := proc (N) local a, b, L; L := NULL; L := sort([op({seq(seq(a/b, a = 0 .. b), b = 1 .. N)})]); return L end proc; F(6);
[   1  1  1  1  2  1  3  2  3  4  5   ]
[0, -, -, -, -, -, -, -, -, -, -, -, 1]
[   6  5  4  3  5  2  5  3  4  5  6   ]
Ford6 := proc (i) local d, k, n, r; k := i; n := numer(F(6)[k]); d := denom(F(6)[k]); r := (1/2)/d^2; return [n/d, r], r end proc; nops(F(6));
13
for i to 13 do C || i := Ford6(i) end do;

display(circle(C1), circle(C2), circle(C3), circle(C4), circle(C5), circle(C6), circle(C7), circle(C8), circle(C9), circle(C10), circle(C11), circle(C12), circle(C13), axes = normal, scaling = constrained, color = blue, size = [800, 800]);

Pythagora table which don't work...

Maple 2018

with(plottools):with(plots): display(seq(seq(display(polygon([[i,j],[i,j+1],[i+1,j+1],[i+1,j]], color=`if``((j)::odd,ColorTools:-Color=magenta))), textplot([1+.5,j+.5,fprintf("%d",i*j)])),i=1..10), j=1..10),axes=none);

How to improve a procedure ?...

Maple 2018
Fract := proc (P::posint, Q::posint) local p, q; for p to P-1 do for q to Q-1 do if is((P-p)*q-p*(Q-q) = 1) then return p/q, P/Q, (P-p)/(Q-q) end if end do end do end proc:#this procedure works Fract1 := proc (P::posint, Q::posint) local p, q; `~`[`~`[`/`@op]](select(type, map2(eval, [[p, q], [P-p, Q-q]], [isolve((P-p)*q-P*(Q-q) = 1)]), [[posint\$2]\$2]))[] end proc:#this procedure don't work Fract(7, 81);Fract1(7,81); Fract(39, 97);Fract1(39,97); Fract(101, 143);Fract1(101,143); Fract(11, 80);Fract1(11,80); Fract(15, 37);Fract1(15,37); Fract(22, 39);Fract1(22,39); Fract(25, 37);Fract1(25,37); Fract(21, 91);Fract1(21,91); Fract(13, 19);Fract1(13,91);

a procedure which don't work...

Maple 2018

restart;
A002487 := proc (m) local a, b, n; option remember; a := 1; b := 0; n := m; while 0 < n do if type(n, odd) then b := a+b else a := a+b end if; n := floor((1/2)*n) end do; b end proc; listeinverse := proc (L::list) local i; [seq(op(nops(L)-i, L), i = 0 .. nops(L)-1)] end proc; Brocot := proc (n) local c, i, L, M, r; L := NULL; r := 2^n; L := [seq(A002487(i), i = 0 .. r)]; M := listeinverse(L); c[0] := 0, 1/cat(0); for i to r do c[i] := L[i]/M[i] end do; c[r+1] := 1/cat(0); return [seq(c[i], i = 1 .. r+1)], r+1 end proc; for i from 0 to 4 do B || i := Brocot(i) end do;
[   1]
B0 := [0, -], 2
[   0]
[      1]
B1 := [0, 1, -], 3
[      0]
[   1        1]
B2 := [0, -, 1, 2, -], 5
[   2        0]
[   1  1  2     3        1]
B3 := [0, -, -, -, 1, -, 2, 3, -], 9
[   3  2  3     2        0]
[   1  1  2  1  3  2  3     4  3  5     5        1]
B4 := [0, -, -, -, -, -, -, -, 1, -, -, -, 2, -, 3, 4, -], 17
[   4  3  5  2  5  3  4     3  2  3     2        0]
rang := proc(M::list, a)  ...  end;;
/       1\
rang|B2[1], -|;
\       2/
/ d        \
|--- don(x)| t work;
\ dx       /

F := proc (N) local a, b, L; L := NULL; L := sort([op({seq(seq(a/b, a = 0 .. b), b = 1 .. N)})]); return L, nops(L) end proc; F(1); F(2); F(3); F(4);
[0, 1], 2
[   1   ]
[0, -, 1], 3
[   2   ]
[   1  1  2   ]
[0, -, -, -, 1], 5
[   3  2  3   ]
[   1  1  1  2  3   ]
[0, -, -, -, -, -, 1], 7
[   4  3  2  3  4   ]
rang(F(3)[1], 2/3);
/[   1  1  2   ]  2\
rang|[0, -, -, -, 1], -|
\[   3  2  3   ]  3/

 First 27 28 29 30 Page 29 of 30
﻿