Ce programme n'a jamais été partagé car internet n'existait pas et puis je l'ai oublié. Pour ceux que ca intéresse, je le mets donc à dispo dans le but de l'optimiser et éventuellement qu'il puisse être porté sur d'autres calculatrices..
Pour le moment il fonctionne parfaitement sur HP28S mais pas sur sur HP50G (problème avec les fonction EXGET, OBJ-> à redéfinir) . Peut-être le trouverez-vous suffisamment intéressant pour le porter sur d'autres calculatrices...
Ce forum m'a l'air parfait pour ça
Tout d'abord ce programme est divisé en 3 parties.
1- REDUC: ce programme permet de trouver la fraction de nombres tels que:
- 6.5 (13/2)
- 6.3333333333333333 (19/3)
- 3.14285714286 (22/7)
- ou même 6.456456456456456456 (2150/333)
bien sur il réduit également toute fraction au maximum
2- RACINE/ Ce programme permet de trouver les fractions des nombres ci-dessus en tenant compte de la racine carrée:
par exemple:
- 1.77281052086 donnera racine(22/7)
- 6.34227616011 donnera 32/9*racine(35/11)
3- FRAC. il s'agit du programme principal qui utilise les 2 autres. Il permet de trouver la fraction d'un nombre complexe, de la racine carrée d'un nombre complexe, d'une matrice, etc..
par exemple
- (1.3333333333333333+4.5i)/(7+6.4i)=0.423892100192+0.255298651253i
le resultat de FRAC donnera 220/519 + 265/1038i
Bien sûr, ca ne marche pas à tous les coups, mais l'avantage de ce programme, c'est que s'i ne trouve pas, le programme le sait tout de suite et ne part pas dans des calculs interminables.
Allons-y..
REDUC
Code : Tout sélectionner
<< DUP ->NUM 1.E12 * 1.E12 -> o n m
<< n ABS m
DO SWAP OVER MOD
UNTIL DUP 10000000 / IP NOT
END DROP n OVER / IP DUP ABS m 4 ROLL / IP DUP
IF 1 <>
THEN 10 SF R->I ->STR "'" ROT R->I ->STR + "/" + SWAP + STR-> SWAP SIGN * DUP
IF ->NUM o ->NUM - ABS .000000001 >
THEN DROP o
END
ELSE DROP2
END
>>
>>
Code : Tout sélectionner
<< EVAL
IF REDUC DUP DUP TYPE SWAP DUP IP SAME OR NOT
THEN
<< DUP DUP
IF 1 <>
THEN \/ IP 1 + -> a g
<< g 2
FOR X
IF a X SQ / DUP DUP IP ==
THEN DUP a SWAP / \/ SWAP 0 'X' STO
ELSE DROP
IF X 2 <=
THEN 1 a
END
END -1
STEP
>>
END
>> -> raci
<< DUP SIGN SWAP DUP SQ REDUC DUP DUP ->STR
IF "." POS SWAP EVAL NOT OR NOT
THEN SWAP DROP DUP
IF TYPE NOT OVER DUP IP SAME OR
THEN 1
ELSE DUP 1 EXGET SWAP 3 EXGET
END -> s n d
<< n raci EVAL d raci EVAL 4 ROLL ROT / REDUC 3 ROLLD / REDUC DUP ->STR -> p q
<< "'\/"
IF p TYPE
THEN "(" q 2 q SIZE 1 - SUB + ")" +
ELSE q
END + STR-> * s
>>
>>
ELSE DROP
END *
>>
END
>>
Code : Tout sélectionner
<<
IF 1 FS?
THEN DUP 35 CF EVAL 35 SF
IF TYPE NOT
THEN RACINE
ELSE
IF DUP TYPE 1 ==
THEN 10 SF DUP RE RACINE SWAP IM RACINE 'i' * +
ELSE
IF DUP TYPE DUP 3 == SWAP 4 == OR
THEN ->STR "" SWAP
DO DUP " " POS DUP2 1 SWAP SUB 3 ROLLD 1 + 999 SUB SWAP
IFERR STR->
THEN
ELSE 10 CF FRAC ->STR
IF 1 FC?
THEN DUP DUP
IF TYPE
THEN SIZE 1
ELSE SIZE 1 - 2
END SWAP SUB
END " " +
END ROT SWAP + SWAP
UNTIL DUP SIZE 2 <=
END +
ELSE
IF DUP TYPE 9 ==
THEN -> a
<< a 1 1 a SIZE
FOR X -> y
<< a X EXGET
IF DUP TYPE 2 <
THEN FRAC DUP
IF TYPE 2 <
THEN 1
ELSE DUP SIZE
END -> s
<< y SWAP EXSUB y s +
>>
ELSE DROP y 1 +
END
>>
NEXT
>> DROP
END
END
END
END
END
>>
<> à remplacer par SHIFT = (différent)
\/ à remplacer par le caractere racine carrée
<= à remplacer par le caractère inférieur ou égal
N'hesitez pas si vous avez des questions, ça me fera plaisir de replonger dans ce code pour le porter sur HP50G par exemple
