TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: MP on September 23, 2010, 03:34:46 PM
-
(defun GetAlignment ( value / lst )
(setq lst
(mapcar
'(lambda ( enum ) (cons (eval enum) (substr (vl-symbol-name enum) 12)))
'( acAlignmentLeft
acAlignmentCenter
acAlignmentRight
acAlignmentAligned
acAlignmentMiddle
acAlignmentFit
acAlignmentTopLeft
acAlignmentTopCenter
acAlignmentTopRight
acAlignmentMiddleLeft
acAlignmentMiddleCenter
acAlignmentMiddleRight
acAlignmentBottomLeft
acAlignmentBottomCenter
acAlignmentBottomRight
)
)
)
(eval
(cons 'defun
(list 'GetAlignment '( value )
(cons 'cdr
(list
(list 'assoc 'value
(list 'quote lst)
)
)
)
)
)
)
(cdr (assoc value lst))
)
(GetAlignment 1)
>> "Center"
Later. :)
-
I can only think of obfuscation,
You didn't want strings in the compiled code.
-
Nice performance enhancement after first call - similar to your recursive double-defun trick with the vl-remove-if...
Perhaps might improve readability to use defun-q ?
-
Lee, if it was for performance I think just building the associative list in the initial definition would be better.
I've changed my vote.
It's to encourage posts of more than 4 characters long :)
-
No se (means I do not know)
Have a look at this:
_$ (GetAlignment 0)
"LEFT"
_$ (GetAlignment -0)
"LEFT"
_$ (GetAlignment -00)
"LEFT"
_$ (GetAlignment -000000000000)
"LEFT"
-
Lee, if it was for performance I think just building the associative list in the initial definition would be better.
Ok, I change my reason: because you can. Next question. :-D
-
After the first execution, the routine is rewritten with the dotted pair already constructed. From there, assoc from a list is a lot faster than stepping through it with vl-remove-if-not. Am I close?
Seems really clever, I would have just done it this way...
(defun foo (v)
(if (and (numberp v) (<= 0 (setq v (fix v)) 14))
(substr (vl-symbol-name
(car (vl-remove-if-not
(function (lambda (e) (eq v (eval e))))
'(acAlignmentLeft acAlignmentCenter acAlignmentRight acAlignmentAligned
acAlignmentMiddle acAlignmentFit acAlignmentTopLeft acAlignmentTopCenter
acAlignmentTopRight acAlignmentMiddleLeft acAlignmentMiddleCenter
acAlignmentMiddleRight acAlignmentBottomLeft acAlignmentBottomCenter
acAlignmentBottomRight
)
)
)
)
12
)
)
)
... but I'm dumb.
Cool stuff, gives me a lot to think about.
-
No se (means I do not know)
Have a look at this:
_$ (GetAlignment 0)
"LEFT"
_$ (GetAlignment -0)
"LEFT"
_$ (GetAlignment -00)
"LEFT"
_$ (GetAlignment -000000000000)
"LEFT"
ZOMG, look at this:
(zerop 0) >> T
(zerop -0) >> T
(zerop -00) >> T
(zerop -000) >> T
What does it mean?? :-o
It means the argument is normalized to 0 (what the heck is a negative zero) when the function call is unpacked, i.e. before it gets to the body of the function, but that's merely a guess.
-
I did it because there is (1) no reason to recreate the list every time the function is called <i.e. evaluate / create the list once, then redefine the function with static data> (2) not palatable to me to hard code third party enum values <ok to do mine tho> (3) easy to revise the enum values if additional enum members are added down the road ... etc. :)
-
No se (means I do not know)
Have a look at this:
_$ (GetAlignment 0)
"LEFT"
_$ (GetAlignment -0)
"LEFT"
_$ (GetAlignment -00)
"LEFT"
_$ (GetAlignment -000000000000)
"LEFT"
ZOMG, look at this:
(zerop 0) >> T
(zerop -0) >> T
(zerop -00) >> T
(zerop -000) >> T
What does it mean?? :-o
lol spooky stuff :lol:
-
I've changed my vote.
It's to encourage posts of more than 4 characters long :)
Nope
-
I can only think of obfuscation,
You didn't want strings in the compiled code.
Truly neither -- I actually tried to pen it so it would be easy for people to see what I did. I fail. (http://www.theswamp.org/screens/mp/facepalm.gif)
-
I would have just done it this way...
I don't understand the benefit of that approach, but I am open to enlightenment. :)
-
I can only think of obfuscation,
You didn't want strings in the compiled code.
I fail. (http://www.theswamp.org/screens/mp/facepalm.gif)
I wouldn't say that.
-
I would have just done it this way...
I don't understand the benefit of that approach, but I am open to enlightenment. :)
I didn't say it was a benefit. I was stating that I would never have thought to create the dotted pair list and redefine the command.
-
I didn't say it was a benefit. I was stating that I would never have thought to create the dotted pair list and redefine the command.
Sorry, poor wording on my part, I just didn't understand the motivation to go the vl-remove-et-al route. :)
-
I did it because there is
(1) no reason to recreate the list every time the function is called <i.e. evaluate / create the list once, then redefine the function with static data>
(2) not palatable to me to hard code third party enum values <ok to do mine tho>
(3) easy to revise the enum values if additional enum members are added down the road ... etc. :)
I understand those reasons.
I Think I'd have done something like this
(Defun Getalignment (Value)
(Cdr (Assoc Value
(List (cons acAlignmentLeft "Left")
(cons acAlignmentCenter "Center")
(cons acAlignmentRight "Right")
(cons acAlignmentAligned "Aligned")
(cons acAlignmentMiddle "Middle")
(cons acAlignmentFit "Fit")
(cons acAlignmentTopLeft "TopLeft")
(cons acAlignmentTopCenter "TopCenter")
(cons acAlignmentTopRight "TopRight")
(cons acAlignmentMiddleLeft "MiddleLeft")
(cons acAlignmentMiddleCenter "MiddleCenter")
(cons acAlignmentMiddleRight "MiddleRight")
(cons acAlignmentBottomLeft "BottomLeft")
(cons acAlignmentBottomCenter "BottomCenter")
(cons acAlignmentBottomRight "BottomRight")
)
)
)
)
-
A variation?
(defun-q GetAlignment ( value / lst )
(setq lst
(mapcar
'(lambda ( enum ) (vl-list* (vl-symbol-value enum) (substr (vl-symbol-name enum) 12)))
'(acAlignmentLeft
acAlignmentCenter
acAlignmentRight
acAlignmentAligned
acAlignmentMiddle
acAlignmentFit
acAlignmentTopLeft
acAlignmentTopCenter
acAlignmentTopRight
acAlignmentMiddleLeft
acAlignmentMiddleCenter
acAlignmentMiddleRight
acAlignmentBottomLeft
acAlignmentBottomCenter
acAlignmentBottomRight
)
)
)
(setq GetAlignment
(cons (car GetAlignment)
(list
(cons (quote cdr)
(list
(list (quote assoc) (quote value) (list (quote quote) lst))
)
)
)
)
)
(cdr (assoc value lst))
)
(quote quote) lol :D
-
I didn't say it was a benefit. I was stating that I would never have thought to create the dotted pair list and redefine the command.
Sorry, poor wording on my part, I just didn't understand the motivation to go the vl-remove-et-al route. :)
Only because I felt it was faster than creating the dotted pair list, then assoc'ing out what was needed.
eg.
(defun foo2 (v)
(cdr (assoc v
(mapcar
'(lambda (enum) (cons (eval enum) (substr (vl-symbol-name enum) 12)))
'(acAlignmentLeft acAlignmentCenter acAlignmentRight acAlignmentAligned
acAlignmentMiddle acAlignmentFit acAlignmentTopLeft acAlignmentTopCenter
acAlignmentTopRight acAlignmentMiddleLeft acAlignmentMiddleCenter
acAlignmentMiddleRight acAlignmentBottomLeft acAlignmentBottomCenter
acAlignmentBottomRight
)
)
)
)
)The brilliance is you constructing the dotted pair list and then redefining the routine to included the newly constructed list.
Consider me educated. Thank you. :-)
-
Re: vl-remove-et-al approach:
Would (car (vl-member-if ... )) be quicker?
-
Re: vl-remove-et-al approach:
Would (car (vl-member-if ... )) be quicker?
Quite a bit. I didn't know that one.
(defun foo3 (v)
(if (and (numberp v) (<= 0 (setq v (fix v)) 14))
(substr (vl-symbol-name
(car (vl-member-if
(function (lambda (e) (eq v (eval e))))
'(acAlignmentLeft acAlignmentCenter acAlignmentRight acAlignmentAligned
acAlignmentMiddle acAlignmentFit acAlignmentTopLeft acAlignmentTopCenter
acAlignmentTopRight acAlignmentMiddleLeft acAlignmentMiddleCenter
acAlignmentMiddleRight acAlignmentBottomLeft acAlignmentBottomCenter
acAlignmentBottomRight
)
)
)
)
12
)
)
)
(FOO3 2).....1638 / 2.81 <fastest>
(FOO 2)......4383 / 1.05
(FOO2 2).....4602 / 1 <slowest>
MP's method is still the powerhouse.
-
Some more 'purely fun for thought':
(defun MakeEnumFunction ( name enums trimfrom / lst )
(setq lst
(mapcar
'(lambda ( enum ) (cons (eval enum) (substr (vl-symbol-name enum) trimfrom)))
enums
)
)
(eval
(cons 'defun
(list name '( value )
(cons 'cdr
(list
(list 'assoc 'value
(list 'quote lst)
)
)
)
)
)
)
)
(MakeEnumFunction
'GetAlignment
'( acAlignmentLeft
acAlignmentCenter
acAlignmentRight
acAlignmentAligned
acAlignmentMiddle
acAlignmentFit
acAlignmentTopLeft
acAlignmentTopCenter
acAlignmentTopRight
acAlignmentMiddleLeft
acAlignmentMiddleCenter
acAlignmentMiddleRight
acAlignmentBottomLeft
acAlignmentBottomCenter
acAlignmentBottomRight
)
12
)
(MakeEnumFunction
'GetHorizontalAlignment
'(
acHorizontalAlignmentAligned
acHorizontalAlignmentCenter
acHorizontalAlignmentFit
acHorizontalAlignmentLeft
)
22
)
(MakeEnumFunction
'GetVerticalAlignment
'(
acVerticalAlignmentBaseline
acVerticalAlignmentBottom
acVerticalAlignmentMiddle
acVerticalAlignmentTop
)
20
)
(GetAlignment 0) >> "Left"
(GetHorizontalAlignment 1) >> "Center"
(GetVerticalAlignment 2) >> "Middle"
:whistle:
-
Most impressive.
-
For you guys that find this remotely interesting and are into python you might consider reading about functors and closures. :) PS: Thanks Alan/all.
-
Some more 'purely fun for thought':
(defun MakeEnumFunction ( name enums trimfrom / lst )
< .. >
)
(GetAlignment 0) >> "Left"
(GetHorizontalAlignment 1) >> "Center"
(GetVerticalAlignment 2) >> "Middle"
:whistle:
The bonus of the ac.. enumerators being consistantly named ...
Now it's getting interesting !!
Great concept post Michael.
-
The bonus of the ac.. enumerators being consistantly named ...
*Gack*
Turns out the TextGenerationFlags are not consistently named because they are the partial union of two enums:
acTextFlagBackward
acTextFlagUpsideDown
acHorizontalAlignmentMiddle
acHorizontalAlignmentRight
So it would be better to return the full enum member string rather than truncated ones, i.e. "acHorizontalAlignmentMiddle" instead of "Middle". Which I can live with. So, code revised --
(defun MakeEnumFunction ( name enums / lst )
(setq lst
(mapcar
'(lambda ( enum ) (cons (eval enum) (vl-symbol-name enum)))
enums
)
)
(eval
(cons 'defun
(list name '( value )
(cons 'cdr
(list
(list 'assoc 'value
(list 'quote lst)
)
)
)
)
)
)
)
(MakeEnumFunction
'GetAlignment
'( acAlignmentLeft
acAlignmentCenter
acAlignmentRight
acAlignmentAligned
acAlignmentMiddle
acAlignmentFit
acAlignmentTopLeft
acAlignmentTopCenter
acAlignmentTopRight
acAlignmentMiddleLeft
acAlignmentMiddleCenter
acAlignmentMiddleRight
acAlignmentBottomLeft
acAlignmentBottomCenter
acAlignmentBottomRight
)
)
(MakeEnumFunction
'GetHorizontalAlignment
'(
acHorizontalAlignmentAligned
acHorizontalAlignmentCenter
acHorizontalAlignmentFit
acHorizontalAlignmentLeft
)
)
(MakeEnumFunction
'GetVerticalAlignment
'(
acVerticalAlignmentBaseline
acVerticalAlignmentBottom
acVerticalAlignmentMiddle
acVerticalAlignmentTop
)
)
(MakeEnumFunction
'GetTextGenerationFlag
'(
acTextFlagBackward
acTextFlagUpsideDown
acHorizontalAlignmentMiddle
acHorizontalAlignmentRight
)
)
(GetAlignment 0) >> "acAlignmentLeft"
(GetHorizontalAlignment 1) >> "acHorizontalAlignmentCenter"
(GetVerticalAlignment 2) >> "acVerticalAlignmentMiddle"
(GetTextGenerationFlag 4) >> "acTextFlagUpsideDown"
Great concept post Michael.
Thank you Kerry.
-
Sometimes I feel smarter just "hanging around" you guys.
Usually I just feel dumberer.
Carry on. :-D
-
Here's a general StripEnumPrefix function one can use after the fact ...
(defun StripEnumPrefix ( enum / result )
(vl-some
'(lambda ( pair )
(if (wcmatch enum (car pair))
(setq result (substr enum (cdr pair)))
)
)
'( ("acAlignment*" . 12)
("acHorizontalAlignment*" . 22)
("acVerticalAlignment*" . 20)
("acTextFlag*" . 11)
[color=green];; add additional filters to suit ...[/color]
)
)
(if result result enum)
)
(StripEnumPrefix "acTextFlagBackward") >> "Backward"
(StripEnumPrefix "acHorizontalAlignmentMiddle") >> "Middle"
(StripEnumPrefix "acVerticalAlignmentBottom") >> "Bottom"
Kerry(Mav) you be funny. :D
-
Perhaps for a touch grammatical house-keeping :wink:
(defun _SplitbyCaps ( s / _f )
(defun _f ( s )
(if (wcmatch s "*[A-Z]*")
(strcat (if (< 64 (ascii s) 91) " " "") (substr s 1 1) (_f (substr s 2)))
s
)
)
(strcat (substr s 1 1) (_f (substr s 2)))
)
(_SplitByCaps "MiddleCenter")
"Middle Center"
Yeah I was bored. :-D
-
Lee,
This would be a far faster method (NOTE: I reformatted this function in the VLIDE for Kerry :D ).
(defun SplitbyCaps (mstr / imstr)
(setq imstr (vl-string->list mstr))
(apply
(function strcat)
(cons
(chr (car imstr))
(mapcar
'(lambda (x)
(if (< 64 x 91)
(strcat " " (chr x))
(chr x)
)
)
(cdr imstr)
)
)
)
)
Benchmarking ...........Elapsed milliseconds / relative speed for 256 iteration(s):
(SPLITBYCAPS SUPERLONGSTRING).......1670 / 54.24 <fastest>
(_SPLITBYCAPS SUPERLONGSTRING).....90574 / 1.00 <slowest>
Tested on a string:
_$ (strlen superlongstring)
6176
_$
I will need time to read and re-read this thread but my initial impression is: "a code {re}generator". would that be correct?
EDIT: Added Benchmark test.
-
Smarty-pants :lol:
-
`Smarty-pants'? If you a referring to my IQ, yes. If you are referring to my code, *meh* more like experience and a few books (In AutoLISP: it is better to operate on a list. In programming: it is always better to K.I.S.S.).
But you had to see something like that coming didn't you (I thought I taught you how to build a substitution model)? ...You were putting a heck of a lot of information on the Stack; you would have done better to use a recursive procedure with an iterative process instead. I would be willing to bet that my procedure would still have been faster but at least yours would have been able to handle a longer string then it currently does.
Anyways, I'm going to a friends house for food and a movie. Take care.
-
Lee,
This would be a far faster method (NOTE: I reformatted this function in the VLIDE for Kerry :D ).
;; < .. >
I thank you, my therapist thanks you. :-)
-
Don't know how this performs comparably but it's how I would do it:
(defun SplitByCaps ( text / lst )
(vl-list->string
(cons
(car (setq lst (vl-string->list text)))
(apply 'append
(mapcar
(function (lambda (x) (if (zerop (logand 32 x)) (list 32 x) (list x))))
(cdr lst)
)
)
)
)
)
(http://www.theswamp.org/screens/mp/oh.gif)
-
my contribution...
(defun AT:SplitByCaps (s)
(apply
(function strcat)
(cons (substr s 1 1)
(mapcar (function (lambda (i)
(if (<= 65 i 90)
(strcat " " (chr i))
(chr i)
)
)
)
(cdr (vl-string->list s))
)
)
)
)
(defun AT:SplitByCaps-2 (s / l)
(apply
(function strcat)
(cons (chr (car (setq l (vl-string->list s))))
(mapcar (function (lambda (i)
(if (<= 65 i 90)
(strcat " " (chr i))
(chr i)
)
)
)
(cdr l)
)
)
)
)
slight change on MP's
(defun SplitByCaps (text / lst)
(vl-list->string
(cons
(car (setq lst (vl-string->list text)))
(apply (function append)
(mapcar
(function (lambda (x)
(if (<= 65 i 90)
(list 32 x)
(list x)
)
)
)
(cdr lst)
)
)
)
)
)
-
I don't think i saved the string i used to test but i just constructed it with a minor bit of code. I can see if i can get some time to do it again on Monday but i will place my bet now that MP will take first place and alanjt (third version) will be second place.
-
Nice coding guys (as always lol)
-
MP,
Nice idea, but a few other chars don't have the 32-bit set...
(SplitByCaps "This[is]a^Te_st")
>> "This [is ]a ^ Te _st"
I like your thinking however.
-
I hear what you're sayin' I've never seen those characters in camel cased enum names. (http://www.theswamp.org/screens/mp/poke.gif)
-
I hear what you're sayin' I've never seen those characters in camel cased enum names. (http://www.theswamp.org/screens/mp/poke.gif)
Fair point - I was in the 'generic function' mindset...
-
Good point Lee / Concede, genericized:
(defun SplitByCaps ( text / lst )
(vl-list->string
(cons
(car (setq lst (vl-string->list text)))
(apply (function append)
(mapcar
(function (lambda (x) (if (< 64 x 91) (list 32 x) (list x))))
(cdr lst)
)
)
)
)
)
-
:-)
-
*GACK* MP, your second function was the exact same route i was planning at first too but i couldn't think of how to append it (I tried appending after the uppermost cons) and i gave up and went the easy route. Ah, its so obvious now that i seen how you applied the append I should make myself sit on the floor the rest of the day. *lol*
Anyways, i am assembling a speed test right now. I will report back when i get it done.
-
*GACK* MP, your second function was the exact same route i was planning at first too but i couldn't think of how to append it (I tried appending after the uppermost cons) and i gave up and went the easy route. Ah, its so obvious now that i seen how you applied the append I should make myself sit on the floor the rest of the day. *lol*
Anyways, i am assembling a speed test right now. I will report back when i get it done.
slight change on MP's
(defun SplitByCaps (text / lst)
(vl-list->string
(cons
(car (setq lst (vl-string->list text)))
(apply (function append)
(mapcar
(function (lambda (x)
(if (<= 65 i 90)
(list 32 x)
(list x)
)
)
)
(cdr lst)
)
)
)
)
)
-
alanjt, *ACK!*
-
alanjt, your last function dosent work for me...It returns the same string.
EDIT: Found it. fixed it.
-
*whistle* ... Good job guys.
I have attached the file for your use.
;; Testing on a string with a length of: 4736
;; Benchmarking ...........Elapsed milliseconds / relative speed for 256 iteration(s):
;;
;; (AT3:SPLITBYCAPS TEST-STR)........2698 / 10.51 <fastest>
;; (MP2:SPLITBYCAPS TEST-STR)........2761 / 10.27
;; (AT2:SPLITBYCAPS TEST-STR)........3167 / 8.95
;; (AT1:SPLITBYCAPS TEST-STR)........3214 / 8.82
;; (SE7EN:SPLITBYCAPS TEST-STR)......3244 / 8.74
;; (MP1:SPLITBYCAPS TEST-STR)........3526 / 8.04
;; (LM:_SPLITBYCAPS TEST-STR).......28346 / 1.00 <slowest>
;;
;; Testing on a string with a length of: 4736
;; Benchmarking ............Elapsed milliseconds / relative speed for 512 iteration(s):
;;
;; (AT3:SPLITBYCAPS TEST-STR)........3385 / 15.84 <fastest>
;; (MP2:SPLITBYCAPS TEST-STR)........3463 / 15.48
;; (SE7EN:SPLITBYCAPS TEST-STR)......4321 / 12.41
;; (AT2:SPLITBYCAPS TEST-STR)........4321 / 12.41
;; (AT1:SPLITBYCAPS TEST-STR)........4368 / 12.27
;; (MP1:SPLITBYCAPS TEST-STR)........4680 / 11.46
;; (LM:_SPLITBYCAPS TEST-STR).......53617 / 1.00 <slowest>
;;
;; Testing on a string with a length of: 4736
;; Benchmarking ...........Elapsed milliseconds / relative speed for 256 iteration(s):
;;
;; (MP2:SPLITBYCAPS TEST-STR)........1107 / 24.86 <fastest>
;; (AT3:SPLITBYCAPS TEST-STR)........1107 / 24.86
;; (AT1:SPLITBYCAPS TEST-STR)........1513 / 18.19
;; (AT2:SPLITBYCAPS TEST-STR)........1513 / 18.19
;; (SE7EN:SPLITBYCAPS TEST-STR)......1545 / 17.81
;; (MP1:SPLITBYCAPS TEST-STR)........1623 / 16.96
;; (LM:_SPLITBYCAPS TEST-STR).......27518 / 1.00 <slowest>
-
lol @ mine :lol:
-
Interesting results John, thanks for posting them.
-
No problem at all MP. After looking closer at the code and the results i cant believe there is a difference between these statements:
(if (< 64 x 91) (list 32 x) (list x))
(if (<= 65 x 90) (list 32 x) (list x))
weird.
Lee, why laugh?! I cant tell you how many times I've spent hours on something that turned into a total abomination. In fact, I have several abominations i have to maintain here at my job because they mutated over time. ...the long and the short of it is this: did you learn anything (-i.e. what are you going to do differently next time)?
Besides, look at who you are up against; MP and alanjt --two people who are very good at what they do-.
-
weird
this
-
i before e except after w.
-
I'm confused; i didn't spell that wrong did i?
http://www.dict.org/bin/Dict?Form=Dict2&Database=*&Query=weird (http://www.dict.org/bin/Dict?Form=Dict2&Database=*&Query=weird)
-
<babelfish interpreter> He was contributing what he could to the thread </babelfish interpreter> :-D
-
Very cool stuff. I know I learned from this thread.