Topic: [challenge] A31 : Midverse

[JohnK]

Reverse the middle letters of a word.

Write a procedure `midverse` that reverses all but the first and last letters of a word.

For example:

(midverse "retinues")
should return "reunites".

Check that
(midverse (midverse [word]))
leaves the word unchanged.

[gile]

Code - Auto/Visual Lisp: [Select]

1. (defun midverse (s)
2.   (vl-list->string
3.     ((lambda (l)
4.        (append (cons (car l) (cdr (reverse (cdr l)))) (list (last l)))
5.      )
6.       (vl-string->list s)
7.     )
8.   )
9. )

[Marc'Antonio Alessi]

...finito... (end) or is with Vanilla Lisp?

[ronjonp]

Code - Auto/Visual Lisp: [Select]

1. (defun midverse-rjp (str / a b c)
2.   (setq a (vl-string->list str))
3.   (setq b (car a))
4.   (setq c (last a))
5.   (setq a (cdr a))
6.   (vl-list->string (append (list b) (cdr (reverse a)) (list c)))
7. )
8. (midverse-rjp "retinues")

Probably slow...

Non VL

Code - Auto/Visual Lisp: [Select]

1. (defun midverse-rjp2 (str / n r)
2.   (setq n 1)
3.   (repeat (- (strlen str) 2) (setq r (cons (substr str (setq n (1+ n)) 1) r)))
4.   (strcat (substr str 1 1) (apply 'strcat r) (substr str (strlen str) 1))
5. )
6. (midverse-rjp2 "retinues")

[gile]

Without vl* functions:

Code - Auto/Visual Lisp: [Select]

1. (defun midverse (s / str->list)
2.   (defun str->list (s)
3.     (if (< 0 (strlen s)) (cons (ascii (substr s 1 1)) (str->list (substr s 2))))
4.   )
5.   (apply 'strcat
6.          (mapcar 'chr
7.                  ((lambda (l)
8.                     (append (cons (car l) (cdr (reverse (cdr l)))) (list (last l)))
9.                   )
10.                    (str->list s)
11.                  )
12.          )
13.   )
14. )

[JohnK]

Mine (without vl):
It looks like I had the same idea as gile (that's a big bump to my ego for the day!).

Code - Auto/Visual Lisp: [Select]

1. (defun midverse (str / lst)
2.   (defun al-string-to-ascii-list (str / alst cntr)
3.     (if (= cntr '()) (setq cntr 1))
4.     (while (<= cntr (strlen str))
5.            (setq alst (cons (ascii (substr str cntr 1)) alst)
6.                  cntr (1+ cntr)))
7.     (reverse alst) )
8.   (setq lst (al-string-to-ascii-list str))
9.   (apply
10.     'strcat
11.     (mapcar
12.       'chr
13.       (append
14.         (cons (car lst)
15.                 (cdr (reverse (cdr lst))))
16.         (list (last lst)))
17.       )
18.     )
19.   )

[Marc'Antonio Alessi]

Code: [Select]

(defun Midverse_A (s / c L i e o)
  (setq L (strlen s) i (substr s 1 1) e (substr s L)  s (substr s 2 (- L 2)) o "" c 1)
  (repeat (strlen s)
    (setq o (strcat (substr s c 1) o)  c  (1+ c))
  )
  (strcat i o e)
)Better:

Code: [Select]

(defun Midverse_A2 (s / c L i e)
  (if (= 1 (setq L (strlen s)))
    s
    (progn
      (setq i (substr s 1 1) e (substr s L)  s (substr s 2 (- L 2)) c 1)
      (repeat (strlen s)
        (setq e (strcat (substr s c 1) e)  c (1+ c))
      )
      (strcat i e)
    )
  )
)


[kirby]

Building block approach...

Code - Auto/Visual Lisp: [Select]

1. ; [challenge] A31 : Midverse
2. ; Reverse the middle letters of a word.
3. ; Write a procedure `midverse` that reverses all but the first and last letters of a word.
4. ; For example:
5. ;       (midverse "retinues")
6. ;               should return "reunites".
7. ;       Check that
8. ;               (midverse (midverse [word]))
9. ;                       leaves the word unchanged.
10.  
11.  
12. (defun MidVerse-kirby (MyString / OutVal)      
13. ; [challenge] A31 : Midverse -  Reverse the middle letters of a word.
14. ; Input:
15. ;       MyString - (string) string to be modified
16. ; Returns:
17. ;       modfied string
18. ; Uses custom functions:
19. ;       StringReverse
20. ;       StringSubst
21.  
22. (setq OutVal nil)
23.  
24. (if (eq (type MyString) 'STR)
25.   (progn
26.         (setq OutVal (stringreverse MyString))                                  ; Reverse
27.         (setq OutVal (StringSubst OutVal (substr MyString 1 1) 1))              ; Replace first char
28.         (setq OutVal (StringSubst OutVal (substr MyString (strlen MyString) 1) (strlen MyString)))      ; Replace last char
29.   )
30. )
31.  
32. OutVal
33. )
34.  
35.  
36. (defun StringReverse (MyString / OutVal CNT CNT1)
37. ; Reverse a string
38. ; Input:
39. ;       MyString - (string) string to be reverses
40. ; Returns:
41. ;       reversed string, or nil if input was not a string
42.  
43. (setq OutVal nil)       ; null output
44.  
45. (if (eq (type MyString) 'STR)
46.   (progn
47.         (setq OutVal "")
48.  
49.         (setq CNT 0)
50.         (repeat (strlen MyString)
51.                 (setq CNT1 (- (strlen MyString) CNT))
52.                 (setq OutVal (strcat OutVal (substr MyString CNT1 1)))         
53.                 (setq CNT (1+ CNT))
54.         ) ; close repeat
55.   )
56. )
57.  
58. OutVal
59. )
60.  
61.  
62.  
63. (defun StringSubst (MyString NewString Pos / OutVal L Part1 Part2)
64. ; Substitude a new string in a string
65. ; Input:
66. ;       MyString - (string) a string
67. ;       NewString - (string) substring to be inserted into MyString
68. ;       Pos - (integer) position for substitution (1 to strlen).
69. ; Returns:
70. ;       modified string
71.  
72. (setq OutVal nil)
73.  
74. (setq L (strlen MyString))
75.  
76. (if (and (>= Pos 1) (<= Pos L))
77.   (progn
78.         (setq Part1 (substr MyString 1 (1- Pos)))                       ; first part of string before Pos
79.         (setq Part2 (substr MyString (1+ Pos) (- L Pos)))               ; last part of string after Pos
80.        
81.         (setq OutVal (strcat Part1 NewString Part2))
82.   )
83. )
84.  
85. OutVal
86. )
87.  
88.  

[JohnK]

Quick lunch break. Did this one in C for fun. It is also possible to do this with XOR as well (in C). I'll see if I can find some time to build that one too, later.

Code - C: [Select]

1. #include <stdio.h>
2. #include <string.h>
3.  
4. char *strrev(char *s) {
5.      /* Reverses the order of all characters in a string except the
6.       * first and last--as well as the terminating byte */
7.      char *start;
8.      char *end;
9.      char tmp;
10.  
11.      /* Set pointer 'end' to last character in string */
12.      end = s + strlen(s) - 1;
13.      /* Eat last char */
14.      --end;
15.  
16.      /* Preserve pointer to start of string */
17.      start = s;
18.      /* Eat first char */
19.      ++s;
20.  
21.      /* Swap characters */
22.      while(end >= s) {
23.           tmp = *end;
24.           *end = *s;
25.           *s = tmp;
26.           --end;
27.           ++s;
28.      }
29.      return(start);
30. }
31.  
32. int main() {
33.      char text[100];
34.      char *p;
35.  
36.      strcpy(text, "retinues");
37.      p = strrev(text);
38.      printf("\n%s",p);
39.  
40.      return 0;
41. }
42.  

[ronjonp]

Quick benchmark .. looks like VL wins for speed on this one.

Elapsed milliseconds / relative speed for 65536 iteration(s):
    (MIDVERSE-RJP "retinues").......2594 / 3.10 <fastest>
    (MIDVERSE-GILE "retinues")......3594 / 2.24
    (MIDVERSE_A "retinues").........4016 / 2.00
    (MIDVERSE_A2 "retinues")........4656 / 1.73
    (MIDVERSE-RJP2 "retinues")......5266 / 1.53
    (MIDVERSE-GILE2 "retinues").....5500 / 1.46
    (MIDVERSE-7 "retinues").........7422 / 1.08
    (MIDVERSE-KIRBY "retinues").....8047 / 1.00 <slowest>
---- Benchmark Utility: In memory of Michael Puckett ----

Code - Auto/Visual Lisp: [Select]

1. (defun midverse-7 (str / lst)
2.   (defun al-string-to-ascii-list (str / alst cntr)
3.     (if (= cntr '())
4.       (setq cntr 1)
5.     )
6.     (while (<= cntr (strlen str))
7.       (setq alst (cons (ascii (substr str cntr 1)) alst)
8.             cntr (1+ cntr)
9.       )
10.     )
11.     (reverse alst)
12.   )
13.   (setq lst (al-string-to-ascii-list str))
14.   (apply 'strcat
15.          (mapcar 'chr (append (cons (car lst) (cdr (reverse (cdr lst)))) (list (last lst))))
16.   )
17. )
18. (defun midverse-rjp (str / a b c)
19.   (setq a (vl-string->list str))
20.   (setq b (car a))
21.   (setq c (last a))
22.   (setq a (cdr a))
23.   (vl-list->string (append (list b) (cdr (reverse a)) (list c)))
24. )
25. (defun midverse-rjp2 (str / n r)
26.   (setq n 1)
27.   (repeat (- (strlen str) 2) (setq r (cons (substr str (setq n (1+ n)) 1) r)))
28.   (strcat (substr str 1 1) (apply 'strcat r) (substr str (strlen str) 1))
29. )
30. (defun midverse-gile (s)
31.   (vl-list->string
32.     ((lambda (l)
33.        (append (cons (car l) (cdr (reverse (cdr l)))) (list (last l)))
34.      )
35.       (vl-string->list s)
36.     )
37.   )
38. )
39. (defun midverse-gile2 (s / str->list)
40.   (defun str->list (s)
41.     (if (< 0 (strlen s))
42.       (cons (ascii (substr s 1 1)) (str->list (substr s 2)))
43.     )
44.   )
45.   (apply
46.     'strcat
47.     (mapcar
48.       'chr
49.       ((lambda (l) (append (cons (car l) (cdr (reverse (cdr l)))) (list (last l)))) (str->list s))
50.     )
51.   )
52. )
53. (defun midverse_a (s / c l i e o)
54.   (setq l (strlen s)
55.         i (substr s 1 1)
56.         e (substr s l)
57.         s (substr s 2 (- l 2))
58.         o ""
59.         c 1
60.   )
61.   (repeat (strlen s)
62.     (setq o (strcat (substr s c 1) o)
63.           c (1+ c)
64.     )
65.   )
66.   (strcat i o e)
67. )
68. (defun midverse_a2 (s / c l i e)
69.   (if (= 1 (setq l (strlen s)))
70.     s
71.     (progn (setq i (substr s 1 1)
72.                  e (substr s l)
73.                  s (substr s 2 (- l 2))
74.                  c 1
75.            )
76.            (repeat (strlen s)
77.              (setq e (strcat (substr s c 1) e)
78.                    c (1+ c)
79.              )
80.            )
81.            (strcat i e)
82.     )
83.   )
84. )
85. (defun midverse-kirby (mystring / outval)
86.   (setq outval nil)
87.   (if (eq (type mystring) 'str)
88.     (progn (setq outval (stringreverse mystring)) ; Reverse
89.            (setq outval (stringsubst outval (substr mystring 1 1) 1)) ; Replace first char
90.            (setq outval (stringsubst outval (substr mystring (strlen mystring) 1) (strlen mystring)))
91.                                         ; Replace last char
92.     )
93.   )
94.   outval
95. )
96. (defun stringreverse (mystring / outval cnt cnt1) ; Reverse a string
97.   (setq outval nil)                     ; null output
98.   (if (eq (type mystring) 'str)
99.     (progn (setq outval "")
100.            (setq cnt 0)
101.            (repeat (strlen mystring)
102.              (setq cnt1 (- (strlen mystring) cnt))
103.              (setq outval (strcat outval (substr mystring cnt1 1)))
104.              (setq cnt (1+ cnt))
105.            )                            ; close repeat
106.     )
107.   )
108.   outval
109. )
110. (defun stringsubst (mystring newstring pos / outval l part1 part2)
111.   (setq outval nil)
112.   (setq l (strlen mystring))
113.   (if (and (>= pos 1) (<= pos l))
114.     (progn (setq part1 (substr mystring 1 (1- pos))) ; first part of string before Pos
115.            (setq part2 (substr mystring (1+ pos) (- l pos))) ; last part of string after Pos
116.            (setq outval (strcat part1 newstring part2))
117.     )
118.   )
119.   outval
120. )
121. (benchmark '((midverse-rjp "retinues")
122.              (midverse-rjp2 "retinues")
123.              (midverse-gile "retinues")
124.              (midverse-gile2 "retinues")
125.              (midverse_a "retinues")
126.              (midverse_a2 "retinues")
127.              (midverse-kirby "retinues")
128.              (midverse-7 "retinues")
129.             )
130. )

[JohnK]

Quick benchmark .. looks like VL wins for speed on this one.
--->%

A procedural language that uses a C++ function to rip apart a string and another to stitch it back together again vs a procedural language's string access function(s); no contest! However, I'm actually surprised at how little it won by (it still surprises me how quick SUBSTR actually is!). And didn't Gile's first one use VL? How did that fare in the test?

I think I have a dumb idea to test out in the morning to possibly close the gap on the VL function just a bit.

[ronjonp]

Quick benchmark .. looks like VL wins for speed on this one.
--->%

A procedural language that uses a C++ function to rip apart a string and another to stitch it back together again vs a procedural language's string access function(s); no contest! However, I'm actually surprised at how little it won by (it still surprises me how quick SUBSTR actually is!). And didn't Gile's first one use VL? How did that fare in the test?

I think I have a dumb idea to test out in the morning to possibly close the gap on the VL function just a bit.

Updated the benchmarks, I had Gile's code duplicated for both functions. My vl vs non vl function is 2x the speed.

[gile]

An F# example using pattern matching.

Code - F#: [Select]

1. let midverse s =
2.     match Seq.toList s with
3.     | x :: xs ->
4.         match List.rev xs with
5.         | y :: ys -> x :: ys @ [y] |> List.toArray |> System.String
6.         | _ -> string x
7.     | _ -> ""

[JohnK]

An F# example using pattern matching.
--->%

Oh that's a neat trick.

[JohnK]

Code: [Select]

(defun Midverse_A (s / c L i e o)
  (setq L (strlen s) i (substr s 1 1) e (substr s L)  s (substr s 2 (- L 2)) o "" c 1)
  (repeat (strlen s)
    (setq o (strcat (substr s c 1) o)  c  (1+ c))
  )
  (strcat i o e)
)--->%

It looks like my idea was already taken. I like it, Marc'Antonio.