about summary refs log tree commit diff stats
path: root/lib/Octans
diff options
context:
space:
mode:
authorAndinus <andinus@nand.sh>2021-01-19 21:53:16 +0530
committerAndinus <andinus@nand.sh>2021-01-19 21:53:16 +0530
commita5c540608c469a2797262facb766e175b932f0e2 (patch)
tree1e0eb79678d66f5ba657c63003592029757aefe7 /lib/Octans
parent5bb0f224483fbc1d57fd1c5a2f4a22dd7263ecd6 (diff)
downloadoctans-a5c540608c469a2797262facb766e175b932f0e2.tar.gz
Re-structure for CPAN upload, include a dictionary file v0.1.0
bin/octans calls lib/Octans/CLI.rakumod which has the MAIN subroutine.
Diffstat (limited to 'lib/Octans')
-rw-r--r--lib/Octans/CLI.rakumod99
-rw-r--r--lib/Octans/Neighbors.rakumod53
-rw-r--r--lib/Octans/Puzzle.rakumod56
-rw-r--r--lib/Octans/RangeSearch.rakumod70
-rw-r--r--lib/Octans/WordSearch.rakumod67
5 files changed, 345 insertions, 0 deletions
diff --git a/lib/Octans/CLI.rakumod b/lib/Octans/CLI.rakumod
new file mode 100644
index 0000000..24ef59f
--- /dev/null
+++ b/lib/Octans/CLI.rakumod
@@ -0,0 +1,99 @@
+use Octans::Puzzle;
+use Octans::WordSearch;
+
+proto MAIN (|) is export {unless so @*ARGS {say $*USAGE; exit;}; {*}}
+multi sub MAIN(Bool :$version) is hidden-from-USAGE {
+    say "Octans v" ~ $?DISTRIBUTION.meta<version>;
+}
+
+multi sub MAIN (
+    Str $url?, #= url for Algot's crossword
+    Str :$dict = (%?RESOURCES<mwords/354984si.ngl> //
+                  "/usr/share/dict/words").Str, #= dictionary file
+    Bool :s($sample), #= run the sample puzzle
+    Bool :v($verbose), #= increase verbosity
+    Bool :$version, #= print version
+) {
+    # Print usage & exit if both sample & url are not passed.
+    unless ($sample or $url) {
+        say $*USAGE;
+        exit 0;
+    }
+
+    # @dict holds the sorted dictionary. Only consider words >= 7
+    # chars.
+    my Str @dict = $dict.IO.lines.grep(*.chars >= 7);
+
+    # @puzzle holds the puzzle.
+    #
+    # @gray-squares holds the list of indexes of valid starting
+    # positions in the puzzle.
+    my (@puzzle, @gray-squares);
+
+    # Set the sample puzzle if requested.
+    if $sample {
+        @puzzle = [
+            [<n a t k>],
+            [<i m e c>],
+            [<a r d e>],
+            [<t e c h>]
+        ];
+        @gray-squares = [3, 0], [2, 0]; # $y, $x
+    }
+
+    # Get the puzzle from $url if it's passed.
+    get-puzzle($url, @puzzle, @gray-squares) with $url;
+
+    if $verbose {
+        # Don't print path if using the dictionary included with the
+        # program.
+        say "Dictionary: ", $dict.Str
+                             unless ($dict.Str
+                                     eq %?RESOURCES<mwords/354984si.ngl>.Str);
+        say "Gray squares: ", @gray-squares;
+        say "Puzzle";
+        "    $_".say for @puzzle;
+    }
+
+    # After the solution is found, the path is printed with these
+    # fancy chars.
+    my %𝒻𝒶𝓃𝒸𝓎-𝒸𝒽𝒶𝓇𝓈 = <a a̶ b b̶ c c̶ d d̶ e e̶ f f̶ g g̶ h h̶ i i̶ j j̶ k k̶ l l̶
+                         m m̶ n n̶ o o̶ p p̶ q q̶ r r̶ s s̶ t t̶ u u̶ v v̶ w w̶
+                         x x̶ y y̶ z z̶>;
+
+    # start-pos block loops over each starting position.
+    start-pos: for @gray-squares -> $pos {
+        my DateTime $initial = DateTime.now;
+
+        # gather all the words that word-search finds starting from
+        # $pos.
+        for gather word-search(
+            @dict, @puzzle, $pos[0], $pos[1],
+        ) -> (
+            # word-search returns the word along with @visited which
+            # holds the list of all grids that were visited when the
+            # word was found.
+            $word, @visited
+        ) {
+            # Print the word, along with the time taken (if $verbose).
+            say ($verbose ??
+                 "\n" ~ $word ~ " [" ~ DateTime.now - $initial ~ "𝑠]" !!
+                 $word);
+
+            # Print the puzzle, highlighting the path.
+            if $verbose {
+                for ^@puzzle.elems -> $y {
+                    print " " x 3;
+                    for ^@puzzle[$y].elems -> $x {
+                        print " ", (@visited[$y][$x] ??
+                                    (%𝒻𝒶𝓃𝒸𝓎-𝒸𝒽𝒶𝓇𝓈{@puzzle[$y][$x]}
+                                     // @puzzle[$y][$x]) !!
+                                    @puzzle[$y][$x]
+                                   );
+                    }
+                    print "\n";
+                }
+            }
+        }
+    }
+}
diff --git a/lib/Octans/Neighbors.rakumod b/lib/Octans/Neighbors.rakumod
new file mode 100644
index 0000000..c6f1c00
--- /dev/null
+++ b/lib/Octans/Neighbors.rakumod
@@ -0,0 +1,53 @@
+unit module Octans::Neighbors;
+
+# neighbors returns the neighbors of given index. Neighbors are cached
+# in @neighbors array. This way we don't have to compute them
+# everytime neighbors subroutine is called for the same position.
+sub neighbors (
+    @puzzle, Int $y, Int $x --> List
+) is export {
+    # @directions is holding a list of directions we can move in. It's
+    # used later for neighbors subroutine.
+    state List @directions = (
+        # $y, $x
+        ( +1, +0 ), # bottom
+        ( -1, +0 ), # top
+        ( +0, +1 ), # left
+        ( +0, -1 ), # right
+    );
+
+    # @neighbors holds the neighbors of given position.
+    state Array @neighbors;
+
+    if @puzzle[$y][$x] {
+
+        # If we've already computed the neighbors then no need to do
+        # it again.
+        unless @neighbors[$y][$x] {
+            my Int $pos-x;
+            my Int $pos-y;
+
+            # Starting from the intital position of $y, $x we move to
+            # each direction according to the values specified in
+            # @directions array. In this case we're just trying to
+            # move in 4 directions (top, bottom, left & right).
+            DIRECTION: for @directions -> $direction {
+                $pos-y = $y + $direction[0];
+                $pos-x = $x + $direction[1];
+
+                # If movement in this direction is out of puzzle grid
+                # boundary then move on to next direction.
+                next DIRECTION unless @puzzle[$pos-y][$pos-x];
+
+                # If neighbors exist in this direction then add them
+                # to @neighbors[$y][$x] array.
+                push @neighbors[$y][$x], [$pos-y, $pos-x];
+            }
+        }
+    } else {
+        # If it's out of boundary then return no neighbor.
+        @neighbors[$y][$x] = [];
+    }
+
+    return @neighbors[$y][$x];
+}
diff --git a/lib/Octans/Puzzle.rakumod b/lib/Octans/Puzzle.rakumod
new file mode 100644
index 0000000..a35c409
--- /dev/null
+++ b/lib/Octans/Puzzle.rakumod
@@ -0,0 +1,56 @@
+unit module Octans::Puzzle;
+
+use WWW;
+
+# get-puzzle returns the @puzzle along with it's @gray-squares.
+sub get-puzzle (
+    Str $url,
+
+    # @puzzle will hold the puzzle grid.
+    @puzzle,
+
+    # @gray-squares will hold the position of gray squares. Algot
+    # marks them with an asterisk ("*") after the character.
+    @gray-squares
+) is export {
+    # $toot_url will hold the url that we'll call to get the toot data.
+    my Str $toot_url;
+
+    # User can pass 2 types of links, either it will be the one when they
+    # view it from their local instance or the one they get from Algot's
+    # profile. We set $toot_url from it.
+    if $url.match("web/statuses") -> $match {
+        $toot_url = $match.replace-with("api/v1/statuses");
+    } else {
+        $toot_url = "https://mastodon.art/api/v1/statuses/" ~ $url.split("/")[*-1];
+    }
+
+    # @gray-squares should be empty.
+    @gray-squares = ();
+
+    # jget just get's the url & decodes the json. We access the
+    # description field of 1st media attachment.
+    if (jget($toot_url)<media_attachments>[0]<description> ~~
+
+        # This regex gets the puzzle in $match.
+        / [[(\w [\*]?) \s*] ** 4] ** 4 $/) -> $match {
+
+        # We have each character of the puzzle stored in $match. It's
+        # assumed that it'll be a 4x4 grid.
+        for 0 .. 3 -> $y {
+            for 0 .. 3 -> $x {
+                with $match[0][($y * 4) + $x].Str.lc -> $char {
+
+                    # If it ends with an asterisk then we push the
+                    # position to @gray-squares.
+                    if $char.ends-with("*") {
+                        @puzzle[$y][$x] = $char.comb[0];
+                        push @gray-squares, [$y, $x];
+                    } else {
+                        @puzzle[$y][$x] = $char;
+                    }
+                }
+            }
+        }
+    }
+}
diff --git a/lib/Octans/RangeSearch.rakumod b/lib/Octans/RangeSearch.rakumod
new file mode 100644
index 0000000..e287d93
--- /dev/null
+++ b/lib/Octans/RangeSearch.rakumod
@@ -0,0 +1,70 @@
+unit module Octans::RangeSearch;
+
+# range-starts-with returns a subset of given @dict list that start
+# with $str. It should be faster than:
+#
+#   @dict.grep: *.starts-with($str)
+#
+# @dict should be a sorted list of words. It performs binary lookup on
+# the list.
+sub range-starts-with (
+    @dict, Str $str --> List
+) is export {
+    # $lower, $upper hold the lower and upper index of the range
+    # respectively.
+    my Int ($lower, $upper);
+
+    # Lookup the whole dictionary.
+    my Int ($start, $end) = (0, @dict.end);
+
+    # Loop until we end up on the lower index of range.
+    while $start < $end {
+        # Divide the list into 2 parts.
+        my Int $mid = ($start + $end) div 2;
+
+        # Check if $mid word is le (less than or equal to) $str. If
+        # true then discard the bottom end of the list, if not then
+        # discard the top end.
+        if $str le @dict[$mid].substr(0, $str.chars).lc {
+            $end = $mid;
+        } else {
+            $start = $mid + 1;
+        }
+    }
+
+    # Found the lower index.
+    $lower = $start;
+
+    # Set $end to the end of list but keep $start at the lower index.
+    $end = @dict.end;
+
+    # Loop until we end up on the upper index of range.
+    while $start < $end {
+        # Divide the list into 2 parts. Adds 1 because we have to find
+        # the upper index in this part. `div' performs Interger
+        # division, output is floor'ed.
+        my Int $mid = (($start + $end) div 2) + 1;
+
+        # Check if $mid word is lt (less than) $str. If true then
+        # discard the bottom end of the list, if not then discard the
+        # top end.
+        if $str lt @dict[$mid].substr(0, $str.chars).lc {
+            $end = $mid - 1;
+        } else {
+            $start = $mid;
+        }
+    }
+
+    # Found the upper index.
+    $upper = $end;
+
+    with @dict[$lower..$upper] -> @list {
+        # Maybe the word doesn't exist in the list, in that case there
+        # will be a single element in @list. We return an empty list
+        # unless that single element starts with $str.
+        if @list.elems == 1 {
+            return () unless @list[0].starts-with($str);
+        }
+        return @list;
+    }
+}
diff --git a/lib/Octans/WordSearch.rakumod b/lib/Octans/WordSearch.rakumod
new file mode 100644
index 0000000..a1ed2c3
--- /dev/null
+++ b/lib/Octans/WordSearch.rakumod
@@ -0,0 +1,67 @@
+unit module Octans::WordSearch;
+
+use Octans::Neighbors;
+use Octans::RangeSearch;
+
+# word-search walks the given grid & tries to find words in the
+# dictionary. It walks in Depth-First manner (lookup Depth-First
+# search).
+sub word-search (
+    # @dict holds the dictionary. @puzzle holds the puzzle.
+    @dict, @puzzle,
+
+    # $y, $x is the position of the current cell, we have to follow
+    # this path. $str is the string we've looked up until now. If it's
+    # not passed then assume that we're starting at $y, $x and take
+    # @puzzle[$y][$x] as the string.
+    #
+    # $str should be passed in recursive calls, it's not required when
+    # $y, $x is the starting position.
+    Int $y, Int $x, $str? = @puzzle[$y][$x],
+
+    # @visited holds the positions that we've already visited.
+    @visited? is copy --> List
+) is export {
+    # If @visited was not passed then mark the given cell as visited
+    # because it's the cell we're starting at.
+    @visited[$y][$x] = True unless @visited;
+
+    # neighbor block loops over the neighbors of $y, $x.
+    neighbor: for neighbors(@puzzle, $y, $x).List -> $pos {
+        # Move on to next neighbor if we've already visited this one.
+        next neighbor if @visited[$pos[0]][$pos[1]];
+
+        # Mark this cell as visited but only until we search this
+        # path. When moving to next neighbor, mark it False.
+        @visited[$pos[0]][$pos[1]] = True;
+
+        # $word is the string that we're going to lookup in the
+        # dictionary.
+        my Str $word = $str ~ @puzzle[$pos[0]][$pos[1]];
+
+        # range-starts-with returns a list of all words in the
+        # dictionary that start with $word.
+        with range-starts-with(@dict, $word) -> @list {
+            if @list.elems > 0 {
+                # If $word exist in the dictionary then it should be
+                # the first element in the list.
+                take @list[0], @visited if @list[0] eq $word;
+
+                # Continue on this path because there are 1 or more
+                # elements in @list which means we could find a word.
+                word-search(
+                    # Don't pass the whole dictionary for next search.
+                    # Words that start with "ab" will always be a
+                    # subset of words that start with "a", so keeping
+                    # this in mind we pass the output of last
+                    # range-starts-with (@list).
+                    @list, @puzzle, $pos[0], $pos[1], $word, @visited
+                );
+            }
+        }
+
+        # We're done looking up this path, mark this cell as False &
+        # move on to another neighbor.
+        @visited[$pos[0]][$pos[1]] = False;
+    }
+}