Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Ici, on fait dans le petit, le LCD qui déchire sa race, on y cause même calculatrices quand on est en manque !

Modérateur : Politburo

Avatar du membre
babaorhum
Fonctionne à 1200 bauds
Fonctionne à 1200 bauds
Messages : 454
Enregistré le : 13 janv. 2013 19:44
Localisation : Marseille-est

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par babaorhum »

Salut les siliciens !

Ca fait bien longtemps que je n'ai pas posté sur Sili ... (mais ça ne m'a pas empêché de vous lire très régulièrement et de suivre vos aventures !)

Bon, C.Ret m'a fait ressortir mes machines. Voici donc un algo de Kaprekar méthode alphanumérique sur un 71B. Je ne rivalise pas avec les versions RPL et assembleur bien sûr ...
Le 71B considère ses chaînes alpha comme des tableaux. On accède ainsi simplement à chacun de ses caractères ... pratique pour trier !

Code : Tout sélectionner

10 INPUT A$ @ A$=STR$(VAL(A$))
20 L=LEN(A$) @ FOR J = L-1 TO 1 STEP -1 @ FOR I = 1 TO J
30 L$=A$[1,1] @ R$=A$[I+1,I+1]
40 IF R$>L$ THEN A$[I,I]=R$ @ A$[I+1,I+1]=L$
50 NEXT I @ NEXT J
60 B$=« » @ FOR I = 1 TO L @ B$[I,I]=A$[L-I+1,L-I+1] @ NEXT I
70 A$=STR$(VAL(A$)-VAL(B$))
80 PRINT A$ @ PAUSE @ GOTO 20
A$ contient le nombre initial (sous forme d'une chaine alpha), puis le nombre trié en décroissant
B$ contient le nombre trié en croissant
L$ et R$ contienne les caractères extraits pour les comparer et si besoin les échanger.

c'est un tri systématique de la gauche vers la droite ... c'est un tri à bulle ?

@ bientôt

Baba
BaBaoRhum
HP J728,200LX,1000CX,75C,71B,48GX,42s,41CX,32E,32Sii,28S,22s,21,16C,11C
Sharp PC- E500,1600,1500,1350,1261,1245
Casio FX-502P,602p,850P,3900P,4000P
TI-74,92,95 ; Canon X-07 ; TANDY EC-4026 ; Wp34S
Avatar du membre
C.Ret
Fonctionne à 9600 bauds
Fonctionne à 9600 bauds
Messages : 3400
Enregistré le : 31 mai 2008 23:43
Localisation : N 49°22 E 6°10

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par C.Ret »

Très beau code qui utilise bien les indices d'adressage des caractères d'une chaine spécifique au HP-71B.

J'aime bien aussi le N$=STR$ VAL N$ pour éviter que l'on ne démarre avec une chaine N$ ne contenant pas un nombre.


Du coup cela m'a donné l'idée de faire pareil sur SHARP PC-1360. Enfin presque pareil parce que le seul moyen d'accéder aux caractères d'une chaine est d'utiliser les instructions MID$ LEFT$ ou RIGHT$.

Code : Tout sélectionner

1:"K" AREAD N: ND$="", NC$=ND$: FOR L=1 TO LEN STR$ N: I$=MID$ (STR$ N,L,1), J=0
2:J=J+1 : IF I$< MID$ (ND$,J,1) GOTO 2
3:ND$= LEFT$ (ND$,J-1)+I$+ MID$ (ND$,J,9) , NC$= LEFT$ (NC$,L-J)+I$+ MID$ (NC$,1+L-J,9) 
4:NEXT L: N= VAL ND$- VAL NC$:  WAIT : PAUSE ND$;"-";NC$: PRINT N: GOTO 1
Pour lancer un nouveau calcul, saisir le nombre et lancer par [ DEF ] [ K ]. La transformation suivantes peut être enchainée soit directement par le même label DEF, soit en pressant simplement sur [ ENTER ]

Si un nombre plus grand que 10 chiffres est saisi, le programme s'arrête sur une erreur 3 en ligne 3. Notez que si l'on utilise les variables D$ et C$ au lieu de ND$ et NC$; le nombre de chiffres se limitera à 7. Au delà les résultats sont erronés, les variables simples ne pouvant contenir plus de 7 caractères.

Les chiffres de N sont triés directement dans les chaines ND$ et NC$ respectivement par ordre décroissant et croissant à partir du test unique de la ligne 2. l'idée est que les chaines ND$ et NC$ sont triées dans un sens et dans l'autre, il y a donc une antisymétrie. Si le chiffre de N doit être placé à la J-ième position à partir de la gauche dans D, il sera à la même J-ième position mais à partir de la droite dans C (c'est à dire (L-J)-ième position comptée à partir de la gauche pour être compatible avec les instructions LEFT$ ou MID$).


AJOUT 30/08/2018:
Et la version pour Commodore VIC-20 :
MPO 85 VIC-20 list+run color.gif
MPO 85 VIC-20 list+run color.gif (82.68 Kio) Vu 13449 fois
Comme cela ne se voit pas sur cette capture fixe, le curseur clignote. Il est possible de modifier la valeur ou de taper directement sur [ RETURN ] pour obtenir le détail de la transformation suivante.
SHARP PC-1211 PC-1360 EL-5150 PC-E500 | Commodore C=128D | Texas Instruments Ti-57LCD Ti-74BASICalc Ti-92II Ti-58c Ti-95PROCalc Ti-30XPROMathPrint | Hewlett-Packard HP-28S HP-41C HP-15C HP-Prime HP-71B | CASIO fx-602p | NUMWORKS | Graphoplex Rietz Neperlog | PockEmul | Sommaire des M.P.O. | Ma...dov'il sapone.
Avatar du membre
C.Ret
Fonctionne à 9600 bauds
Fonctionne à 9600 bauds
Messages : 3400
Enregistré le : 31 mai 2008 23:43
Localisation : N 49°22 E 6°10

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par C.Ret »

babaorhum a écrit : 26 août 2018 18:38 […] Le 71B considère ses chaînes alpha comme des tableaux. On accède ainsi simplement à chacun de ses caractères ...[...]
Intéressant ça, je constate qu'il y a à chaque fois deux indices. S'agit-il des indices de début et de fin du "tableau" de caractères ?

Si c'est le cas, il devient possible de manipuler plus d'un caractère à la fois :

Code : Tout sélectionner

10 INPUT N$ @ N$=STR$(VAL(N$)) @ D$="" @ C$="" @ FOR I = 1 TO LEN(N$) @ J=1
20 IF J<I THEN IF N$[I,I]<D$[J,J] THEN J=J+1 @ GOTO 20
30 D$[J,0]=N$[I,I] @ C$[1+I-J,0]=N$[I,I] @ NEXT I @ N$=D$&"-"&C$ 
40 PRINT N$;" :";VAL(N$) @ PAUSE @ GOTO 10
Je n'ai pas d' HP-71B, le code ci-dessus a-t-il une chance de fonctionner ??
SHARP PC-1211 PC-1360 EL-5150 PC-E500 | Commodore C=128D | Texas Instruments Ti-57LCD Ti-74BASICalc Ti-92II Ti-58c Ti-95PROCalc Ti-30XPROMathPrint | Hewlett-Packard HP-28S HP-41C HP-15C HP-Prime HP-71B | CASIO fx-602p | NUMWORKS | Graphoplex Rietz Neperlog | PockEmul | Sommaire des M.P.O. | Ma...dov'il sapone.
Avatar du membre
babaorhum
Fonctionne à 1200 bauds
Fonctionne à 1200 bauds
Messages : 454
Enregistré le : 13 janv. 2013 19:44
Localisation : Marseille-est

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par babaorhum »

Bonjour,

j'ai peut être été un peu rapide mes explications ... On peut accéder au contenu des variables alpha du HP71B comme dans un tableau :

A$ = B$[3,5] affectera à A$ 3 caractères : du 3ème au 5ème de B$ - comme un MID$(B$,3,3) sur une Sharp par exemple.

Le gros avantage HP est que ça marche dans l'autre sens - Dans mon code je l'ai utilisé pour affecter un caractère (A$[I,I]= "x") . Facile.
Pour plusieurs caractères ça mérite de s'y pencher un peu plus ...

extrait du manuel P74, traduit à la volée :
V$[I,J] = "teacup" étend ou contracte la partie de V$ à partir de la position I jusqu'à la position J de manière à ce que le mot "teacup" entre exactement - tout caractère existant auparavant entre I et J sont écrasés, y compris les positions I et J
Ca mérite un essai pour bien comprendre ... sortons la bête et essayons :

Code : Tout sélectionner

A$="SILICIUM C'EST SUPER"
LEN(A$) renvoit 20
A$[5,8] = "GLOUPS"
A$ renvoie "SILIGLOUPS C'EST SUPER"  donc on élimine les 4 caractères entre du 5éme au 8éme et on les remplace par les 6 caractères de "GLOUPS"
A$[5,10] = "CIUM"
A$ contient "SILICIUM C'EST SUPER"  on élimine les 6 caractères (entre 5 et 10) et on les remplace par 4 "CIUM"
Voilà, maintenant on comprend mieux le manuel effectivement ...

Avec cet éclaircissement, C.ret, il faut je pense revoir ta ligne 30 (pas le temps d'aller plus loin aujourd'hui ...)

Autre précision, l'instruction N$=STR$(VAL(N$)) sert aussi à éliminer d'éventuels zéros en début de ligne, changer par exemple, 0001485 en 1485 - sinon les zéros sont considérés, on est en mode alpha ...

A suivre

Baba
BaBaoRhum
HP J728,200LX,1000CX,75C,71B,48GX,42s,41CX,32E,32Sii,28S,22s,21,16C,11C
Sharp PC- E500,1600,1500,1350,1261,1245
Casio FX-502P,602p,850P,3900P,4000P
TI-74,92,95 ; Canon X-07 ; TANDY EC-4026 ; Wp34S
Avatar du membre
C.Ret
Fonctionne à 9600 bauds
Fonctionne à 9600 bauds
Messages : 3400
Enregistré le : 31 mai 2008 23:43
Localisation : N 49°22 E 6°10

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par C.Ret »

OUi, c'est une spécificité bien pratique du HP-71B les crochets permettent bien plus de choses que les MID$ ou LEFT$ / RIGHT$ d'autres BASICs

De plus si on a D$="952" et C$="259" alors D$[3,0]="4" et C$[2,0]="4" insèrent respectivement la chaine "4" dans D$ (avant le 3ième caractère) et C$ (avant le second) de telle sorte que l'on obtient alors D$="9542" et C$="2459". je ne sais pas si c'est bien expliqué bien dans le manuel HP, mais c'est à essayer sur un HP-71B (ROM BBBB)

Sans compter les HP-71B qui aurait l'instruction REV$. Dans ce cas, mon C$ devient inutile, il est remplacé par REV$(D$) !
SHARP PC-1211 PC-1360 EL-5150 PC-E500 | Commodore C=128D | Texas Instruments Ti-57LCD Ti-74BASICalc Ti-92II Ti-58c Ti-95PROCalc Ti-30XPROMathPrint | Hewlett-Packard HP-28S HP-41C HP-15C HP-Prime HP-71B | CASIO fx-602p | NUMWORKS | Graphoplex Rietz Neperlog | PockEmul | Sommaire des M.P.O. | Ma...dov'il sapone.
Avatar du membre
badaze
Fonctionne à 14400 bauds
Fonctionne à 14400 bauds
Messages : 8372
Enregistré le : 12 févr. 2007 18:36
Localisation : Pas très loin de Lyon
Contact :

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par badaze »

Ma contribution avec un programme pour Casio PB-100 (en fait un Olympia OP 544).

Le programme est sans fioritures et pas spécialement optimisé. J'ai utilisé un tableau A(15+I) avec 0<=I<=9 pour remplir les variables de O à X. J'aurais pu utiliser le tableau O(I).
On saisit le nombre qui est mis dans la variable $ qui a une capacité de 30 caractères.

PS : le cas de 52 est correctement géré.

zone P0 - programme principal

Code : Tout sélectionner

10 INPUT $
20 GOSUB #1
30 GOSUB #2
40 GOSUB #3
50 F=G-H
60 PRINT F
70 GOTO 10
80 END
Malheureusement le PB-100 n'a pas de fonction STR qui convertit un nombre en chaîne mais seulement VAL. De ce fait il est impossible de faire boucler le programme automatiquement pour afficher les résultats de la suite. J'ai quand même mis un GOTO 10 car il suffit d'appuyer sur la touche ANS pour que le dernier résultat soit automatiquement copié.

zone P1 - calcul des positions

Code : Tout sélectionner

-- Initialisation du tableau 
10 FOR I=0 TO 9
20 A(15+I) = 0
30 NEXT I 
-- Comptage du nombre de chiffres par chiffre
40 FOR I=1 TO LEN($)
50 B$ = MID(I,1)
60 C = VAL(B$)
70 A(15+C) = A(15+C)
80 NEXT I
90 RETURN
Les chiffres du nombre saisi sont comptés et le comptage est mis dans un tableau. Par exemple pour 562545 le poste 5 du tableau est égal à 3 car il y a 3 cinq dans le nombre.
Image

zone P2 - mise en forme du nombre (chiffres dans l'ordre croissant)

Code : Tout sélectionner

-- ligne 10 = paramètres de la boucle FOR NEXT de la zone 4
10 L=9:M=0:N=-1
20 GOSUB #4
30 H=D
40 RETURN
zone P3 - mise en forme du nombre (chiffres dans l'ordre décroissant)

Code : Tout sélectionner

-- ligne 10 = paramètres de la boucle FOR NEXT de la zone 4
10 L=0:M=9:N=1
20 GOSUB #4
30 G=D
40 RETURN
zone P4 - sous routine générique de mise en forme

Code : Tout sélectionner

10 D=0:J=0:K=0
20 FOR I=L TO M STEP N
30 IF A(15+I) = 0 THEN 80
40 FOR J=1 TO A(15+I)
50 D=D+(I*(10^K))
60 K=K+1
70 NEXT J
80 NEXT I
90 RETURN
La sous routine P4 est appelée par les sous routines P2 et P3. P4 parcourt le tableau du comptage des chiffres de 0 à 9 (appel depuis P3) ou de 9 à 0 (appel depuis P2) et donne un nombre dont les chiffres sont triés par ordre croissant (P2) ou décroissant (P3).
Le principe est d'utiliser les puissances de 10 pour positionner les chiffres dans le nombre final (incrément de la variable K à chaque fois qu'un chiffre est utilisé).
La seconde boucle FOR NEXT sert à traiter le cas où le même chiffre se retrouve plusieurs fois dans le nombre initial.
Image
.
.
.
.
.
.
.
Fichiers joints
Capture20180831_001.JPG
Capture20180831_001.JPG (11.78 Kio) Vu 13399 fois
Tout est bon dans le pocket.
Moi j'aime tout.... Casio, HP, Sharp, TI et les autres sauf que les TI semblent ne pas m'aimer :(
http://www.emmella.fr
Mes Casio - HP - Sharp - TI
Homme invisible.
Avatar du membre
badaze
Fonctionne à 14400 bauds
Fonctionne à 14400 bauds
Messages : 8372
Enregistré le : 12 févr. 2007 18:36
Localisation : Pas très loin de Lyon
Contact :

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par badaze »

J'ai réussi à convertir un nombre en chaîne de caractères.

zone P0 - programme principal

Code : Tout sélectionner

10 INPUT $
20 GOSUB #1
30 GOSUB #2
40 GOSUB #3
50 F=G-H
60 PRINT F
65 GOSUB #9
70 GOTO 20
80 END
Le code des zones P1, P2, P3 et P4 ne change pas.

zone P9 - conversion numérique en numérique alpha

Code : Tout sélectionner

10 $="0123456789":Y=0:K=0
20 FOR I=0 TO 9
30 O$(I)=""
40 NEXT I
50 Y=F
60 Y=Y/10
70 Z=FRAC(Y)*10
80 Y=INT(Y)
90 O$=MID(Z+1,1):H$=P$(K):J=LEN(H$)
100 IF J>7;K=K+1
110 P$(K)=O$+P$(K)
120 IF Y<>0 THEN 60
130 $=""
140 FOR I=0 TO K
150 $=$+P$(I)
160 NEXT I
170 RETURN
et vous savez quoi. Le code de la zone P9 m'a donné un nouvel algorithme.
EDIT : en fait non :(
Tout est bon dans le pocket.
Moi j'aime tout.... Casio, HP, Sharp, TI et les autres sauf que les TI semblent ne pas m'aimer :(
http://www.emmella.fr
Mes Casio - HP - Sharp - TI
Homme invisible.
cgh
Fonctionne à 2400 bauds
Fonctionne à 2400 bauds
Messages : 2136
Enregistré le : 30 août 2011 12:23
Localisation : Vous êtes ici -> .

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par cgh »

Ma petite contribution sur... CASIO FX-702P 8)
Le programme occupe 188 octets (1680-1492) et utilise les variables C, I, J, K, L, N, P, S, T. On pourrait de plus n'avoir que K (et pas P) :geek:
Il y a un peu de message quand meme: NOMBRE= et K(...)=... :mrgreen:
Le code suivant occupe le programme P0.

Code : Tout sélectionner

10 INP "NOMBRE=",N
20 C=0:S=0:T=0:L=INT LOG (INT N+.1)
30 FOR I=1 TO L+1:C=C+10^INT (10*FRAC (N/10^I)):NEXT I
40 FOR I=0 TO 9:P=INT (FRAC (C/10^(I+1))*10)
50 IF P=0 THEN 70
60 FOR J=1 TO P:T=T*10+I:S=S/10+I:NEXT J
70 NEXT I:K=S*10^L-T:PRT "K(";N;")=";K:N=K:GOTO 20
Lancer le programme par P0. Entrer votre nombre et EXE. K(...) va s'afficher. Appuyer sur CONT pour continuer la sequence ou si vous voulez un nouveau nombre, relancer le programme par P0.

Ligne 20: le # est le caractere different qui est present sur le FX-702P ;)
Modifié en dernier par cgh le 01 sept. 2018 03:37, modifié 3 fois.
Il y a ceux qui voient les choses telles qu'elles sont et se demandent pourquoi, et il y a ceux qui imaginent les choses telles qu'elles pourraient être et se disent... pourquoi pas? - George Bernard Shaw
J'adore parler de rien, c'est le seul domaine où j'ai de vagues connaissances ! - Oscar Wilde
Ce n'est pas parce que les choses sont difficiles que nous n'osons pas. C'est parce que nous n'osons pas que les choses sont difficiles. - Sénèque
cgh
Fonctionne à 2400 bauds
Fonctionne à 2400 bauds
Messages : 2136
Enregistré le : 30 août 2011 12:23
Localisation : Vous êtes ici -> .

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par cgh »

Une solution BASIC (oui, oui, cela m'arrive :mrgreen:) sur SHARP PC1500.

Code : Tout sélectionner

10 INPUT N$
20 T$="":S$="":L=LEN N$:FOR I=48TO 57:C$=CHR$ I:FOR J=1TO L
30 IF MID$ (N$,J,1)=C$LET T$=T$+C$:S$=C$+S$
40 NEXT J:NEXT I
50 K$=STR$ (VAL S$-VAL T$):PRINT "K(";N$;")=";K$:N$=K$:GOTO 20
Lancer le programme par RUN. Entrer votre nombre; le resultat K(n)=k sera affiche. Appuyer sur ENTER pour la suite de la sequence, sinon relancer le programme par RUN pour un nouveau nombre.

Note: 48 correspond au code ASCII de "0" et 57 a celui de "9"... :geek:
Il y a ceux qui voient les choses telles qu'elles sont et se demandent pourquoi, et il y a ceux qui imaginent les choses telles qu'elles pourraient être et se disent... pourquoi pas? - George Bernard Shaw
J'adore parler de rien, c'est le seul domaine où j'ai de vagues connaissances ! - Oscar Wilde
Ce n'est pas parce que les choses sont difficiles que nous n'osons pas. C'est parce que nous n'osons pas que les choses sont difficiles. - Sénèque
cgh
Fonctionne à 2400 bauds
Fonctionne à 2400 bauds
Messages : 2136
Enregistré le : 30 août 2011 12:23
Localisation : Vous êtes ici -> .

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par cgh »

Du coup, en appliquant la meme methode au programme du FX-702P, le programme occupe maintenant 140 octets (1680-1540).

Code : Tout sélectionner

10 INP "NOMBRE=",N
20 C=0:S=0:T=0:L=INT LOG (INT N+.1)
30 FOR I=0 TO 9:FOR J=1 TO L+1
40 IF I=INT (FRAC (N/10^J)*10);T=T*10+I:S=S/10+I
50 NEXT J: NEXT I:
70 NEXT I:K=S*10^L-T:PRT "K(";N;")=";K:N=K:GOTO 20
Il y a ceux qui voient les choses telles qu'elles sont et se demandent pourquoi, et il y a ceux qui imaginent les choses telles qu'elles pourraient être et se disent... pourquoi pas? - George Bernard Shaw
J'adore parler de rien, c'est le seul domaine où j'ai de vagues connaissances ! - Oscar Wilde
Ce n'est pas parce que les choses sont difficiles que nous n'osons pas. C'est parce que nous n'osons pas que les choses sont difficiles. - Sénèque
Avatar du membre
C.Ret
Fonctionne à 9600 bauds
Fonctionne à 9600 bauds
Messages : 3400
Enregistré le : 31 mai 2008 23:43
Localisation : N 49°22 E 6°10

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par C.Ret »

Je suis aux 9ième Pocketicaires et. J'ai pu corriger mon code pour HP-71B

Code : Tout sélectionner

10 INPUT N$ @ N$=STR$(VAL(N$)) @ D$="" @ C$="" @ FOR I = 1 TO LEN(N$) @ J=1
20 IF J<I AND N$[I,I]<D$[J,J] THEN J=J+1 @ GOTO 20
30 D$[J,0]=N$[I,I] @ C$[1+I-J,0]=N$[I,I] @ NEXT I @ N$=D$&"-"&C$ 
40 PRINT N$;" :";VAL(N$) @ PAUSE @ GOTO 10
Modifié en dernier par C.Ret le 30 juin 2020 11:56, modifié 1 fois.
SHARP PC-1211 PC-1360 EL-5150 PC-E500 | Commodore C=128D | Texas Instruments Ti-57LCD Ti-74BASICalc Ti-92II Ti-58c Ti-95PROCalc Ti-30XPROMathPrint | Hewlett-Packard HP-28S HP-41C HP-15C HP-Prime HP-71B | CASIO fx-602p | NUMWORKS | Graphoplex Rietz Neperlog | PockEmul | Sommaire des M.P.O. | Ma...dov'il sapone.
Gilles59
Fonctionne à 2400 bauds
Fonctionne à 2400 bauds
Messages : 1602
Enregistré le : 27 oct. 2010 20:46

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par Gilles59 »

On va dire que je gruge mais avec l'indispensable bibliothèque ListExt https://www.hpcalc.org/details/7971 pour HP49 et HP50 :

Code : Tout sélectionner

 « I➔NL SORT DUP REVLIST N➔LI SWAP NL➔I - » 
I➔NL transforme un entier en liste de chiffres (mnémo : Integer to Number List) : 4546 -> { 4 5 4 6 }
NL➔I fait le contraire (mnémo : Number List to Integer) : { 9 5 7 6 } -> 9576

Le reste est du standard 49/50g. SORT trie une liste, REVLIST la retourne
Casio FX-502P /602P / 603P / FX180P+ / FX4000P / TI57 / TI66 / TI74 Basicalc / TI95 Procalc / HP12C / HP15C LE / DM41L / HP 30B / HP39GII / HP 48SX USA / 49G / 49g+ / 50G / 50G NewRPL / HP Prime / Oric 1 / Amstrad CPC 6128+ CM14 et MM12 / Alice 32
Avatar du membre
C.Ret
Fonctionne à 9600 bauds
Fonctionne à 9600 bauds
Messages : 3400
Enregistré le : 31 mai 2008 23:43
Localisation : N 49°22 E 6°10

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par C.Ret »

C.Ret a écrit : 13 oct. 2018 17:08Je suis aux 9ième Pocketicaires et. J'ai pu corriger mon code pour HP-71B

Code : Tout sélectionner

10 INPUT N$ @ N$=STR$(VAL(N$)) @ D$="" @ C$="" @ FOR I = 1 TO LEN(N$) @ J=1
20 IF J<I AND N$[I,I]<D$[J,J] THEN J=J+1 @ GOTO 20
30 D$[J,0]=N$[I,I] @ C$[1+I-J,0]=N$[I,I] @ NEXT I @ N$=D$&"-"&C$ 
40 PRINT N$;" :";VAL(N$) @ PAUSE @ GOTO 10
Comme maintenant j'ai mon propre HP-71B, je peux tester à loisir ses possibilités; j'ai donc amélioré les E/S de mon premier code.

Code : Tout sélectionner

10 LOOP @ DISP N$; @ INPUT "= ",STR$(VAL(N$&".0"));N$ @ DESTROY D$,C$ @ FOR I=1 TO LEN(N$) @ J=1 @ K$=N$[I,I]
20 WHILE J<I AND K$<D$[J,J] @ J=J+1 @ END WHILE @ D$[J,0]=K$ @ C$[1+I-J,0]=K$ @ NEXT I @ N$=D$&"-"&C$ @ END LOOP
Que l'on peux aussi lister ainsi:

Code : Tout sélectionner

10  LOOP
  @    DISP N$;
  @    INPUT "= ",STR$(VAL(N$&".0"));N$
  @    DESTROY D$,C$
  @    FOR I=1 TO LEN(N$)
  @       J=1 @ K$=N$[I,I]
20        WHILE J<I AND K$<D$[J,J]
  @          J=J+1
  @       END WHILE
  @       D$[J,0]=K$ @ C$[1+I-J,0]=K$
  @    NEXT I
  @    N$=D$&"-"&C$
  @ END LOOP
Avec cette version, j'obtiens exactement le même comportement pour la saisie que sur mes Commodore.

A la première utilisation l'HP-71B affiche :

Code : Tout sélectionner

  =[0]                                     (PRGM)
avec le curseur de saisie qui clignote sur le 0
Je saisis par exemple 9452 et valide par [END/LINE]
L'affiche se transforme presque immédiatement en :

Code : Tout sélectionner

  9542-2459=[7]083                         (PRGM)
avec le curseur de saisie clignotant su le chiffre 7 du résultat.
Je peux alors utiliser directement ce premier résultat pour le calcul suivant en pressant sur END/LINE.
Ou modifier la saisie à loisir avec les touches déplacement du curseur et d'édition puis valider par END/LINE. La touche [ON] efface la zone de saisie.
Pour sortir du programme il suffit de presser deux fois de suite sur la touche [ON]

Code : Tout sélectionner

9542-2459=7083
8730-0378=8352
8532-2358=6174
7641-1467=6174
Et ainsi de suite...
Vivement que les choses s'améliorent et que l'on puisse tous se retrouver IRL pour de prochains (mini-)pockéticaires !!
SHARP PC-1211 PC-1360 EL-5150 PC-E500 | Commodore C=128D | Texas Instruments Ti-57LCD Ti-74BASICalc Ti-92II Ti-58c Ti-95PROCalc Ti-30XPROMathPrint | Hewlett-Packard HP-28S HP-41C HP-15C HP-Prime HP-71B | CASIO fx-602p | NUMWORKS | Graphoplex Rietz Neperlog | PockEmul | Sommaire des M.P.O. | Ma...dov'il sapone.
Gilles59
Fonctionne à 2400 bauds
Fonctionne à 2400 bauds
Messages : 1602
Enregistré le : 27 oct. 2010 20:46

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par Gilles59 »

Bonsoir à tous,

version NewRpl :

Code : Tout sélectionner

« ➔STR UTF8➔ SORT DUP REVLIST ➔UTF8 STR➔ SWAP STR➔ - »
Pour installer le NewRPL sur votre 49G+/50G/39G+/39GS ou 40GS (ou émulateur):
https://newrpl.wiki.hpgcc3.org/doku.php
Casio FX-502P /602P / 603P / FX180P+ / FX4000P / TI57 / TI66 / TI74 Basicalc / TI95 Procalc / HP12C / HP15C LE / DM41L / HP 30B / HP39GII / HP 48SX USA / 49G / 49g+ / 50G / 50G NewRPL / HP Prime / Oric 1 / Amstrad CPC 6128+ CM14 et MM12 / Alice 32
Avatar du membre
C.Ret
Fonctionne à 9600 bauds
Fonctionne à 9600 bauds
Messages : 3400
Enregistré le : 31 mai 2008 23:43
Localisation : N 49°22 E 6°10

Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar)

Message par C.Ret »

Gilles59 a écrit : 01 janv. 2021 20:11version NewRpl :

Code : Tout sélectionner

« ➔STR UTF8➔ SORT DUP REVLIST ➔UTF8 STR➔ SWAP STR➔ - »
Bonsoir Gilles,

J'aime bien l'algorithme qui en RPL utilise l'instruction de tri et quelques commandes de conversion du format des données qui font le travail proprement et directement.

Je ne suis pas un spécialiste du New-RPL, qui me semble être une bonne évolution du user-RPL, mais il me semble qu'il manque une instruction →UTF8 qui a dû se perdre en recopiant ton code :

Je donne ci-dessous mon interprétation de ton code New-RPL à partir de l'exemple numérique issu de 9452 ;

Code : Tout sélectionner

CODE:         STACK:                                     COMMENTS:
«                                   1:          9452       Argument initial
  →STR                              1:         "9452"
  UTF8→                             1: { 57 52 53 50 }     Mise sous forme de liste de l'argument 
  SORT                              1: { 50 52 53 57 }     Toute la beauté de la méthode basée sur un tri !!
  DUP         2: { 50 52 53 57 }    1: { 50 52 53 57 }
  REVLIST     2: { 50 52 53 57 }    1: { 57 53 52 50 }     Toute l'astuce de l'inversion !!  
  →UTF8       2: { 50 52 53 57 }    1:         "9542"
  STR→        2: { 50 52 53 57 }    1:          9542       Remise en format numérique de D (ordre décroissant)
  SWAP        2:          9542      1: { 50 52 53 57 }
**→UTF8*******2:**********9542******1:*********"2459"**    * instruction qui semble faire défaut * * * * * * * 
  STR→        2:          9542      1:          2459       Remise en format numérique de C (ordre croissant)
  - »                               1:          7083       Soustraction de Kaprekar donnant le résultat
SHARP PC-1211 PC-1360 EL-5150 PC-E500 | Commodore C=128D | Texas Instruments Ti-57LCD Ti-74BASICalc Ti-92II Ti-58c Ti-95PROCalc Ti-30XPROMathPrint | Hewlett-Packard HP-28S HP-41C HP-15C HP-Prime HP-71B | CASIO fx-602p | NUMWORKS | Graphoplex Rietz Neperlog | PockEmul | Sommaire des M.P.O. | Ma...dov'il sapone.
Répondre

Retourner vers « Tous les Pockets »