ElpanovEvgeniy

L'algorithme de mon premier et ton programme sont semblables. Mon deuxième programme utilise un autre algorithme. 1. Je trouve l'une fois les paires des blocs mis. 2. Je trouve les racines des blocs - qui ne sont pas mis dans les autres 3. Je trouver la succession seulement des racines.

Un petit benchmark pour le fun : avec le fichier que (gile) donn? (niveau 4) avec le fichier de bseb67 (niveau 65) [Edité le 3/12/2009 par ElpanovEvgeniy]

Vous avez choisi la vitesse... :) Ma réponse : (defun ff4 (/ A B C D E F) ;;(ff4) (defun rd (l) (if l (cons (car l) (rd (vl-remove (car l) (cdr l)))) ) ;_ if ) ;_ defun (while (setq b (cdr (assoc 2 (tblnext "BLOCK" (not b))))) (setq a (tblobjname "BLOCK" b)) (while a (while (and a (/= (cdr (assoc 0 (entget a))) "INSERT")) (setq a (entnext a))) (setq c (cons (cons b a) c)) (and a (setq a (entnext a))) ) ;_ while ) ;_ while (foreach a c (setq f (cons (if (cdr a) (list (cdr (assoc 2 (entget (cdr a)))) (car a)) ) ;_ if f ) ;_ cons ) ;_ setq ) ;_ foreach (setq f (vl-remove nil f) c (mapcar (function reverse) f) d 1 e 1 ) ;_ setq (foreach a (vl-remove-if (function (lambda (a) (assoc a f))) (rd (mapcar (function car) c)) ) ;_ vl-remove-if (while (setq a (assoc a c)) (setq d (1+ d) c (vl-remove a c) a (cadr a) ) ;_ setq ) ;_ while (setq e (max d e) d 1 ) ;_ setq ) ;_ foreach e ) Un petit benchmark pour le fun : avec le fichier que (gile) donn? (niveau 4) avec le fichier de bseb67 (niveau 65)

Salut Vous estimez est trop haut mes possibilités! Vous avez écrit les programmes excellents, avec l'utilisation VLA-* Pour moi resta seulement propre LISP... (defun f (/ B I) (defun f1 (a) (cond ((not a) 1) ((/= (cdr (assoc 0 (entget a))) "INSERT") (f1 (entnext a))) ((max (1+ (f1 (tblobjname "BLOCK" (cdr (assoc 2 (entget a)))))) (f1 (entnext a)))) ) ) (setq i 0) (while (setq b (cdr (assoc 2 (tblnext "BLOCK" (= 0 i))))) (setq i (max i (f1 (tblobjname "BLOCK" b)))) ) )

Je demande pardon. J'étais peu attentif...

Salut, (gile) :) Il m'est difficile de comprendre ce sujet. Montre deux images - jusqu'à et après...

Aujourd'hui, a remarqué le contrôle superflu dans la première ligne.. (defun F (i l) (cond ((null (and i (cdr l))) l) ((= 1 (car i)) (cons (cadr l) (f (mapcar '1- (cdr i)) (cons (car l) (cddr l))))) ((cons (car l) (f (mapcar '1- (if (< (car i) 1) (cdr i) i)) (cdr l)))) ) )

Salut Tramber. Je fais les excuses! Effectivement, il m'était nécessaire d'être plus retenu et attendre jusqu'à lundi suivant...

Maintenant, je réduis quelques mots : (defun F (i l) (cond ((or (null i) (null (cdr l))) l) ((= 1 (car i)) (cons (cadr l) (f (mapcar '1- (cdr i)) (cons (car l) (cddr l))))) ((cons (car l) (f (mapcar '1- (if (< (car i) 1)(cdr i) i)) (cdr l)))) ) ;_ cond ) :)

Patrick_35, contrôle le programme : (setq lst '("a" "a" "a" "b" "b" "b")) (list_up1 '(2 3) lst) ;=>> ("a" "a" "a" "a" "a" "a" "a" "a" "a" "b" "b" "b") (list_up1 '(0 3) lst) ;=>> ("a" "a" "a" "b" "b" "b" "b" "b") (list_up1 '(0 1 4 5) lst);=>> ("a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "b" "b" "b")

recursion variant: (defun F (i l) (cond ((or (null i) (null (cdr l))) l) ((= 1 (car i)) (cons (cadr l) (f (mapcar '1- (cdr i)) (cons (car l) (cddr l))))) ((< (car i) 1) (cons (car l) (f (mapcar '1- (cdr i)) (cdr l)))) ((cons (car l) (f (mapcar '1- i) (cdr l)))) ) )

Salut! Je montrerai absolument la variante. Les jours fériés, je regarde seulement vos variantes. Je montrerai seulement recursion la variante...

Hi bonuscad. My code, slowly works on the big texts...

(defun test (s o n) (cond ((= s "") s) ((wcmatch s (strcat o "*")) (strcat n (test (substr s (1+ (strlen o))) o n))) ((strcat (substr s 1 1) (test (substr s 2) o n))) ) ;_ cond )

M'excusez. Je ne suis pas assuré qu'a compris exactement. À moi il vaut mieux se taire...

>ahoule Il est plus confortable d'utiliser : (function "_" "test_nom_alex") =>> '("test" "nom" "alex") (function " " "test nom alex") =>> '("test" "nom" "alex")

> Tramber Merci :) > jfcantin1977 (setq a(angtos 0.219601 1 4)) (setq d (atoi a)) (setq m (if (setq i (vl-string-search "d" a)) (atoi (substr a (+ 2 i))) 0 ) ;_ if ) ;_ setq (setq s (if (setq i (vl-string-search "'" a)) (atof (substr a (+ 2 i))) 0. ) ;_ if ) ;_ setq (setq str (strcat (rtos d 2 0) "d" (rtos m 2 0)"'" (rtos s 2)"\"")) (progn (princ str) (princ))

(angtof "12d34'56\"") =>> 0.219601 (angtos 0.219601 1 4) =>> "12d34'56\"" [Edité le 14/10/2009 par ElpanovEvgeniy]

Tous les sujets, avec le nom "Challenge" j'appelle pour moi-même comme les leçons et j'apprends...

Salut! Ma variante 2 : :) (defun position (a b) (defun f (a b i) (cond ((not b) nil) ((equal a (mapcar '(lambda (a b) b) a b)) i) ((f a (cdr b) (1+ i))) ) ;_ cond ) ;_ defun (f a b 0) )

Salut, Tramber! Pourquoi les fous ? Que n'est pas correct ?

Salut! Ma variante : (defun position (a b / f) (defun f (a b i n) (cond ((> i n) nil) ((apply 'and (mapcar '= a b)) i) ((f a (cdr b) (1+ i) n)) ) ;_ cond ) ;_ defun (f a b 0 (- (length b) (length a))) ) J'aimais l'idée multi-position...: (defun multi-position (a b / f) (defun f (a b i n) (cond ((> i n) nil) ((apply 'and (mapcar '= a b)) (cons i (f a (cdr b) (1+ i) n))) ((f a (cdr b) (1+ i) n)) ) ;_ cond ) ;_ defun (f a b 0 (- (length b) (length a))) ) ;_ defun

Une décision très intéressante! Ma voie - propre LISP...

Bien, j'attends d'autres réponses.

Salut (gile)! Tu connais, j'aime tels sujets... :) Quand, je peux publier la décision ? [Edité le 10/10/2009 par ElpanovEvgeniy]