Challenge31

(gile) · le 24 janvier 2010

Salut,

Un sujet dans le forum "ObjectARX/DBX, C++, .NET, RealDWG" m'a donné une idée.

Il s'agirait de faire une routine qui retourne le chemin relatif d'un fichier par rapport à un dossier.

La routine aurait 2 arguments : le chemin complet du dossier et le chemin complet du fichier.

Le chemin du dossier devrait pouvoir être spécifié avec ou sans \ à la fin :

"C:\\Doc\\Toto\\Test" ou "C:\\Doc\\Toto\\Test\\"

(foo "C:\\Doc\\Toto\\Test" "c:\\doc\\toto\\test\\blah\\fichier") retourne : ".\\blah\\fichier"

(foo "C:\\Doc\\Toto\\Test" "c:\\doc\\toto\\blah\\fichier") retourne : "..\\blah\\fichier"

(foo "C:\\Doc\\Toto\\Test" "c:\\doc\\fichier") retourne : "..\\..\\fichier"

(foo "C:\\Doc\\Toto\\Test" "F:\\blah\\fichier") retourne : "F:\\blah\\fichier"

ElpanovEvgeniy · le 28 janvier 2010

Toutes les salutations!

Dans cette rubrique sans réponses...

Puis-je présenter ma version du programme ou de la peine d'attendre?

Tramber · le 28 janvier 2010

Tu peux Eugène !

J'ai essayé avec CHR et ASCII ou vl-string-xxx-trim mais je n'ai pas réussi à faire bien !

Personne n'ose tenter sa chance.

Pajalista

ElpanovEvgeniy · le 28 janvier 2010

Si vous avez besoin de plus de temps, je peux attendre.

J'ai un code simple, sans récurrence, en utilisant des variables supplémentaires ...

Je pense que vous pouvez facilement faire tous!

Tramber · le 28 janvier 2010

sans récurrence

Ah bon ? Tu es malade ? :cool:

ElpanovEvgeniy · le 28 janvier 2010

sans récurrence

Ah bon ? Tu es malade ? :cool:

no!

no recursion (rus >> fr) "sans récursion"

без рекурсии

Tramber · le 28 janvier 2010

рекурсии comme "recursion", j'ai bien compris !

без comme "sans"

Ok

C'est une blague ! Car d'habitude, tu fais des récursions.

ElpanovEvgeniy · le 28 janvier 2010

J'ai décidé que la récursivité ne contribue pas à moi de faire une plus courte ou plus simple - besoin de faire plusieurs programmes et les lier ...

ps. Désolé, je trouve qu'il est difficile d'attraper la plaisanterie.

ElpanovEvgeniy · le 28 janvier 2010

no recursion:

 
(defun test (a b / i)
;;(test a b)
(setq a (strcase a t)
      b (strcase b t)
)
(cond ((/= (substr a 1 3) (substr b 1 3)) b)
      ((wcmatch b (strcat a "*")) (strcat "." (substr b (1+ (strlen a)))))
      (t
       (while (= (substr a 1 (setq i (vl-string-position 92 a))) (substr b 1 i))
        (setq a (substr a (+ i 2))
              b (substr b (+ i 2))
        )
       )
       (While a
        (setq b (strcat "..\\" b)
              a (if (setq i (vl-string-position 92 a))
                 (substr a (+ i 2))
                )
        )
       )
       b
      )
)
)

Tramber · le 28 janvier 2010

ps. Désolé, je trouve qu'il est difficile d'attraper la plaisanterie.

Don't worry.

Je suis bien souvent le seul à me trouver drôle.

Belle routine, comme d'habitude.

Même si il n'y a pas de récursivité :red:

(gile) · le 28 janvier 2010

voilà ce que j'avais fait :

(defun GetRelativePath (dir file / a b)
 (setq dir (vl-string-right-trim "\\" dir))
 (if (/= (strcase (substr dir 1 1)) (strcase (substr file 1 1)))
   file
   (progn
     (while
       (= (strcase (substr dir 1 (setq a (vl-string-position 92 dir))))
          (strcase (substr file 1 (setq b (vl-string-position 92 file))))
       )
        (setq dir (if a
                  (substr dir (+ 2 a))
                  ""
                )
              file (substr file (+ 2 b))
        )
     )
     (if (= dir "")
       (strcat ".\\" file)
       (progn
         (while (setq a (vl-string-position 92 dir))
           (setq file (strcat "..\\" file)
                 dir (substr dir (+ 2 a))
           )
         )
         (strcat "..\\" file)
       )
     )
   )
 )
)

Tramber · le 28 janvier 2010

Moi je jouais plus avec ce type de fonctions :

(setq a "C:\\Doc\\Toto\\Test" b "c:\\doc\\toto\\test\\blah\\fichier")
(setq a(strcase a )b(strcase b) )
(setq al(vl-string->list a))
(setq bl(vl-string->list b))
(while(=(car al)(car bl))
 (setq al(cdr al)bl(cdr bl)))
(vl-list->string  bl)

Malheureusement BL ressort en majuscules.

Mais j'ai effacé le brillant code que j'avais commencé à écrire à la maison. Jugeant que je n'étais pas digne de vous....

J'ai peut-être eu tord !

ElpanovEvgeniy · le 28 janvier 2010

Moi je jouais plus avec ce type de fonctions :
(setq a "C:\\Doc\\Toto\\Test" b "c:\\doc\\toto\\test\\blah\\fichier")
(setq a(strcase a )b(strcase b) )
(setq al(vl-string->list a))
(setq bl(vl-string->list b))
(while(=(car al)(car bl))
 (setq al(cdr al)bl(cdr bl)))
(vl-list->string  bl) 
Malheureusement BL ressort en majuscules.

Mais j'ai effacé le brillant code que j'avais commencé à écrire à la maison. Jugeant que je n'étais pas digne de vous....

J'ai peut-être eu tord !

vérifier

(setq a "C:\\Doc\\Toto\\Temp"
     b "c:\\doc\\toto\\test\\blah\\fichier"
)

(gile) · le 29 janvier 2010

Salut,

Je n'ai pas eu trop de temps pour répondre hier.

I didn't have many time to reply yesterday.

Super Evgeniy, comme toujours...

Super Evgeniy, as usual...

Juste une petite chose, la routine devait fonctionner que le répertoire soit spécifié comme retourné par :

Just a little thing, the routine would work for directories specified as returned by:

(getvar "dwgprefix") => "C:\\Doc\\Toto\\Test\\"

ou par :

or by:

(vl-filename-directory f) => "C:\\Doc\\Toto\\Test"

(test "C:\\Doc\\Toto\\Test\\" "c:\\doc\\toto\\blah\\fichier") => "..\\..\\blah\\fichier"

(test "C:\\Doc\\Toto\\Test" "c:\\doc\\toto\\blah\\fichier") => "..\\blah\\fichier"

(GetRelativePath "C:\\Doc\\Toto\\Test\\" "c:\\doc\\toto\\blah\\fichier") => "..\\blah\\fichier"

(GetRelativePath "C:\\Doc\\Toto\\Test" "c:\\doc\\toto\\blah\\fichier") => "..\\blah\\fichier"

Patrick_35 · le 30 janvier 2010

Salut

Ma version

Elle fonctionne en international

(defun foo(base rech / loc1 loc2 pos1 pos2 pos3 resu)
 (if (<= (strlen base) (strlen rech))
   (progn
     (setq ch (vl-string-translate "\\" "/" base)
    rc (vl-string-translate "\\" "/" rech)
     )
     (or (eq (substr ch (strlen ch) 1) "/") (setq ch (strcat ch "/")))
     (or (eq (substr rc (strlen rc) 1) "/") (setq rc (strcat rc "/")))
     (setq pos1 (vl-string-search "/" ch)
    pos2 (vl-string-search "/" rc)
    loc1 1
    loc2 1
     )
     (while (and pos1 pos2 (= (strcase (substr ch 1 pos1)) (strcase (substr rc 1 pos2))))
(setq loc1 pos1
      loc2 pos2
      pos1 (vl-string-search "/" ch (1+ pos1))
      pos2 (vl-string-search "/" rc (1+ pos2))
)
     )
     (cond
((and (< loc1 4) (< loc2 4))
  (setq resu rc)
)
((eq (strlen ch) (1+ loc1))
  (if (eq (strlen rc) (1+ loc2))
    (setq resu "./")
    (setq resu (strcat "./" (substr rc (+ 2 loc2))))
  )
)
(T
  (setq pos3 loc2
	resu (substr rc (+ 2 loc2))
  )
  (while (setq pos3 (vl-string-search "/" ch (1+ pos3)))
    (setq resu (strcat "../" resu))
  )
)
     )
     (or (member (substr rech (strlen rech) 1) '("/" "\\"))
(setq resu (substr resu 1 (1- (strlen resu))))
     )
     (and (vl-string-search "\\" rech)
       (setq resu (vl-string-translate "/" "\\" resu))
     )
   )
 )
 resu
)

Autres tests

(foo "C:\\Doc\\Toto\\Test" "C:\\Doc\\Toto\\Test") retourne "."

(foo "C:\\Doc\\Toto\\Test" "c:\\blah\\fichier") retourne "c:\\blah\\fichier"

(foo "C:\\" "c:\\") retourne "c:\\"

(foo "C:\\yoyo\\test\\123" "c:\\yoyo") retourne nil

@+

(gile) · le 30 janvier 2010

Patrick_35,

Autres tests

(foo "C:\\Doc\\Toto\\Test" "C:\\Doc\\Toto\\Test") retourne "."

(foo "C:\\Doc\\Toto\\Test" "c:\\blah\\fichier") retourne "c:\\blah\\fichier"

(foo "C:\\" "c:\\") retourne "c:\\"

(foo "C:\\yoyo\\test\\123" "c:\\yoyo") retourne nil

Si "C:\\Doc\\Toto\\Test" est le chemin du dossier "Test" et "C:\\Doc\\Toto\\Test" le chemin du fichier "Test",

(foo "C:\\Doc\\Toto\\Test" "C:\\Doc\\Toto\\Test") devrait retourner "..\\Test"

de même,

(foo "C:\\Doc\\Toto\\Test" "c:\\blah\\fichier") devrait retourner "..\\..\\..\\blah\\fichier"

(foo "C:\\yoyo\\test\\123" "c:\\yoyo") devrait retourner "..\\..\\..\\yoyo"

(foo "C:\\" "c:\\") devrait retourner un message d'erreur ou nil.

Evgeniy,

((wcmatch file (strcat dir "*")) (strcat "." (substr file (1+ (strlen dir)))))

L'expression me plaisait mais :

(test "C:\\Doc\\Toto\\Test" "c:\\doc\\toto\\test LISP\\blah\\fichier")

retourne:

". lisp\\blah\\fichier"

J'ai essayé quelque chose de plus sûr :

(defun RelativePath (dir file / i)
 (setq dir (strcat (vl-string-right-trim "\\" dir) "\\"))
 (if (/= (strcase (substr dir 1 1)) (strcase (substr file 1 1)))
   file
   (progn
     (while
(and
  (setq i (vl-string-position 92 dir))
  (= (strcase (substr dir 1 (1+ i)))
     (strcase (substr file 1 (1+ i)))
  )
)
 (setq dir  (substr dir (+ 2 i))
       file (substr file (+ 2 i))
 )
     )
     (cond
((= file "") nil)
((= dir "") (strcat ".\\" file))
(T
 (while	(setq i (vl-string-position 92 dir))
   (setq dir  (substr dir (+ 2 i))
	 file (strcat "..\\" file)
   )
 )
)
     )
   )
 )
)

Patrick_35 · le 31 janvier 2010

Salut (gile)

Je pense que tu étais fatigué hier soir ;)

Si "C:\\Doc\\Toto\\Test" est le chemin du dossier "Test" et "C:\\Doc\\Toto\\Test" le chemin du fichier "Test",
(foo "C:\\Doc\\Toto\\Test" "C:\\Doc\\Toto\\Test") devrait retourner "..\\Test"

Un chemin relatif entre "C:\\Doc\\Toto\\Test" et "C:\\Doc\\Toto\\Test" ne peut donner comme résultat qu'un "." car on fait une comparaison entre les mêmes arborescences et si c'est identique, le "." est donc le résultat

(foo "C:\\Doc\\Toto\\Test" "c:\\blah\\fichier") devrait retourner "..\\..\\..\\blah\\fichier"

Un chemin relatif entre "C:\\Doc\\Toto\\Test" et "c:\\blah\\fichier" ne peut donner comme résultat qu'un "c:\\blah\\fichier" car rien n'est commun dans l'arborescence sauf la racine, donc pas de chemin relatif

(foo "C:\\" "c:\\") devrait retourner un message d'erreur ou nil.

Un chemin relatif entre "C:\\" et "c:\\" donne comme résultat un "." car l'arborescence est identique, mais comme c'est la racine, je préfere donc un "c:\\"

(foo "C:\\yoyo\\test\\123" "c:\\yoyo") devrait retourner "..\\..\\..\\yoyo"

Un chemin relatif entre "C:\\yoyo\\test\\123" et "c:\\yoyo") ne peut donner comme résulat qu'une erreur, donc un nil car on inverse la recherche du chemin relatif

@+

(gile) · le 31 janvier 2010

Salut,

Je pense que tu étais fatigué hier soir

Je pense qu'il s'agit plutôt d'un mal-entendu.

Un chemin relatif entre "C:\\Doc\\Toto\\Test" et "C:\\Doc\\Toto\\Test" ne peut donner comme résultat qu'un "." car on fait une comparaison entre les mêmes arborescences et si c'est identique, le "." est donc le résultat

Pour moi, il était clair que le premier argument est un dossier, le second un fichier.

J'aurais dû mettre une extension.

(foo "C:\\Doc\\Toto\\Test" "C:\\Doc\\Toto\\Test.dwg") doit bien retourner "..\\Test.dwg"

Un chemin relatif entre "C:\\Doc\\Toto\\Test" et "c:\\blah\\fichier" ne peut donner comme résultat qu'un "c:\\blah\\fichier" car rien n'est commun dans l'arborescence sauf la racine, donc pas de chemin relatif

Tu as raison, quoique... un chemin relatif peut remonter jusqu'à la racine et si les dossiers Doc et blah sont déplacés sur un autre disque, le chemin relatif reste valable.

Un chemin relatif entre "C:\\yoyo\\test\\123" et "c:\\yoyo") ne peut donner comme résulat qu'une erreur, donc un nil car on inverse la recherche du chemin relatif

Voir plus haut. J'aurais dû préciser "C:\\yoyo.dwg"...

L'énoncé n'était pas clair, au temps pour moi...

Patrick_35 · le 1 février 2010

Je pense qu'il s'agit plutôt d'un mal-entendu.

Ok, d'autant que tu prècises

Le chemin du dossier devrait pouvoir être spécifié avec ou sans \ à la fin :
"C:\\Doc\\Toto\\Test" ou "C:\\Doc\\Toto\\Test\\"

@+

ElpanovEvgeniy · le 1 février 2010

last version:

(defun test (a b / i)
(setq a (vl-string-right-trim "\\" (strcase a t))
      b (vl-string-right-trim "\\" (strcase b t))
) ;_  setq
(cond ((/= (substr a 1 3) (substr b 1 3)) b)
      ((wcmatch b (strcat a "\\*")) (strcat "." (substr b (1+ (strlen a)))))
      (t
       (while (= (substr a 1 (setq i (vl-string-position 92 a)))
                 (substr b 1 (vl-string-position 92 b))
              ) ;_  =
        (setq a (substr a (+ i 2))
              b (substr b (+ i 2))
        ) ;_  setq
       ) ;_  while
       (While a
        (setq b (strcat "..\\" b)
              a (if (setq i (vl-string-position 92 a))
                 (substr a (+ i 2))
                ) ;_  if
        ) ;_  setq
       ) ;_  While
       b
      )
) ;_  cond
)

[Edité le 1/2/2010 par ElpanovEvgeniy]

ElpanovEvgeniy · le 1 février 2010

recursion:

(defun p->lst (a / i)
(if (wcmatch a "*\\*")
 (cons (substr a 1 (setq i (vl-string-position 92 a))) (p->lst (substr a (+ i 2))))
 (list a)
)
)
(defun comp (a b)
(if (and a b (= (strcase (car a) t) (strcase (car b) t)))
 (comp (cdr a) (cdr b))
 (list a b)
)
)
(defun test (a b)
(setq a (comp (p->lst a) (p->lst b)))
(if (= (caar a) (caadr a))
 (apply 'strcat
        (append (cond ((not (car a)) '(".\\"))
                      ((mapcar '(lambda (a) "..\\") (car a)))
                )
                (mapcar '(lambda (a) (strcat a "\\")) (cadr a))
        )
 )
 b
)
)

Connexion

Challenge31

Messages recommandés

(gile)

ElpanovEvgeniy

Tramber

ElpanovEvgeniy

Tramber

ElpanovEvgeniy

Tramber

ElpanovEvgeniy

ElpanovEvgeniy

Tramber

(gile)

Tramber

ElpanovEvgeniy

(gile)

Patrick_35

(gile)

Patrick_35

(gile)

Patrick_35

ElpanovEvgeniy

ElpanovEvgeniy

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante