#!/usr/bin/env raku use v6.d; use WWW; unit sub MAIN ( 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 = ( # , # , # , # # ); # 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)[0] ~~ # 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; } } } } } if $verbose { say "Gray squares: ", @gray-squares; say "Puzzle"; " $_".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]; } } } else { # If it's out of boundary then return no neighbor. @neighbors[$y][$x] = []; } return @neighbors[$y][$x]; }