diff options
Diffstat (limited to 'octans.raku')
| -rwxr-xr-x | octans.raku | 268 |
1 files changed, 56 insertions, 212 deletions
diff --git a/octans.raku b/octans.raku index 0c2e3fa..e65613e 100755 --- a/octans.raku +++ b/octans.raku @@ -1,87 +1,34 @@ #!/usr/bin/env raku use v6.d; -use WWW; +use lib 'lib'; +use Puzzle; +use WordSearch; unit sub MAIN ( - Str $url, #= url for Algot's crossword + Str $url?, #= url for Algot's crossword Str :$dict = "/usr/share/dict/words", #= dictionary file Bool :v($verbose), #= increase verbosity ); -# @directions is holding a list of directions we can move in. It's -# used later for neighbors subroutine. -my List @directions[4] = ( - # $y, $x - ( +1, +0 ), # bottom - ( -1, +0 ), # top - ( +0, +1 ), # left - ( +0, -1 ), # right -); - -# This code is just for testing purpose. The code below that is -# getting the puzzle & parsing it will set @puzzle & @gray-squares -# like this: - -# We can call @puzzle[$y][$x] to get the character. $y stands for -# column & $x for row, so @puzzle[0][3] will return `k' for this -# sample @puzzle: - -# my List @puzzle = ( -# <n a t k>, -# <i m e c>, -# <a r d e>, -# <t e c h> -# ); - -# my List @gray-squares = (3, 0), (2, 0); # $y, $x - -# @puzzle will hold the puzzle grid. -my @puzzle; - -# @gray-squares will hold the position of gray squares. Algot marks -# them with an asterisk ("*") after the character. -my @gray-squares; - -# $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]; -} - -say "Fetching: $toot_url" if $verbose; - -# 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; - } - } - } - } -} +# @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); +@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 { say "Gray squares: ", @gray-squares; @@ -89,144 +36,41 @@ if $verbose { " $_".say for @puzzle; } -# This for block loops over every word in the dictionary & searches -# the puzzle grid for it's presence. -word: for $dict.IO.lines -> $word { - # We don't want words whose length is less than 7. - next word unless $word.chars >= 7; - - # start-pos block loops over each starting position. In normal - # case every position could be the start position but for Algot's - # puzzle they're limited to a few blocks. - start-pos: for @gray-squares -> $pos { - - # If the dictionary word doesn't start with the starting - # position character then move on to the next start position. - next start-pos unless $word.starts-with( - @puzzle[$pos[0]][$pos[1]] - ); - - # Check if each letter of word is present in puzzle grid. - next word unless $word.comb ⊆ @puzzle[*;*]; - - # Print the word if the search is successful. - say $word if word-search(@puzzle, $pos[0], $pos[1], $word); - } -} - -# word-search performs a Depth-First search on @puzzle. word-search -# matches the word character by character. -sub word-search ( - @puzzle, Int $y, Int $x, - - # $count will keep the count of character's of $word present in - # the puzzle. - Str $word, Int $count = 1, - @visited? is copy - --> Bool -) { - # If the number of character's we've found is equal to the length - # of $word then return True because we've found the whole word. - return True if $count == $word.chars; - - # For each neighbor, we perform a Depth-First search to find the - # word. - neighbor: for neighbors(@puzzle, $y, $x).List -> $pos { - - # Move on to next neighbor if we've already visited this one. - # This is because we cannot reuse a grid. - next neighbor if @visited[$pos[0]][$pos[1]]; - - if @puzzle[$pos[0]][$pos[1]] eq $word.comb[$count] { - - # This explains why we have to mark this position as False - # if the search fails: - # - # Here we're marking this position as True. This approach - # might cause us to miss possible solutions. If the puzzle - # is like so: - # - # a b e - # c a f - # - # And the word we're looking for is "cabefa". Then let's - # say that we go through the other 'a' first (bottom-mid - # 'a') & at this point it would be marked as True but the - # search would fail (correctly so). - # - # And after that failure we move to next neighbor which is - # top-left 'a'. The search goes on until we reach 'f' & - # get the list of f's neighbors which would return 'e' & - # bottom-mid 'a'. Now 'e' would be discarded because it - # was marked as visited but 'a' also has been marked as - # visited & it too would be discarded. - # - # This would cause us to miss solutions. So we just make - # it False again if the word wasn't found with this - # neighbor. After making it False, we move on to the next - # neighbor. - - @visited[$pos[0]][$pos[1]] = True; - - # Call word-search recursively & increment $count as we - # find each character. If the search was successful then - # return True. - if word-search( - @puzzle, $pos[0], $pos[1], - $word, $count + 1, - @visited - ) { - return True; - } else { - # Mark this as not visited if the search was - # unsuccessful and move on to next neighbor. - @visited[$pos[0]][$pos[1]] = False; - next neighbor; - } - } - } - - # return False if no neighbor matches the character. - return False; -} - -# 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 -) { - 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]; +# 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"; } } - } else { - # If it's out of boundary then return no neighbor. - @neighbors[$y][$x] = []; } - - return @neighbors[$y][$x]; } |