Récursivité en Panoramic

DIM LIST_KEY : LIST_KEY=52
DIM ARBRE_MAX : ARBRE_MAX=100
DIM GAUCHE : GAUCHE=1
DIM DROITE : DROITE=2
DIM RACINE : RACINE=1
DIM CLE : CLE=0

DLIST LIST_KEY : ' liste contenant les mots à trier
DIM PILE : PILE=40 : DLIST PILE : ' Pile pour récursivité

' Procédures arbre binaire
DIM Arbre(ARBRE_MAX, 2) : ' (x, 0) : Clé (x, 1) : fils gauche (x, 2) : fils droit

LABEL AddItem : DIM AddItem_str$ : ' Ajout d'un élément dans l'arbre
LABEL Recherche : DIM Recherche_str$, Recherche_id, Recherche : CLEAR PILE
LABEL Parcours : ' parcours de l'arbre binaire

' procédures diverses
LABEL strcmp : DIM strcmp_s1$, strcmp_s2$, strcmp
LABEL CreateNewObject

' ------------------------------------------------------------------------------
' Tests des fonctions :
' ------------------------------------------------------------------------------
DIM I, A$
A$="TFWAGUY" : ' cet ordre correspond pour l'instant à un arbre équilibré

' --- remplissage de l'arbre binaire
FOR I=1 TO LEN(A$)
    AddItem_str$= MID$(A$, I, 1) : GOSUB AddItem
NEXT I

' --- test recherche dans l'arbre
A$="AWZ"
PRINT : PRINT "Test recherche :"
FOR I=1 TO LEN(A$)
    ' Malheureusement j'ai pas encore trouvé de solution pour virer la ligne ci-dessous
    DELETE PILE : Recherche_id=RACINE
    Recherche_str$= MID$(A$, I, 1) : GOSUB Recherche
    SELECT Recherche
        CASE 0 : PRINT Recherche_str$+" non trouvé"
        CASE 1 : PRINT Recherche_str$+" trouvé !"
    END_SELECT
NEXT I
DELETE PILE : Recherche_str$="A" : GOSUB Recherche

' --- Parcours de l'arbre
PRINT
PRINT "parcours de l'arbre (tri fct récursive): " ;
GOSUB Parcours


END
' ==============================================================================
' ==============================================================================

' procédure récursive de recherche d'élément
Recherche:
    IF OBJECT_EXISTS(PILE)=0
        DLIST PILE
        Recherche=0
        strcmp_s1$=Recherche_str$
    END_IF
    IF Recherche_id=0 THEN RETURN : ' on est arrivé sur une terminaison
    ' comparaison des clés
    strcmp_s2$ = ITEM_READ$(LIST_KEY, Arbre(Recherche_id, 0))
    GOSUB strcmp
    ' Si egal : on a trouvé
    IF strcmp=0
        Recherche =1
        RETURN
    END_IF
    ' Si inférieur
    IF strcmp =-1
        ' Sauvegarde dans la pile
        ITEM_ADD PILE, Recherche_id : ITEM_ADD PILE, strcmp
        Recherche_id=Arbre(Recherche_id, GAUCHE) : ' on prend le fils à gauche

        GOSUB Recherche

        ' Restitution du contexte
        strcmp= ITEM_READ$(PILE, COUNT(PILE)) : ITEM_DELETE PILE, COUNT(PILE)
        Recherche_id= ITEM_READ$(PILE, COUNT(PILE)) : ITEM_DELETE PILE, COUNT(PILE)
    END_IF
    ' Si supérieur
    IF strcmp=1
        ' Sauvegarde dans la pile
        ITEM_ADD PILE, Recherche_id : ITEM_ADD PILE, strcmp
        Recherche_id=Arbre(Recherche_id, DROITE) : ' on prend le fils à droite

        GOSUB Recherche

        strcmp= VAL(ITEM_READ$(PILE, COUNT(PILE))) : ITEM_DELETE PILE, COUNT(PILE)
        Recherche_id= VAL(ITEM_READ$(PILE, COUNT(PILE))) : ITEM_DELETE PILE, COUNT(PILE)
    END_IF

RETURN

' Procédure récursive de parcours d'un arbre
Parcours:
    IF VARIABLE("Parcours_id")=0
        DIM Parcours_id
        Parcours_id=RACINE : CLEAR PILE
        strcmp_s1$=SearchItem_str$
    END_IF
    IF Arbre(Parcours_id, GAUCHE)<>0
        ' Sauvegarde dans la pile
        ITEM_ADD PILE, STR$(Parcours_id) : Parcours_id=Arbre(Parcours_id, GAUCHE)
        GOSUB Parcours
        ' Restitution du contexte
        Parcours_id= ITEM_READ$(PILE, COUNT(PILE)) : ITEM_DELETE PILE, COUNT(PILE)
    END_IF
    PRINT ITEM_READ$(LIST_KEY, Arbre(Parcours_id, CLE));
    IF Arbre(Parcours_id, DROITE)<>0
        ITEM_ADD PILE, STR$(Parcours_id)
        Parcours_id=Arbre(Parcours_id, DROITE)
        GOSUB Parcours
        Parcours_id= ITEM_READ$(PILE, COUNT(PILE))
        ITEM_DELETE PILE, COUNT(PILE)
    END_IF

RETURN

' Procédure iteractive
AddItem:
    IF VARIABLE("AddItem_r")=0
        DIM AddItem_r, AddItem_n
    END_IF
    ITEM_ADD LIST_KEY, AddItem_str$
    strcmp_s1$=AddItem_str$
    AddItem_n= COUNT(LIST_KEY)
    ' si arbre vide
    IF AddItem_n = RACINE
        Arbre(AddItem_n, CLE)=1 : Arbre(AddItem_n, GAUCHE)=0 : Arbre(AddItem_n, DROITE)=0
        RETURN
    END_IF
    ' sinon on parcours l'arbre
    AddItem_r = RACINE
    REPEAT
        strcmp_s2$= ITEM_READ$(LIST_KEY, Arbre(AddItem_r, CLE))
        GOSUB strcmp
        IF strcmp<0 : ' si inferieur
            IF Arbre(AddItem_r, GAUCHE)=0 : ' si pas de feuille en dessous
                Arbre(AddItem_r, GAUCHE)=AddItem_n
                Arbre(AddItem_n, CLE)=AddItem_n : Arbre(AddItem_n, GAUCHE)=0 : Arbre(AddItem_n, DROITE)=0
                PRINT "Insert Arbre(" + STR$(AddItem_r)+",1)=" +strcmp_s1$
                RETURN
            ELSE
                AddItem_r=Arbre(AddItem_r, GAUCHE)
            END_IF
        ELSE
            IF strcmp=0
                ITEM_DELETE LIST_KEY, AddItem_n
                RETURN
            ELSE
                IF Arbre(AddItem_r, DROITE)=0 : ' Si pas de feuille en dessous
                    Arbre(AddItem_r, DROITE)=AddItem_n
                    Arbre(AddItem_n, 0)=AddItem_n : Arbre(AddItem_n, GAUCHE)=0 : Arbre(AddItem_n, DROITE)=0
                    PRINT "Insert Arbre(" + STR$(AddItem_r)+",2)=" +strcmp_s1$
                    RETURN
                ELSE
                    AddItem_r=Arbre(AddItem_r, DROITE)
                END_IF
            END_IF
        END_IF
    UNTIL 2<>2
RETURN

' ==============================================================================
' DIVERS
' ==============================================================================
strcmp:
    IF VARIABLE("strcmp_list")=0
        DIM strcmp_list
        GOSUB CreateNewObject : strcmp_list=CreateNewObject
        DLIST strcmp_list
    END_IF
    CLEAR strcmp_list
    IF strcmp_s1$=strcmp_s2$
        strcmp=0
    ELSE
        ITEM_ADD strcmp_list, strcmp_s1$ : ITEM_ADD strcmp_list, strcmp_s2$
        SORT strcmp_list
        IF (strcmp_s1$= ITEM_READ$(strcmp_list, 1)) : strcmp=-1 : ELSE : strcmp=1 : END_IF
    END_IF
RETURN

CreateNewObject:
    IF VARIABLE("CreateNewObject")=0
        DIM CreateNewObject
    END_IF
    CreateNewObject=1
    WHILE OBJECT_EXISTS(CreateNewObject)=1
        CreateNewObject=CreateNewObject+1
    END_WHILE
RETURN

LABEL Factorielle
DIM PILE:PILE=1:DLIST PILE
DIM resultat, n

n = 15
GOSUB Factorielle : ' n!
PRINT n;"! =";resultat
END

Factorielle:
    resultat = n
    IF n=1 THEN RETURN
    ITEM_ADD PILE,n
    ITEM_ADD PILE,resultat
    n = n - 1 : GOSUB Factorielle
    resultat = resultat * VAL(ITEM_READ$(PILE,COUNT(PILE)))
    ITEM_DELETE PILE,COUNT(PILE)
    n = VAL(ITEM_READ$(PILE,COUNT(PILE))) : ITEM_DELETE PILE,COUNT(PILE)
RETURN

' ------------------------------------------------------------------------------
'      SIMULATION D'APPEL DE FONCTIONS AVEC PASSAGE DE PARAMETRES
' Auteur : Nardo26
' ------------------------------------------------------------------------------
DIM Debug: Debug=0


' Liste des procédures :
LABEL CARRE :  ' resultat = Carre(N)
LABEL FACTORIELLE
LABEL RINSTR
LABEL HEX2RVB

' Déclaration de la pile de gestion des paramètres
DIM PILE:PILE = 20

IF Debug = 0
  DLIST PILE
ELSE
  DIM CAPTION_SIZE:HEIGHT 0,0:CAPTION_SIZE=HEIGHT(0):HEIGHT 0,400
  DIM BORDER_SIZE:PICTURE 1:FULL_SPACE 1:BORDER_SIZE=WIDTH(0)-WIDTH(1):DELETE 1
  DIM FORM_DEBUG:FORM_DEBUG=200
  FORM FORM_DEBUG:LEFT FORM_DEBUG,SCREEN_X-WIDTH(FORM_DEBUG)-20
  CAPTION FORM_DEBUG,"PILE"
  LIST PILE:PARENT PILE,FORM_DEBUG:WIDTH PILE,WIDTH(FORM_DEBUG)-BORDER_SIZE:HEIGHT PILE,HEIGHT(FORM_DEBUG)-CAPTION_SIZE
END_IF

' ------------------------------------------------------------------------------
' TESTS DES DIFFERENTES FONCTIONS
' ------------------------------------------------------------------------------

DIM N,Resultat

' -------------------------------
' Test de la fonction CARRE(N) :
' -------------------------------
N=5
' On empile le paramètre d'entrée + appel à la fonction carre()
ITEM_ADD PILE,str$(N):GOSUB CARRE
' on récupère la valeur en retour :
Resultat = VAL(ITEM_READ$(PILE,COUNT(PILE))) : ITEM_DELETE PILE,COUNT(PILE)
PRINT:PRINT "  CARRE(";N;") = ";Resultat

' -----------------------------------
' Test de la fonction RINSTR(S1$,S2$)
' -----------------------------------
' passage de 2 paramètres :
DIM s1$: s1$="C:\Dir1\Dir2\Dir3"
DIM s2$: s2$="\"
PRINT:PRINT "  RINSTR('";s1$;"','";s2$;"') = ";
ITEM_ADD PILE,s1$ : ITEM_ADD PILE,s2$
IF Debug = 1 THEN STOP  : ' pour controler le contenu de la pile
GOSUB RINSTR
IF Debug = 1 THEN STOP  : ' pour controler le contenu de la pile
' on récupère la valeur en retour
Resultat = VAL(ITEM_READ$(PILE,COUNT(PILE))) : ITEM_DELETE PILE,COUNT(PILE)
PRINT Resultat

' -----------------------------------
' Test de la fonction HEX2RVB(S1$)
' -----------------------------------
s1$="FFECBA"
DIM R,V,B
ITEM_ADD PILE,s1$:GOSUB HEX2RVB
R = VAL(ITEM_READ$(PILE,COUNT(PILE))) : ITEM_DELETE PILE,COUNT(PILE)
V = VAL(ITEM_READ$(PILE,COUNT(PILE))) : ITEM_DELETE PILE,COUNT(PILE)
B = VAL(ITEM_READ$(PILE,COUNT(PILE))) : ITEM_DELETE PILE,COUNT(PILE)
PRINT: PRINT "  HEX2RVB('";s1$;"') = ";R;",";V;",";B

' -----------------------------------
' Test de la fonction FACTORIELLE(N)
' -----------------------------------
' On empile le paramètre d'entrée + appel à la fonction Factorielle()
ITEM_ADD PILE,STR$(N):GOSUB FACTORIELLE
' on depile le résultat :
Resultat = VAL(ITEM_READ$(PILE,COUNT(PILE))) : ITEM_DELETE PILE,COUNT(PILE)
PRINT:PRINT "  ";N;"! = ";Resultat


END

' ------------------------------------------------------------------------------
' Exemple fonction avec un paramètre :
'    retour = CARRE(N)
'    -> retourne le carré de N
' ------------------------------------------------------------------------------
CARRE:
    IF VARIABLE("Carre_return")=0
        DIM Carre_return
    END_IF
    ' on récupère le paramètre en entrée
    Carre_return = VAL(ITEM_READ$(PILE,COUNT(PILE))): ITEM_DELETE PILE,COUNT(PILE)
    Carre_return = Carre_return * Carre_return
    ' Ajout du résultat dans la pile du résultat
    ITEM_ADD PILE,STR$(Carre_return)
RETURN

' ------------------------------------------------------------------------------
' Exemple fonction avec un paramètre d'entrée et 3 valeurs en retour:
' R,V,B = HEX2RVB(S1)
' ------------------------------------------------------------------------------
HEX2RVB:
    IF VARIABLE("Hex2RVB_r")=0
        DIM Hex2RVB_str$,Hex2RVB_R,Hex2RVB_V,Hex2RVB_B
    END_IF
    ' on récupère le paramètre en entrée
    Hex2RVB_str$ = TRIM$(ITEM_READ$(PILE,COUNT(PILE))): ITEM_DELETE PILE,COUNT(PILE)
    ' on insere dans la pile :
    ITEM_ADD PILE,STR$(HEX(RIGHT$(Hex2RVB_str$,2))) : ' composante B
    ITEM_ADD PILE,STR$(HEX(MID$(Hex2RVB_str$,3,2))): ' composante V
    ITEM_ADD PILE,STR$(HEX(LEFT$(Hex2RVB_str$,2)))  : ' composante R
RETURN
' ------------------------------------------------------------------------------
' Exemple de fonction avec deux paramètres :
'    retour = RINSTR(s1,s2)    idem instr mais en partant par la fin de s1
'    -> retourne la position de s2 dans s1 sinon 0
' ------------------------------------------------------------------------------
RINSTR:
    IF VARIABLE("Rinstr_s1$")=0
        DIM Rinstr_s1$,Rinstr_s2$,Rinstr_return,Rinstr_i
    END_IF
    ' on récupère les chaines s1 et s2 dans la pile
    Rinstr_s2$ = ITEM_READ$(PILE,COUNT(PILE)): ITEM_DELETE PILE,COUNT(PILE)
    Rinstr_s1$ = ITEM_READ$(PILE,COUNT(PILE)): ITEM_DELETE PILE,COUNT(PILE)
    Rinstr_return = 0
    IF LEN(Rinstr_s2$) = LEN(Rinstr_s1$)
        Rinstr_return= INSTR(Rinstr_s1$,Rinstr_s2$)
    ELSE
        IF LEN(Rinstr_s2$) < LEN(Rinstr_s1$)
            FOR Rinstr_i=LEN(Rinstr_s1$)-LEN(Rinstr_s2$) TO 1 STEP -1
              Rinstr_return = INSTR(MID$(Rinstr_s1$,Rinstr_i,LEN(Rinstr_s2$)),Rinstr_s2$)
              IF Rinstr_return <> 0 THEN Rinstr_return = Rinstr_i : EXIT_FOR
            NEXT Rinstr_i
        END_IF
    END_IF
    ' on empile le résultat
    ITEM_ADD PILE, STR$(Rinstr_return)
return

' ------------------------------------------------------------------------------
' Exemple de fonction récursive avec un paramètre :
'    retour = FACTORIELLE(N)
'    -> retourne N!
' ------------------------------------------------------------------------------
FACTORIELLE:
    IF VARIABLE("Factorielle_n") = 0
        DIM Factorielle_n, Factorielle_return
    END_IF
    ' [3] récupération + depilement du paramètre en entrée
    Factorielle_n = VAL(ITEM_READ$(PILE,COUNT(PILE))):ITEM_DELETE PILE,COUNT(PILE)
    ' Mise à jour de la valeur de retour
    Factorielle_return = Factorielle_n
    ' [2] Si factorielle de 1, on empile la valeur de retour
    IF (Factorielle_return = 1) THEN ITEM_ADD PILE,STR$(Factorielle_return): RETURN
    ' [1] Sinon on empile N
    ITEM_ADD PILE,STR$(Factorielle_n)
    ' [3] Appel à Factorielle(N-1)
    Factorielle_n = Factorielle_n - 1 : ITEM_ADD PILE,STR$(Factorielle_n) : GOSUB FACTORIELLE
    ' [2] on récupère la valeur de retour de factorielle(N-1)
    Factorielle_return = VAL(ITEM_READ$(PILE,COUNT(PILE))) : ITEM_DELETE PILE,COUNT(PILE)
    ' [1] on dépile N
    Factorielle_n = VAL(ITEM_READ$(PILE,COUNT(PILE))): ITEM_DELETE PILE,COUNT(PILE)
    ' on multiplie : N * Factorielle(n-1)
    Factorielle_return = Factorielle_n * Factorielle_return
    ' [2] on stocke dans la pile la nouvelle valeur de retour
    ITEM_ADD PILE,STR$(Factorielle_return)
return

LABEL Factorielle
DIM resultat, n, i

n = 15 : i = 1 : resultat = 1      : ' n doit être >= 0 pour un factoriel
GOSUB Factorielle : ' n!
PRINT n;"! =";resultat
END

Factorielle:
    IF i > n THEN RETURN
    resultat = resultat * i
    i = i + 1 : GOSUB Factorielle
RETURN

LABEL Factorielle
DIM resultat, n, i
n=15:resultat=1
GOSUB Factorielle
PRINT resultat
END
Factorielle:
  FOR i = 1 TO n : resultat = resultat * i : NEXT i
RETURN