Challenge 23

[(gile)]

Salut,

 

Un petit challenge pour jouer avec l'appariement de caractères.

Les parenthèses du LISP, les accolades du DCL ou des formatages de mtextes fonctionnent par paires et peuvent être profondément imbriquées.

 

Il s'agirait donc de faire une routine "générique" qui retournerait une liste composée de la position d'un caractère ouvrant et de son correspondant fermant dans une chaîne.

 

Les arguments pourraient être :

- le caractère (ou suite de caractère) "ouvrant" ex : "(", "{", "%

- son correspondant fermant, ex : ")", "}", ">%"...

- la chaîne

- la position du départ de la recherche dans la chaîne

 

exemples :

 

(paire "(" ")" "(* (+ 2 3) 6)" 0) retourne (0 12)

(paire "(" ")" "(* (+ 2 3) 6)" 1) retourne (3 9)

(paire "(" ")" "(* (+ 2 3) 6" 0) retourne nil

 

 

[Edité le 18/8/2008 par (gile)]

[Patrick_35]

Salut (gile)

 

Une permière version, mais qui triche un peu ;)

(defun paire(1er 2em str pos); / asc lst pos1 pos2 tot1 tot2)
 (setq lst (vl-list->string (reverse (setq asc (vl-string->list str)))))
 (if (and (/= 1er 2em)
   (setq pos1 (vl-string-search 1er str pos))
   (setq pos2 (vl-string-search 2em lst pos))
   (setq tot1 (length asc)
	 asc  (vl-remove (ascii 1er) asc)
	 tot1 (- tot1 (setq tot2 (length asc)))
	 asc  (vl-remove (ascii 2em) asc)
	 tot2 (- tot2 (length asc))
   )
   (eq tot1 tot2)
     )
   (list pos1 (1- (- (strlen str) pos2)))
   nil
 )
)

 

Une seconde qui correspond beaucoup mieux et qui répond aussi aux conditions suivantes

(paire "(" ")" "(* (+ 2 3) 6" 1) retourne (3 9)

(paire "(" ")" "(* (+ 2 3) 6" 4) retourne nil

(paire "(" ")" "* (+ 2 3) 6)" 0) retourne (2 8)

 

(defun paire(1er 2em str whe / loc lst1 lst2 pos pos1 pos2 tbl)
 (setq loc 0
tbl 0
 )
 (while (setq pos (vl-string-search 1er str loc))
   (and (< pos whe)
     (setq tbl (1+ tbl))
   )
   (setq lst1 (cons pos lst1)
  loc (1+ pos)
   )
 )
 (setq loc 0)
 (while (setq pos (vl-string-search 2em str loc))
   (setq lst2 (cons pos lst2)
  loc (1+ pos)
   )
 )
 (if (and
(/= 1er 2em)
lst1
lst2
(> (length lst1) tbl)
(> (- (length lst1) tbl) 0)
(setq pos1 (nth tbl (reverse lst1)))
(setq pos2 (nth (1- (- (length lst1) tbl)) (reverse lst2)))
     )
   (list pos1 pos2)
 )
)

 

ps : c'est plutôt le challenge 23 ;)

 

@+

[(gile)]

Salut,

 

Peut-être me suis-je mal exprimé, quand je disais paire "correspondante", je voulais bien dire le caractère fermant correspondant au caractère ouvrant.

 

Un autre exemple plus "déterminant" :

 

(setq str "(1(3)5(7(9)))")

 

(paire "(" ")" str 0) doit retourner (0 12) là pas de soucis

 

(paire "(" ")" str 1) doit retourner (2 4) paire_pat1 retourne (2 10) et paire_pat2 retourne (2 11)

 

(paire "(" ")" str 6) doit retourner (6 11) paire_pat1 retourne (6 4) et paire_pat2 retourne (6 10)

 

(paire "(" ")" str 8) doit retourner (8 10) paire_pat1 et paire_pat2 retournent (8 4)

[Patrick_35]

Re

 

Je ne l'avais pas vu de cette manière.

 

(defun paire(1er 2em str pos / cnt deb fin imb lst)
 (if (setq deb (vl-string-search 1er str pos))
   (progn
     (setq lst (vl-string->list str)
    cnt (1+ deb)
    imb 0
     )
     (while (setq cac (nth cnt lst))
(if (eq (chr cac) 1er)
  (setq imb (1+ imb))
  (if (eq (chr cac) 2em)
    (if (> imb 0)
      (setq imb (1- imb))
      (setq fin cnt
	    cnt (1+ (length lst))
      )
    )
  )
)
(setq cnt (1+ cnt))
     )
     (if (and deb fin)
(list deb fin)
     )
   )
 )
)

 

@+

[(gile)]

Ça fonctionne, mais curieusement c'est moins rapide que la méthode que j'utilise sans transformer la chaîne en liste (pour pouvoir apparier des successions de plusieurs caractères comme "%%" dans les codes de champ)

[(gile)]

Devant l'enthousiasme suscité par ce challenge, je donne ma réponse.

 

(defun paire (op cl str pos / opened closed start tmp cnt)
 (and
   (setq opened (vl-string-search op str pos))
   (setq start	 (1+ opened)
  closed T
  cnt	 1
   )
   (while (and closed (      (setq tmp	   (vl-string-search op str start)
    closed (vl-string-search cl str start)
     )
     (if closed
(if (and tmp (	  (setq	cnt   (1+ cnt)
	start (1+ tmp)
  )
  (setq	cnt   (1- cnt)
	start (1+ closed)
  )
)
     )
   )
 )
 (if (= 0 cnt)
   (list opened closed)
 )
) 

[Patrick_35]

Devant l'enthousiasme suscité par ce challenge

C'est les vacances ;)

 

@+

[ElpanovEvgeniy]

Bon matin!

Je n'utilise pas VL-* :)

 (defun paire-e (a b s i)
;; ElpanovEvgeniy
(setq s (substr s (1+ i))
      i (list i)
)
(while (and (or (null (cdr i)) (not (zerop (car i))))
            (null (= s ""))
       )
 (if (cdr i)
  (cond ((= a (substr s 1 1))
         (setq i (cons (1+ (car i)) (cons (1+ (cadr i)) (cddr i)))
               s (substr s 2)
         )
        )
        ((= b (substr s 1 1))
         (if (= (car i) 1)
          (setq i (cdr i)
                s ""
          )
          (setq i (cons (1- (car i)) (cons (1+ (cadr i)) (cddr i)))
                s (substr s 2)
          )
         )
        )
        (t
         (setq i (cons (car i) (cons (1+ (cadr i)) (cddr i)))
               s (substr s 2)
         )
        )
  )
  (if (= a (substr s 1 1))
   (setq i (cons 1 (cons (1+ (car i)) i))
         s (substr s 2)
   )
   (setq i (list (1+ (car i)))
         s (substr s 2)
   )
  )
 )
)
(if (and (cdr i) (null (cddr i)))
 (reverse i)
)
) 

 

[Edité le 22/8/2008 par ElpanovEvgeniy]

[(gile)]

Jolie routine Evgeniy, mai les fonction vl-* semblent plus rapides.

 

_$ (setq str "(1(3)5(7(9)))")

"(1(3)5(7(9)))"

_$ (benchmark '((paire-e "(" ")" str 0) (paire_gile "(" ")" str 0) (paire_pat "(" ")" str 0)))

Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):

 

(PAIRE_GILE "(" ")" STR 0).....1766 / 2.49

(PAIRE_PAT "(" ")" STR 0)......2391 / 1.84

(PAIRE-E "(" ")" STR 0)........4406 / 1.00