TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Lee Mac on October 08, 2010, 03:23:32 PM
-
The Challenge:
To construct a function to return a string converted to titlecase.
(Titlecase <string>)
Examples:
_$ (Titlecase "test string")
"Test String"
_$ (Titlecase "TEST")
"Test"
_$ (Titlecase "TEST STRING")
"Test String"
-
There is titlecase and titlecase...
Should it be:
"The Taming Of The Shrew"
Or:
"The Taming of the Shrew"
?
-
To remove ambiguity, the first one Roy :-)
-
To kick us off perhaps :-)
(defun LM:TitleCase ( s / n )
(vl-list->string
(mapcar
(function
(lambda ( x )
(setq n (boole (if (or (not n) (= 32 n)) 2 7) x 32))
)
)
(vl-string->list s)
)
)
)
-
To remove ambiguity, the first one Roy :-)
read: easier to program. *lol*
Didn't we already have one like this?
EDIT: Sorry, that was "split by case" (I found a function in my junk file).
-
(LM:TITLECASE "it's easy as 123")
-
(LM:TITLECASE "it's easy as 123")
Nice spot Roy.
(defun LM:TitleCase2 ( s / n )
(vl-list->string
(mapcar
(function
(lambda ( x )
(setq n
(if (or (not n) (= 32 n))
(if (< 96 x 123) (boole 2 x 32) x)
(if (< 64 x 91) (boole 7 x 32) x)
)
)
)
)
(vl-string->list s)
)
)
)
-
To remove ambiguity, the first one Roy :-)
read: easier to program. *lol*
whatever, I'll let you do the other one then.
-
A little crabby are we?
-
A little crabby are we?
I've got better things to do than rise to your snide comments.
-
*blink* WHAT?! How was my comment `snide'?
...you got a problem with me?
-
A titlecase-function will always be language dependent:
(LM:TITLECASE2 "McMurphy is an Irish-American brawler")
http://en.wikipedia.org/wiki/Randle_McMurphy
-
My entry. 8-)
http://www.theswamp.org/index.php?topic=29049.0
-
(defun J7:TitleCase ( s / )
(setq s (strcase s T))
(while (setq sp (vl-string-position 32 s sp))
(setq s (vl-string-subst
(chr (boole 2 (vl-string-elt s (1+ sp)) 32))
(chr (vl-string-elt s (1+ sp)))
s
(1+ sp)
)
sp (1+ sp)
)
)
(vl-string-subst
(chr (boole 2 (vl-string-elt s 0) 32))
(chr (vl-string-elt s 0))
s
)
)
EDIT: Fixed formatting of code (code not changed).
-
Very old
;;;PROPER NAMES
(defun proper (s / i tmp)
(setq i 1)
(while (<= i (strlen s))
(cond ((= i 1)
(setq tmp (strcase (substr s i 1))))
((= " " (substr s (1- i) 1))
(setq tmp (strcat tmp (strcase (substr s i 1)))))
(T
(setq tmp (strcat tmp (strcase (substr s i 1) t)))))
(setq i (1+ i)))
tmp)
-David
-
J7:TitleCase
sharp eyes John :)
-
(defun kg:TitleCase (s / result)
(setq
result (list (ascii (strcase (substr s 1 1))))
s (cdr (vl-string->list (strcase s 'T)))
)
(while s
(if (= (car s) 32)
(setq
result (vl-list* (ascii (strcase (chr (cadr s)))) (car s) result)
s (cddr s)
)
(setq
result (cons (car s) result)
s (cdr s)
)
)
)
(vl-list->string (reverse result))
)
123-test: pass.
(KG:TITLECASE "it's easy as 123") => "It's Easy As 123"
McMurphy-test: fail. :cry:
(KG:TITLECASE "McMurphy is an Irish-American brawler") => "Mcmurphy Is An Irish-american Brawler"
-
(J7:TITLECASE "it's easy as 123")
-
Tidying up my other one:
(defun LM:TitleCase3 ( s / n )
(vl-list->string
(mapcar
(function
(lambda ( x )
(setq n (if (and (or (not n) (= 32 n)) (< 96 x 123)) (boole 2 x 32) x))
)
)
(vl-string->list (strcase s t))
)
)
)
(LM:TitleCase3 "it's easy as 123")
"It's Easy As 123"
-
Hi,
A very quicky using the most used (by me) string manipulation routines (str2lst and lst2str)
Certainly not the faster one (converting string to an integer list with vl-string->list, manipulating the list and convert it back to a string seems to be the faster way to manipulate string with LISP).
(defun gc:TitleCase (str)
(gc:lst2str
(mapcar '(lambda (x)
(strcat (strcase (substr x 1 1)) (strcase (substr x 2) T))
)
(gc:str2lst str " ")
)
" "
)
)
(defun gc:str2lst (str sep / pos)
(if (setq pos (vl-string-search sep str))
(cons (substr str 1 pos)
(gc:str2lst (substr str (+ (strlen sep) pos 1)) sep)
)
(list str)
)
)
(defun gc:lst2str (lst sep)
(if (cdr lst)
(strcat (car lst) sep (gc:lst2str (cdr lst) sep))
(car lst)
)
)
-
Here is the Title case stripped from my old routine.
(defun tcase (txt / spc letter nlst)
(setq spc t) ; space char flag
(foreach letter (vl-string->list txt)
(cond
((= letter 32) (setq spc t))
((and spc (< 96 letter 123))
(setq letter (- letter 32) spc nil)) ; to upper
((< 64 letter 91) (setq letter (+ letter 32))) ; to lower
)
(setq nlst (cons letter nlst))
)
(vl-list->string (reverse nlst))
)
-
Another one
(defun gc:titleCase2 (s / f)
(defun f (l)
(if l
(if (and (= 32 (car l)) (< 96 (cadr l) 123))
(cons 32 (cons (- (cadr l) 32) (f (cddr l))))
(cons (car l) (f (cdr l)))
)
)
)
(vl-list->string
(f
(vl-string->list
(strcat (strcase (substr s 1 1)) (strcase (substr s 2) T))
)
)
)
)
-
This one tries to be a little (English) language sensitive:
(defun kg:TitleCase2 (s / markers result)
(setq
markers
'(
" a "
" an "
" and "
" and/or "
" as "
" at "
" in "
" is "
" of "
" on "
" or "
" the "
" to "
" Mc"
" Mac"
" '"
" ("
")("
" -"
" "
"-"
; list is language dependent and can of course be extended...
)
result ""
s (strcat " " (strcase s 'T)) ; temporarily add a space
)
(while (/= s "")
(if
(not
(vl-some
'(lambda (a)
(if (wcmatch s (strcat (strcase a 'T) "*"))
(if (or (= a " ") (= a (setq a (vl-string-right-trim " " a))))
(setq
result (strcat result a (strcase (substr s (1+ (strlen a)) 1)))
s (substr s (+ (strlen a) 2))
)
(setq
result (strcat result a)
s (substr s (1+ (strlen a)))
)
)
)
)
markers
)
)
(setq
result (strcat result (substr s 1 1))
s (substr s 2)
)
)
)
(strcat (strcase (substr result 2 1)) (substr result 3))
)
(kg:TitleCase2 "the taming of the shrew") => "The Taming of the Shrew"
(kg:TitleCase2 "it's easy as 123") => "It's Easy as 123"
(kg:TitleCase2 "mcmurphy is an irish-american brawler") => "McMurphy is an Irish-American Brawler"
(kg:TitleCase2 "old macdonald had a farm, e-i-e-i-o") => "Old MacDonald Had a Farm, E-I-E-I-O"
(kg:TitleCase2 "he said (and i quote): 'i hate school. it's terrible!'") => "He Said (And I Quote): 'I Hate School. It's Terrible!'"
Edit: this one fails actually:
(kg:TitleCase2 "he said (and i quote): 'i hate school. it's terrible!'") => "He Said (And I Quote): 'I Hate School. It's Terrible!'"
"(And " should be "(and "
-
J7:TitleCase
sharp eyes John :)
Thank you Kerry.
So far (I'm keeping tally): I have sharp eyes and a snide fingers.
-
Another
(defun LM:Titlecase4 ( s / regex v )
(setq s (strcase s t) regex (vlax-create-object "VBScript.RegExp"))
(vlax-put-property regex 'global actrue)
(vlax-put-property regex 'pattern "(^|\\s)\\S")
(vlax-for x (vlax-invoke regex 'execute s)
(setq s (vl-string-subst (strcase (setq v (vlax-get x 'value))) v s (vlax-get x 'firstindex)))
)
(vlax-release-object regex)
s
)
-
(J7:TITLECASE "it's easy as 123")
Oh no, mine was not built for that. I had very specific criteria I wanted to meet when i built mine. I spend an *hour* designing it and you had already said that we didn't need to design for that.
-
I have my regular tee time with my father in a few so here is a test for someone to fill in and run.
( (lambda (/ s)
(setq s "test string with several spaces"
s (repeat 7 (setq s (strcat s s))))
;; dont operate on a string much larger because the memory gets used up.
;;(strlen s)
(benchmark
'(
)
)
)
)
-
roy_043,
I agree with your method but this thread is what I would call "stacked".
Hint: build for raw speed or a quirky algorithm.
-
I was thinking about Regex too,
Here's a C# example:
public string TitleCase(string s)
{
return Regex.Replace(s.ToLower(), "(^[a-z]|\\s[a-z])", x => x.Value.ToUpper());
}
-
Nice Gile -
I tried to be more concise with mine, but struggled to perform the replacement using RegEx :|
-
The VBScript Regex.Replace method only allows to replace a specified string (or pattern) by another specified string.
The .NET Regex.Replace method is overloaded (means many definitions with different arguments) and some allows to use a MatchEvaluator delegate as argument (a method defined with requiered argument(s) and return value).
Since NET 3.0 version delegates can be specified as 'lambda expressions' which allows more concise (and cryptic ?) code:
x => x.Value.ToUpper() (where x is a Match object: the MatchEvaluator argument).
A 'more traditionnal' way should have been to define the delegate as an external function:
public string TitleCase(string s)
{
return Regex.Replace(s.ToLower(), "(^[a-z]|\\s[a-z])", MatchToUpper); }));
}
private string MatchToUpper(Match m)
{
return m.Value.ToUpper();
}
Or using an 'anonymous method' (more like the lambda LISP function):
private static string TitleCase(string s)
{
return Regex.Replace(s.ToLower(), "(^[a-z]|\\s[a-z])", delegate(Match m) { return m.Value.ToUpper(); });
}
Maybe it's not the right forum for this (Please CAB, don't cry...)
-
Thanks for the information Gile, I had read up about the MatchEvaluator argument, and its a shame this cannot be supplied to the VBScript Regex Object - the closest I can get to that behaviour is to use the "$n" symbols (n integer) in the replace string, which reference the matches 'remembered' when using parentheses in the pattern string.
Example, changing the order of matched strings:
(RegRep "$3$2$1" "(\\S)(\\S)(\\S)" "abc abc abc")
"cba cba cba"
-
Improved version of kg:TitleCase2:
(defun kg:TitleCase3 (s / wordBeginMarkersLst prefixesWithFollowingCapLst wordsNoCapsMatchString tmp lst)
;; lists and wordsNoCapsMatchString are language dependent and can of course be extended...
(setq
s (strcase s 'T)
wordBeginMarkersLst ; the order of this list is important
'(
" '"
" "
"-"
"("
)
prefixesWithFollowingCapLst
'(
"Mc"
"Mac"
)
wordsNoCapsMatchString "a,an,and,and/or,as,at,in,is,it,of,on,or,the,to"
tmp ""
)
(while (/= s "")
(if
(not
(vl-some
'(lambda (a)
(if (wcmatch s (strcat a "*"))
(setq
lst (vl-list* (cons 0 a) (cons 1 tmp) lst)
tmp ""
s (substr s (1+ (strlen a)))
)
)
)
wordBeginMarkersLst
)
)
(setq
tmp (strcat tmp (substr s 1 1))
s (substr s 2)
)
)
)
(setq tmp
(apply
'strcat
(mapcar
'(lambda (a)
(cond
((or (zerop (car a)) (wcmatch (cdr a) wordsNoCapsMatchString))
(cdr a)
)
(
(vl-some
'(lambda (b)
(if (wcmatch (cdr a) (strcase (strcat b "*") 'T))
(setq tmp (strcat b (strcase (substr (cdr a) (1+ (strlen b)) 1)) (substr (cdr a) (+ (strlen b) 2))))
)
)
prefixesWithFollowingCapLst
)
tmp
)
('T
(strcat (strcase (substr (cdr a) 1 1)) (substr (cdr a) 2))
)
)
)
(reverse (cons (cons 1 tmp) lst))
)
)
)
(strcat (strcase (substr tmp 1 1)) (substr tmp 2))
)
(kg:TitleCase3 "the taming of the shrew") => "The Taming of the Shrew"
(kg:TitleCase3 "it's easy as 123") => "It's Easy as 123"
(kg:TitleCase3 "mcmurphy is an irish-american brawler") => "McMurphy is an Irish-American Brawler"
(kg:TitleCase3 "old macdonald had a farm, e-i-e-i-o") => "Old MacDonald Had a Farm, E-I-E-I-O"
(kg:TitleCase3 "he said (and i quote): 'i hate school. it's terrible!'") => "He Said (and I Quote): 'I Hate School. It's Terrible!'"
@ Se7en: Pretty quirky I would say :evil:. But undoubtedly very slow...
-
One more
(defun LM:Titlecase5 ( s / a s l n c )
(setq a (vl-string->list (strcase s t)) s (vl-string-subst (strcase (chr (car a))) (chr (car a)) s 0) l (length a))
(while (setq x (vl-position 32 a))
(setq n (length a) a (cdr (member 32 a)) c (chr (car a)) s (vl-string-subst (strcase c) c s (+ 1 (- l n) x)))
)
)
-
Inspired by Lee's use of the member function:
(defun kg:TitleCaseQuirk (s / result tmp)
(setq s (vl-string->list (strcase s 'T)))
(substr
(apply
'strcat
(reverse
(while s
(setq tmp (reverse s))
(while (member 32 tmp) (setq tmp (cdr (member 32 tmp))))
(setq s (cdr (member 32 s)))
(setq result (cons (strcat " " (strcase (chr (car (setq tmp (reverse tmp))))) (vl-list->string (cdr tmp))) result))
)
)
)
2
)
)
-
And another:
(defun kg:TitleCase4 (s / result)
(setq s (reverse (vl-string->list (strcase s 'T))))
(while s
(setq result (cons (if (and (member (cadr s) '(32 nil)) (< 96 (car s) 123)) (- (car s) 32) (car s)) result))
(setq s (cdr s))
)
(vl-list->string result)
)
-
Nice ideas Roy :-)
-
A quick test:
String Length: 992
Benchmarking .............Elapsed milliseconds / relative speed for 1024 iteration(s):
(LM:TITLECASE3 S)..........1076 / 19.95 <fastest>
(LM:TITLECASE2 S)..........1233 / 17.41
(LM:TITLECASE5 S)..........1342 / 15.99
(GC:TITLECASE2 S)..........1435 / 14.96
(KG:TITLECASE S)...........1436 / 14.95
(CAB:TCASE S)..............1684 / 12.75
(KG:TITLECASE4 S)..........1857 / 11.56
(GC:TITLECASE S)...........1950 / 11.01
(LM:TITLECASE4 S)..........7768 / 2.76
(DB:PROPER S)..............8393 / 2.56
(KG:TITLECASEQUIRK S).....21465 / 1.00 <slowest>
-
Mine wasn't good enough to test (or am i not to partake in any reindeer games)?
-
Mine wasn't good enough to test (or am i not to partake in any reindeer games)?
Yours wasn't comparing apples with apples (see #17), same reason my first one doesn't appear in the list either.
-
So i wasted an hour deriving a clever function to your criteria and its all for not...all i have to say is: WTF!
roy_043 made this point right away and you dismissed it.
-
So i wasted an hour deriving a clever function to your criteria and its all for not...all i have to say is: WTF!
It hardly met the criteria if it can handle some strings but not others, how much time you spend on it and what you do with your time is up to you.
roy_043 made this point right away and you dismissed it.
What are you talking about? Roy made that point, and so I changed my code to account for it.
-
So here is my understanding (recap);
you state a challenge.
someone (roy_043) asks for clarification.
you state that we are to be literal ("remove ambiguity").
I state that being literal would be easier to program.
(BTW, I added a "literal" meaning to your statement about being ambiguous thus creating a joke)
you insult me.
(and ignore me)
you determine that one item in the sea of `ambiguity' is worth addressing.
(part of the humor in my joke)
...again: WTF! and I'll even add: screw-u.
-
The clarification that Roy asked for is beside the point - your function (and my first one) cannot handle strings containing numbers (amongst other characters), hence they cannot be compared with those which do handle such. Roy pointed this out straight away (see post #5), and I corrected my code to account for it. You seem outraged that the same bug be pointed out in your "clever" code.
you insult me.
A little crabby are we?
I've got better things to do than rise to your snide comments.
I would hardly call that an 'insult', this however:
...again: WTF! and I'll even add: screw-u.
is quite insulting, at which point I shall depart from this conversation.
-
So you get to determine what is insulting to me?!
Go ahead and bail on the conversation (I didn't bail on your challenge even though i felt insulted).
-
(http://i56.tinypic.com/t6w7t2.jpg)
-
:-D
-
John I think you are over reacting.
Run you own speed test. 8-)
-
CAB,
Im slightly confused by that statement;
If taken literal: of course. I already have. The test is not the issue.
If taken figuratively: there's no helping not to, but I just cant stand "stupid". ...actually, i am not sure what to make of this whole thread to be honest so `stupid' may not describe "it" well enough or be too harsh;
o It could be that the OP honestly didnt see the all the different problems and thought a simple "list processing, or mapcar-lambda" formula could handle all the possible string processing involved (different combination's of numeral, chars, hyphens, etc.).
o It could possibly be that the OP honestly doesnt understand that (mapcar 'func lst) is (salt.grain --> you) the fastest and (mapcar '(lambda)) is the second fastest list processing method and therefore creating a challenge thread in the tone of: "here is my second fastest--but only because this task cant be done with the fastest method--solution, lets see yours and race *yeah* and *w00t*" seem(s/d) a bit odd.
NOTES:
1. I said a bit odd because we beat that dead horse only a little bit ago in another thread.
2. I also know that we all stand on the shoulders of giants but I mean, come on.
o It could possibly be that the OP didnt get or understand that i was trying to divert attention--"make light" may be a better description--of a seemingly (to me? to me only?) odd/weird/crazy/whatever thread (and for what reason? I don't have the foggiest anymore and I don't really care anymore to be honest).
o Maybe I'm the stupid one and the OP saw all this and more and had a "better reason" that I just cant see.
Whatever. Maybe I need to take a break from the internet. Maybe i need to pull a Homer Simpson and shove a crayon up my nose to be blissful.
-
Maybe i need to pull a Homer Simpson and shove a crayon up my nose to be blissful.
let me know if you need a hand :lol:
-
Maybe i need to pull a Homer Simpson and shove a crayon up my nose to be blissful.
let me know if you need a hand :lol:
Oh anytime; I got my pellet gun waitin' by the front door (Halloween is fast approaching and i don't much care for Batman).
-
my version
(defun ee:TitleCase (s)
(vl-list->string
(mapcar
(function
(lambda (a b c)
(if (= a 32) b c)
)
)
(cons 32 (vl-string->list s))
(vl-string->list (strcase s nil))
(vl-string->list (strcase s t))
)
)
)
-
recursion version, not use vla-*
(defun f (s)
(if (= s "")
s
(if (= (ascii s) 32)
(strcat " " (strcase (substr s 2 1) nil) (f (substr s 3)))
(strcat (strcase (substr s 1 1) t) (f (substr s 2)))
)
)
)
-
A quick test:
((lambda (/ s)
(setq s "test string with several spaces"
s (repeat 7 (setq s (strcat s " " s)))
) ;_ setq
(princ (strcat "String Length: " (itoa (strlen s)) "\n"))
(benchmark '((ee:TitleCase s) (LM:TitleCase2 s) (LM:TitleCase3 s) (LM:TitleCase5 s)))
) ;_ lambda
)
_$
String Length: 4095
Benchmarking ............Elapsed milliseconds / relative speed for 512 iteration(s):
(EE:TITLECASE S)......1466 / 5.60 <fastest>
(LM:TITLECASE3 S).....2059 / 3.99
(LM:TITLECASE2 S).....2418 / 3.39
(LM:TITLECASE5 S).....8206 / 1.00 <slowest>
_$
-
Very cool!
-
This is my contribution...
this tool also run when there is TAB space..
;; By Andrea Andreetti
(defun AA:TITLECASE (str / nstr s F)
(setq F t nstr "")
(repeat (strlen str)
(setq s (substr str 1 1))
(setq nstr (strcat nstr (if F (strcase s)(strcase s t))))
(if (member s '(" " "\t"))(setq F T)(setq F nil))
(setq str (substr str 2))
)
nstr
)
(AA:TITLECASE "weLl therE wE Go witH my aTtemPt")
-
recursion version, not use vla-*
(defun f (s)
(if (= s "")
s
(if (= (ascii s) 32)
(strcat " " (strcase (substr s 2 1) nil) (f (substr s 3)))
(strcat (strcase (substr s 1 1) t) (f (substr s 2)))
)
)
)
this is cool !
but...you miss the first caracter. :kewl:
-
another approach..
(defun AA:Titlecase (str)
(setq str (strcase str t))
(foreach n (mapcar 'vl-princ-to-string '(a b c d e f g h i j k l m n o p q r s t w x y z))
(setq str (acet-str-replace (strcat " " n) (strcat " " (strcase n)) str T)))
(vl-string-subst (strcase (substr str 1 1)) (substr str 1 1) str)
)
-
Late to the ball, but here's my contribution:
(defun AT:TitleCase (s / l)
(vl-list->string
(mapcar (function (lambda (a b)
(if (vl-position a '(9 32))
(cond ((<= 65 b 90) b)
((<= 97 b 122) (- b 32))
(b)
)
(cond ((<= 65 b 90) (+ b 32))
((<= 97 b 122) b)
(b)
)
)
)
)
(cons 32 (setq l (vl-string->list s)))
l
)
)
)
-
Here is my entry:
;N = Number of characters in a word that are required before the word is captilized. Specify 0 to cpatilize all words.
(defun TitleCase (s N / Title Ct)
(setq ct 1)
(setq nxtspc (vl-string-search " " s ct))
(setq Title (strcat (strcase (substr s ct 1)) (substr s (+ ct 1) nxtspc)))
(setq ct (+ nxtspc 1))
(while (and (< CT (strlen s)) (< nxtspc (strlen s)))
(setq nxtspc (vl-string-search " " s ct))
(cond
((= nxtspc nil)
(setq nxtspc (strlen s))
)
)
(cond
((> (- nxtspc ct) N)
(setq Title (strcat Title (strcase (substr s (+ ct 1) 1)) (substr s (+ ct 2) (- nxtspc ct))))
)
(T
(setq Title (strcat Title (substr s (+ ct 1) (- nxtspc ct))))
)
)
(setq CT (+ nxtspc 1))
)
Title
)
I do not know how well this will hold up in the benchmarks, but it works and it works with numbers in the string, as well as being able to specify a word length that is needed to capitalize the word.
-
@ cmwade77:
(TITLECASE "i did it my way too i think" 3) => "I diditmywaytooiThink"
(One strcat doesn't eat up the following space)
-
I will have to take another look at that, it wasn't doing that to me when I tested it before.