From 52ceae37900545eca82809566307e4463fd4fe54 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 28 Apr 2016 20:51:39 -0700
Subject: [PATCH] successor: new vocab.

---
 extra/successor/authors.txt            |  1 +
 extra/successor/successor-docs.factor  | 16 +++++++++
 extra/successor/successor-tests.factor | 14 ++++++++
 extra/successor/successor.factor       | 46 ++++++++++++++++++++++++++
 4 files changed, 77 insertions(+)
 create mode 100644 extra/successor/authors.txt
 create mode 100644 extra/successor/successor-docs.factor
 create mode 100644 extra/successor/successor-tests.factor
 create mode 100644 extra/successor/successor.factor

diff --git a/extra/successor/authors.txt b/extra/successor/authors.txt
new file mode 100644
index 00000000000..e091bb8164f
--- /dev/null
+++ b/extra/successor/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/successor/successor-docs.factor b/extra/successor/successor-docs.factor
new file mode 100644
index 00000000000..fad0a23d11f
--- /dev/null
+++ b/extra/successor/successor-docs.factor
@@ -0,0 +1,16 @@
+! Copyright (C) 2011 John Benediktsson.
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: help.markup help.syntax successor strings ;
+
+IN: succesor
+
+HELP: successor
+{ $values { "str" string } }
+{ $description
+    "Returns the successor to " { $snippet "str" } ". The successor is calculated by incrementing characters starting from the rightmost alphanumeric (or the rightmost character if there are no alphanumerics) in the string. Incrementing a digit always results in another digit, and incrementing a letter results in another letter of the same case. "
+    $nl
+    "If the increment generates a carry, the character to the left of it is incremented. This process repeats until there is no carry, adding an additional character if necessary. "
+} ;
+
+
diff --git a/extra/successor/successor-tests.factor b/extra/successor/successor-tests.factor
new file mode 100644
index 00000000000..3cd167f568d
--- /dev/null
+++ b/extra/successor/successor-tests.factor
@@ -0,0 +1,14 @@
+! Copyright (C) 2011 John Benediktsson.
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: successor tools.test ;
+
+IN: successor
+
+[ "" ] [ "" successor ] unit-test
+[ "abce" ] [ "abcd" successor ] unit-test
+[ "THX1139" ] [ "THX1138" successor ] unit-test
+[ "<<koalb>>" ] [ "<<koala>>" successor ] unit-test
+[ "2000aaa" ] [ "1999zzz" successor ] unit-test
+[ "AAAA0000" ] [ "ZZZ9999" successor ] unit-test
+[ "**+" ] [ "***" successor ] unit-test
diff --git a/extra/successor/successor.factor b/extra/successor/successor.factor
new file mode 100644
index 00000000000..9f6f9f9c450
--- /dev/null
+++ b/extra/successor/successor.factor
@@ -0,0 +1,46 @@
+! Copyright (C) 2011 John Benediktsson.
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: ascii combinators combinators.short-circuit fry kernel
+math sequences ;
+
+IN: successor
+
+<PRIVATE
+
+: carry ( elt last first -- ? elt' )
+    '[ _ > dup _ ] keep ? ;
+
+: next-digit ( ch -- ? ch' )
+    1 + CHAR: 9 CHAR: 0 carry ;
+
+: next-letter ( ch -- ? ch' )
+    [ ch>lower 1 + CHAR: z CHAR: a carry ] [ LETTER? ] bi
+    [ ch>upper ] when ;
+
+: next-char ( ch -- ? ch' )
+    {
+        { [ dup digit?  ] [ next-digit  ] }
+        { [ dup Letter? ] [ next-letter ] }
+        [ t swap ]
+    } cond ;
+
+: map-until ( seq quot: ( elt -- ? elt' ) -- seq' ? )
+    [ t 0 pick length '[ 2dup _ < and ] ] dip '[
+        nip [ over _ change-nth ] keep 1 +
+    ] while drop ; inline
+
+: alphanum? ( ch -- ? )
+    { [ Letter? ] [ digit? ] } 1|| ;
+
+PRIVATE>
+
+: successor ( str -- str' )
+    dup empty? [
+        dup [ alphanum? ] any? [
+            reverse [ next-char ] map-until
+            [ dup last suffix ] when reverse
+        ] [
+            dup length 1 - over [ 1 + ] change-nth
+        ] if
+    ] unless ;