BASIC’s 50th Anniversary … and more crazy F# type providers!

by Pezi 1. May 2014 08:56

Did you know that it is the 50th anniversary of the BASIC programming language today? (1st May) No? Well why not!  BASIC is the language that brought computers to the mainstream.  Back in the day, if you had a computer, you learnt how to program it in basic.  Infact, when you switched it on, that’s what you were presented with.  These computers wanted to be programmed. Thousands of people purchased these expensive computers purely to learn how to program them.

I figured I should do something to mark the anniversary.  Many of you will already know about my various crazy type providers, including MineSweeper and Choose Your Own Adventrue.  So, I thought to myself, wouldn’t it be great if we could write some equivalents of the very early BASIC games via a re-usable and extensible type provider?  One which doesn’t require you to write any type-providing code, but is abstracted away from all that …


Enter InteractiveProvider (which I just wrote this afternoon).  Unfortunately, it doesn’t yet support any BASIC (although Phil Trelford’s Small Basic interpreter is looking like a good fit).  What it does do is abstract away all the voodoo magic of infinitely-recursive-type-providers, and allow you to write some fairly sophisticated type provider games by implementing a couple of interfaces.  The type provider itself will scan assemblies in a given location to find types that implement the interfaces it uses, and the rest happens JUST LIKE MAGIC!  There’s not much content yet, I have converted some simple BASIC games from the legendary 101 BASIC games book, and some of the my other type providers to work with it as examples, although I have some special plans up my sleeve for new games !

To use it, grab and build the source from my github and do something like the following in your friendly FSI session

#r @"F:\git\InteractiveProvider\InteractiveProvider\bin\Debug\InteractiveProvider.dll"

open PinkSquirrels.Interactive

type GamesType = InteractiveProvider< @"F:\git\InteractiveProvider\BASIC_Anniversary\bin\Debug\">

let games = GamesType()

The static parameter here is the directory to search for assemblies containing compatible games.  Now when you press dot on the games value, you will be presented with a series of properties named ‘Start <game>’, one for each type it found implementing said interfaces (more on that below)



There are currently a massive 3 games.


Ronseal.  See this post for more informations



Rock Paper Scissors

Try your hand against the computer in this classic game!



My personal favourite, this introduces another ground-breaking type provider mechanic, the ability to input any sized number via successive properties!  In this game you are a chemist and you must correctly dilute the fictional KRYPTOCYANIC acid.





Writing Games

By this point you must be just crying out to write your own games.  And I too am crying out for your pull requests.  The way it works is as follows.

There are two interfaces.  IInteractiveState and IInteractiveServer

type IInteractiveState= 
    abstract member DisplayText : string 
    abstract member DisplayOptions : (string * obj) list

type IInteractiveServer = 
    abstract member NewState : IInteractiveState 
    abstract member ProcessResponse : IInteractiveState * obj –> IInteractiveState

The type provider will pick up on any types that implement the server interface.  Upon doing so, it will call Activator.CreateInstance and create an instance of the server type.  From this type it will get an initial state from the NewState property.

The state interface returns information to the type provider via DisplayOptions about what choices it should surface as properties, along with objects to pass back to the server when a property is selected.  It also has a property DisplayText which is a string that will be placed on the property that leads to this state.  In some games  this is not desirable as it gives the player a preview of the next state, however there is a way around that (see Rock Paper Scissors)

The objects themselves that implement these interfaces can be literally anything you like at all.  The only caveat is that you must store all the information in the state which you require.  When a property is accessed, the old state gets passed to the ProcessResponse function along with the object representing the selection, which can be anything, as previously defined in the DisplayOptions .  In MineSweeper this is the int * int tuple of the grid square that was selected.  In Chemistry it is a discriminated union type. Rock Paper Scissors uses something different again.

Often it is a good choice to use a record type or discriminated union for your state.  Rock Paper Scissors simply holds everything it needs  to know about the game in one record type which both interfaces use to define their next behaviour.   Chemistry uses multiple discriminated union cases and lots of pattern matching to work out the behaviour.



Here’s a very simple example that has the player guess a number from 1 to 100.  It uses a discriminated union to model the different states.  There is no fail condition, you can just keep guessing until you win :)

type ExampleState = 
    | Start of target: int 
    | Guess of lastGuess : int * target : int 
    | Success 
    interface IInteractiveState with 
        member this.DisplayText = 
            // create the text that will appear on the property 
            match this with 
            | Start _ -> "I HAVE PICKED A NUMBER FROM 1 TO 100! SEE IF YOU CAN GUESS IT!" 
            | Guess(last,targ) -> 
                if last > targ then "WRONG!! MY NUMBER IS LESS THAN THAT! GUESS AGAIN FOOL!" 
            | Success -> "YOU WIN!!" 
        member this.DisplayOptions = 
            match this with 
            | Start _ 
            | Guess(_,_) -> 
                // in all cases except for a win, show 1 - 100 properties 
                [for x in 1..100 -> (x.ToString(),box x)] 
            | Success -> [] // game over

type ExampleGame() = 
    interface IInteractiveServer  with 
        member this.NewState = // create the inital state 
            Start (Utils.rnd.Next(1,101))  :> IInteractiveState 
        member this.ProcessResponse(state,choice) = 
            let newGuess = unbox<int> choice 
            match state :?> ExampleState with 
            | Start target 
            | Guess(_,target) when target = newGuess -> Success :> IInteractiveState 
            | Success -> failwith "this case is not possible" 
            | Start target 
            | Guess(_,target) -> Guess(newGuess,target) :> IInteractiveState


That's it! No ProvidedTypes or any other craziness in sight.  Now if I fire up the type provider, I can play this smashing game as follows, it seems the computer picked exactly 50 on this first go!


Watch this space for more exciting, much more complex games in the future!  In the meantime, please have a go and write your own games, and submit me pull requests!


F# | type providers

Solving Puzzle Quest with F# Part 1

by Pezi 17. April 2014 04:57

Tomas Petricek posted an article recently about how he used F# to solve a puzzle he had been given for Christmas.  This reminded me of several similar mini-projects I have developed in the past, the most recent being a program to help solve a specific sort of puzzle in the game Puzzle Quest, which I shall now describe.

Puzzle Quest is a match-3 game, with various game modes.  One game mode in particular, “Capture”, has a specific layout of tiles which can be matched in a certain way to leave no tiles behind at the end.  Some of these are really quite tricky, and I thought it would be fun to write a program to solve them.  Here is a example of a puzzle:



As ever with F#, the first thing you do is write the types you will need to represent the problem.  Because the game is very much about mutable state, and the order of things is important, it is natural to represent the board itself as a two dimensional array. The game has a bunch of different tile types that can appear in the grid somewhere, which are easily modelled by the very awesome discriminated union:

type Tile = 
    | Yellow 
    | Blue 
    | Green 
    | Red 
    | Purple 
    | Coin 
    | Skull of Flaming : bool 
    | Blank

Notice skull is slightly different – this is because there are two types of skull.  You get normal skulls, and exploding ones – they function the same in terms of matching, but when a flaming skull is part of a match, it also destroys all 8 tiles around it (recursively - this explosion can take out further exploding skulls).  Thanks to the mega awesome discriminated union, I can really easily model additional behavior of the skull within the type.

What else is required? Err… not much really, that’s about it!  One other small thing that will be required though is directions – the processing steps will have to move along in certain directions to discover matches, and other stuff

type Direction = 
    | Up 
    | Down 
    | Left 
    | Right


Obviously, I need an easy way to express a board, and a way to print them as well.  This is very easily done with a string:

let createBoard (text:string) = 
    let data = text.Replace("\n","") 
                   .Replace(" ","").ToCharArray() 
    Array2D.init 8 8 (fun row col -> 
        match data.[row*8+col] with 
        | 'y' -> Yellow 
        | 'b' -> Blue 
        | 'g' -> Green 
        | 'r' -> Red 
        | 'c' -> Coin 
        | 'p' -> Purple 
        | 's' -> Skull false 
        | 'S' -> Skull true 
        | '_' -> Blank 
        | x -> failwithf "unexpected input '%c'" x)

let printBoard board = 
    let sb = System.Text.StringBuilder() 
    |> Array2D.iteri(fun row col tile -> 
        match tile with 
        | Yellow      -> sb.Append("y") |> ignore 
        | Blue        -> sb.Append("b") |> ignore 
        | Green       -> sb.Append("g") |> ignore 
        | Red         -> sb.Append("r") |> ignore 
        | Skull true  -> sb.Append("S") |> ignore 
        | Skull false -> sb.Append("s") |> ignore 
        | Purple      -> sb.Append("p") |> ignore 
        | Coin        -> sb.Append("c") |> ignore 
        | Blank       -> sb.Append("_") |> ignore 
        if col = 7 then sb.AppendLine() |> ignore) 

Nice and simple so far, now I can create a board by doing something like this

let wight = 

Processing Logic

Now for the good stuff .. before thinking about attempting to solve a puzzle, first I must be able to fully emulate the process that occurs when two tiles are swapped (the player makes a move).

  1. Swap the two tiles
  2. Search in all directions from the two new tiles to find a chain of 2+ tiles of the same type
  3. The resulting tiles will need to be removed – but watch out for flaming skulls! these will also remove all their neighbours, and this process will continue if more flaming skulls are hit in the explosion
  4. Once all the tiles have been removed, all tiles above the removed ones will need to be moved down the correct amount of places to fill the gaps
  5. Now, ALL tiles that were affected (eg all the ones that were moved down to fill gaps) will need to have this whole process from 2. performed on them, to find any chain-matches.  Not only that, but they must all be processed at the SAME time to ensure the configuration of the board is not changed between evaluating each affected tile. 

Whew – this is actually pretty complicated!  There’s various things to trip over on the way, but as you can see a lot of this lends itself well to recursive processing, which means that as usual F# is an awesome fit for this kind of problem.

Firstly, a small function that safely gets the neighbour of a tile in a given direction

let getNeighbour (board:Tile[,]) row col direction = 
    match direction with 
    | Up   -> if row > 0 then Some(board.[row-1,col] ,row-1,col) else None 
    | Down -> if row < 7 then Some(board.[row+1,col] ,row+1,col) else None 
    | Left -> if col > 0 then Some(board.[row,col-1] ,row,col-1) else None 
    | Right-> if col < 7 then Some(board.[row,col+1],row,col+1) else None 

And a special one to safely get all surrounding tiles, for use with processing those pesky flaming skulls

let getSurroundingTiles (board:Tile[,]) row col = 
    [-1,-1;    -1,0;    -1,1; 
      0,-1;              0,1; 
      1,-1;     1,0;     1,1;] 
    |> List.choose(fun (rd, cd) -> 
        let r = row + rd 
        let c = row + cd 
        if r < 7 && r > 0 && c < 7 && c > 0 then 
            Some(board.[r,c], r, c) 
        else None)

And next a very cool function that, given a starting location and direction, will produce a sequence of tiles until a different kind of tile is found.  Seq.unfold is a very nice way of achieving this.  If you are new to functional programming then Seq.unfold will likely make your head explode, play around with it though as it’s great once you understand how to use it!

let unfoldMatches board row col direction f = 
    |> Seq.unfold( 
        fun (row,col,direction) -> 
            match getNeighbour board row col direction with 
            | Some(tile,newRow,newCol) when f tile ->  Some((tile,newRow,newCol),(newRow,newCol,direction)) 
            | _ -> None) 
    |> Seq.toList

Notice when f tilef is a function that is passed in, and it is used to determine when the sequence should stop.  The reason I have not simply used equality on the tile type is because those pesky skulls again.  Whilst Skull(true) and Skull(false) are the same union case, they are not equivalent, however for purposes of the matching they should always be treated as equivalent – this is achieved via f as you will see soon.  This is also the reason why the unfold function returns the tile types – this wouldn’t usually be necessary as I should already know the tile type, but in the case of the skulls I need to be able to disambiguate them at a later stage, so the flaming ones can be processed appropriately.

let getBasicMatches (board:Tile[,]) row col f = 
    |> List.choose(fun (dira,dirb) -> 
        unfoldMatches board row col dira f @ unfoldMatches board row col dirb f 
        |> function _::_::_ as xs -> Some xs | _ -> None) 
    // don't forget to include the original tile 
    |> matches -> (board.[row,col],row,col)::matches) 
    |> List.collect id 

This function might be confusing for various reasons! Notice here that I match both left and right at the same time, then both up and down at the same time.  The reason for this is because the tile in question might be in the centre of a 3+ match, therefore I cannot simply check left or right.  This approach instead does both at the same time, appends the results together, then looks at the resulting list. If it has 2 or more tiles -achieved using list pattern match ( _::_::_ )  that matches 2 or more elements plus a tail – then it is returned.  I use 2 here and not 3 because the tile under question is not included in the match, which is why it is added afterwards to the results.  Finally, the lists are flattened out into one big list of results using List.collect id

But wait! I've forgotten about those damn flaming skulls.. this bit is a little tricky.  Given the matches returned, I need to find any flaming skulls, and add all their surrounding tiles to the results list – and if any of those surrounding tiles are also flaming skulls, the process has to be repeated recursively.  

// get all 3+ of a kind matches from a given point, 
// including any chained flaming skulls along the path 
let getMatches (board:Tile[,]) row col = 
    let rec processFlamingSkull row col =        
        getSurroundingTiles board row col 
        |> List.partition(function (Skull(true),_,_) -> true | _ -> false) 
        |> function 
            | [], toRemove -> toRemove 
            | skulls, toRemove -> 
                |> (_,row,col) -> processFlamingSkull row col |> List.filter(fun t -> List.exists ((=)t) toRemove)) 
                |> List.collect id 
                |> List.append toRemove 
    match board.[row,col] with 
    | Blank -> [] 
    // for skulls, I want to match both types regardless of this type    
    | (Skull(_)) -> 
        let results = (function Skull(_) -> true | _ -> false) |> getBasicMatches board row col 
        // collect up any chained flaming skull tiles and append to original results 
        |> List.choose(function (Skull(true),row,col) -> Some(processFlamingSkull row col) | _ -> None ) 
        |> List.collect id 
        |> List.append results 
    // all other tiles are a straight match 
    | other ->  (=) other |> getBasicMatches board row col

More head exploders in here :) (pun fully intended.)  In processFlamingSkull, after getting a skull’s surrounding tiles, I use List.partition to split off any of them that are flaming skulls.  If there are none,  I just return the rest of the tiles.  If there are some, the list is mapped over recursively using the same function, after first removing any skulls already encountered – otherwise I would get caught in infinite recursion. The results are collected up and finally appended to the other tiles to be destroyed.  This function then returns one single big list that contains all tiles destroyed by chained flaming skulls.

PHEW!  There’s still a lot left though, first of which is the “gravity” effect after removing tiles.  This is actually fairly complicated depending on how you choose to do it.  It is essentially like “defragging” an array, and there might be several blocks of empty tiles to deal with in any column.  I figured that the easiest way to do this would be as follows:

For a column that had tiles removed

  1. Create a list of tiles from the bottom up, skipping out any blanks
  2. Blank the entire column
  3. Place tiles back in the order from the list
// performs "gravity" effect on a column, and returns 
// affected tiles 
let defragColumn (board:Tile[,]) col = 
    let (blankTiles,activeTiles) = [for r in 7 .. -1 .. 0 -> r,board.[r,col]] 
                                   |> List.partition(function (_,Blank) -> true | _ -> false) 
    for r = 0 to 7 do board.[r,col] <- Blank 
    activeTiles |> List.iteri(fun r (_,t) -> board.[7-r,col] <- t) 
    blankTiles  |> List.choose(fun (r,t) -> if board.[r,col] <> Blank then Some r else None)

I realised that once all columns had been “defragged” that all the affected tiles on the board would now need to go through the whole match cycle again, at the same time, to process any chain-matching caused from the tiles dropping down.  However, I don’t want to process the whole board (although that would be fine, as it is tiny).  Instead I’d like to be clever about it and only process tiles that could possibly be affected.  As far as I can tell, this is any tile that was blanked out and now had something else fall into it – so this is why the function above also returns a list of tiles that were empty before the gravity kicked in and are no longer empty.

So, the last piece of the puzzle (pun fully intended) before I can build something to solve the problem, is the core algorithm that uses all the above stuff to fully process a given amount of tiles that have been mutated, all at once.

// process a step - remove tiles and move ones above down 
let rec processStep board tilesToProcess  = 
    // get all matches from all affected tiles 
    let matches = 
        |> (fun (row,col) -> getMatches board row col) 
        |> List.collect id 
        |> Set.ofList

    if matches.Count = 0 then board else 
    // remove the tiles 
    matches |> Set.iter( fun (_,row,col) -> board.[row,col] <- Blank)

    // "defrag" / apply gravity 
    let affectedTiles = 
        // get distinct column list from matches 
        |> (_,_,col) -> col) 
        |> Set.toList 
        // defrag and collect results 
        |> col -> defragColumn board col |> row -> (row,col)))     
        |> List.collect id      
        // remove dupes 
        |> Set.ofList 
        |> Set.toList

    // recursively process all affected tiles in one pass 
    processStep board affectedTiles


This is it! This function takes in any amount of tile locations with which to process.  It then finds all 3+ matches and chained exploding skull tiles.  All the matches are then removed.  Then, for each distinct column involved in the matches, the “defrag / gravity” process is called, which returns all further tiles that have subsequently been affected – these then have any duplicates removed, and the whole process is called recursively until no new matches are found.

let makeMove (board:Tile[,]) row col dir = 
    // swap tiles 
    let tile = board.[row,col]

    match getNeighbour board row col dir with 
    | Some(otherTile,otherRow,otherCol) -> 
        board.[otherRow,otherCol] <-tile 
        board.[row,col] <- otherTile 
        (processStep board [row,col;otherRow,otherCol])

    | None -> failwith "illegal move"

This function lets me perform a move on a given board configuration, so the behaviours can be tested.  The Wight puzzle from the start of the post can be solved like so:

let a = makeMove wight 7 1 Up 
let b = makeMove a 7 6 Up 
let c = makeMove b 6 3 Left 
let d = makeMove c 6 4 Right 
let e = makeMove d 6 5 Down 
let f = makeMove e 7 3 Up 
let g = makeMove f 7 4 Up

Cool!  Effectively I have now completely emulated the puzzle quest mechanics, you could very easily use this processing code to write your own match-3 game :)

Next up is how to actually find solutions to a given puzzle.  This challenge is equally fraught with peril.  How can you determine which moves are currently possible?  Is it possible to simply brute-force, or is the problem space too big?  Will I run into tail-call issues?  Will it be super-slow, and if so can it be improved with various optimisation techniques?

Stay tuned for the next part to find out!