Author Topic: [challenge] A31 : Midverse  (Read 1449 times)

0 Members and 1 Guest are viewing this topic.

JohnK

  • Administrator
  • Seagull
  • Posts: 10140
[challenge] A31 : Midverse
« on: March 07, 2022, 11:12:19 AM »
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.
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

gile

  • Water Moccasin
  • Posts: 2392
  • Marseille, France
Re: [challenge] A31 : Midverse
« Reply #1 on: March 07, 2022, 11:31:24 AM »
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. )
Speaking English as a French Frog

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1314
  • Marco
Re: [challenge] A31 : Midverse
« Reply #2 on: March 07, 2022, 11:36:19 AM »
...finito... (end) or is with Vanilla Lisp?

ronjonp

  • Needs a day job
  • Posts: 7437
Re: [challenge] A31 : Midverse
« Reply #3 on: March 07, 2022, 11:39:38 AM »
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")
« Last Edit: March 07, 2022, 11:45:51 PM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2022

Custom Build PC

gile

  • Water Moccasin
  • Posts: 2392
  • Marseille, France
Re: [challenge] A31 : Midverse
« Reply #4 on: March 07, 2022, 11:41:20 AM »
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.          (mapcar 'chr
  6.                  ((lambda (l)
  7.                     (append (cons (car l) (cdr (reverse (cdr l)))) (list (last l)))
  8.                   )
  9.                    (str->list s)
  10.                  )
  11.          )
  12.   )
  13. )
« Last Edit: March 07, 2022, 11:58:56 AM by gile »
Speaking English as a French Frog

JohnK

  • Administrator
  • Seagull
  • Posts: 10140
Re: [challenge] A31 : Midverse
« Reply #5 on: March 07, 2022, 11:46:01 AM »
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.   )
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1314
  • Marco
Re: [challenge] A31 : Midverse
« Reply #6 on: March 07, 2022, 12:13:53 PM »
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

  • Newt
  • Posts: 110
Re: [challenge] A31 : Midverse
« Reply #7 on: March 07, 2022, 01:07:32 PM »
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

  • Administrator
  • Seagull
  • Posts: 10140
Re: [challenge] A31 : Midverse
« Reply #8 on: March 07, 2022, 01:45:29 PM »
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.  
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

ronjonp

  • Needs a day job
  • Posts: 7437
Re: [challenge] A31 : Midverse
« Reply #9 on: March 07, 2022, 07:42:09 PM »
Quick benchmark .. looks like VL wins for speed on this one.
Quote
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.          (mapcar 'chr (append (cons (car lst) (cdr (reverse (cdr lst)))) (list (last lst))))
  15.   )
  16. )
  17. (defun midverse-rjp (str / a b c)
  18.   (setq a (vl-string->list str))
  19.   (setq b (car a))
  20.   (setq c (last a))
  21.   (setq a (cdr a))
  22.   (vl-list->string (append (list b) (cdr (reverse a)) (list c)))
  23. )
  24. (defun midverse-rjp2 (str / n r)
  25.   (setq n 1)
  26.   (repeat (- (strlen str) 2) (setq r (cons (substr str (setq n (1+ n)) 1) r)))
  27.   (strcat (substr str 1 1) (apply 'strcat r) (substr str (strlen str) 1))
  28. )
  29. (defun midverse-gile (s)
  30.   (vl-list->string
  31.     ((lambda (l)
  32.        (append (cons (car l) (cdr (reverse (cdr l)))) (list (last l)))
  33.      )
  34.       (vl-string->list s)
  35.     )
  36.   )
  37. )
  38. (defun midverse-gile2 (s / str->list)
  39.   (defun str->list (s)
  40.     (if (< 0 (strlen s))
  41.       (cons (ascii (substr s 1 1)) (str->list (substr s 2)))
  42.     )
  43.   )
  44.   (apply
  45.     'strcat
  46.     (mapcar
  47.       'chr
  48.       ((lambda (l) (append (cons (car l) (cdr (reverse (cdr l)))) (list (last l)))) (str->list s))
  49.     )
  50.   )
  51. )
  52. (defun midverse_a (s / c l i e o)
  53.   (setq l (strlen s)
  54.         i (substr s 1 1)
  55.         e (substr s l)
  56.         s (substr s 2 (- l 2))
  57.         o ""
  58.         c 1
  59.   )
  60.   (repeat (strlen s)
  61.     (setq o (strcat (substr s c 1) o)
  62.           c (1+ c)
  63.     )
  64.   )
  65.   (strcat i o e)
  66. )
  67. (defun midverse_a2 (s / c l i e)
  68.   (if (= 1 (setq l (strlen s)))
  69.     s
  70.     (progn (setq i (substr s 1 1)
  71.                  e (substr s l)
  72.                  s (substr s 2 (- l 2))
  73.                  c 1
  74.            )
  75.            (repeat (strlen s)
  76.              (setq e (strcat (substr s c 1) e)
  77.                    c (1+ c)
  78.              )
  79.            )
  80.            (strcat i e)
  81.     )
  82.   )
  83. )
  84. (defun midverse-kirby (mystring / outval)
  85.   (setq outval nil)
  86.   (if (eq (type mystring) 'str)
  87.     (progn (setq outval (stringreverse mystring)) ; Reverse
  88.            (setq outval (stringsubst outval (substr mystring 1 1) 1)) ; Replace first char
  89.            (setq outval (stringsubst outval (substr mystring (strlen mystring) 1) (strlen mystring)))
  90.                                         ; Replace last char
  91.     )
  92.   )
  93.   outval
  94. )
  95. (defun stringreverse (mystring / outval cnt cnt1) ; Reverse a string
  96.   (setq outval nil)                     ; null output
  97.   (if (eq (type mystring) 'str)
  98.     (progn (setq outval "")
  99.            (setq cnt 0)
  100.            (repeat (strlen mystring)
  101.              (setq cnt1 (- (strlen mystring) cnt))
  102.              (setq outval (strcat outval (substr mystring cnt1 1)))
  103.              (setq cnt (1+ cnt))
  104.            )                            ; close repeat
  105.     )
  106.   )
  107.   outval
  108. )
  109. (defun stringsubst (mystring newstring pos / outval l part1 part2)
  110.   (setq outval nil)
  111.   (setq l (strlen mystring))
  112.   (if (and (>= pos 1) (<= pos l))
  113.     (progn (setq part1 (substr mystring 1 (1- pos))) ; first part of string before Pos
  114.            (setq part2 (substr mystring (1+ pos) (- l pos))) ; last part of string after Pos
  115.            (setq outval (strcat part1 newstring part2))
  116.     )
  117.   )
  118.   outval
  119. )
  120. (benchmark '((midverse-rjp "retinues")
  121.              (midverse-rjp2 "retinues")
  122.              (midverse-gile "retinues")
  123.              (midverse-gile2 "retinues")
  124.              (midverse_a "retinues")
  125.              (midverse_a2 "retinues")
  126.              (midverse-kirby "retinues")
  127.              (midverse-7 "retinues")
  128.             )
  129. )
« Last Edit: March 07, 2022, 11:42:58 PM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2022

Custom Build PC

JohnK

  • Administrator
  • Seagull
  • Posts: 10140
Re: [challenge] A31 : Midverse
« Reply #10 on: March 07, 2022, 08:18:58 PM »
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.
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

ronjonp

  • Needs a day job
  • Posts: 7437
Re: [challenge] A31 : Midverse
« Reply #11 on: March 07, 2022, 11:44:39 PM »
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.

Windows 11 x64 - AutoCAD /C3D 2022

Custom Build PC

gile

  • Water Moccasin
  • Posts: 2392
  • Marseille, France
Re: [challenge] A31 : Midverse
« Reply #12 on: March 08, 2022, 01:36:28 AM »
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.     | _ -> ""
Speaking English as a French Frog

JohnK

  • Administrator
  • Seagull
  • Posts: 10140
Re: [challenge] A31 : Midverse
« Reply #13 on: March 08, 2022, 08:16:40 AM »
An F# example using pattern matching.
--->%

Oh that's a neat trick. :)
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

JohnK

  • Administrator
  • Seagull
  • Posts: 10140
Re: [challenge] A31 : Midverse
« Reply #14 on: March 08, 2022, 08:51:48 AM »
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.
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org