sbv-5.14: SMT Based Verification: Symbolic Haskell theorem prover using SMT solving.

Copyright | (c) Levent Erkok
License | BSD3
Maintainer | erkokl@gmail.com
Stability | experimental
Safe Haskell | None
Language | Haskell2010

Data.SBV.Examples.Puzzles.U2Bridge

Contents

- Modeling the puzzle
- Actions
- Recognizing valid solutions
- Solving the puzzle

Description

The famous U2 bridge crossing puzzle: http://www.braingle.com/brainteasers/515/u2.html

Synopsis

- data U2Member
  - = Bono
  - | Edge
  - | Adam
  - | Larry
- type SU2Member = SBV U2Member
- bono :: SU2Member
- edge :: SU2Member
- adam :: SU2Member
- larry :: SU2Member
- type Time = Word32
- type STime = SBV Time
- crossTime :: U2Member -> Time
- sCrossTime :: SU2Member -> STime
- data Location
  - = Here
  - | There
- type SLocation = SBV Location
- here :: SLocation
- there :: SLocation
- data Status = Status {
  - time :: STime
  - flash :: SLocation
  - lBono :: SLocation
  - lEdge :: SLocation
  - lAdam :: SLocation
  - lLarry :: SLocation
  }
- start :: Status
- type Move a = State Status a
- peek :: (Status -> a) -> Move a
- whereIs :: SU2Member -> Move SLocation
- xferFlash :: Move ()
- xferPerson :: SU2Member -> Move ()
- bumpTime1 :: SU2Member -> Move ()
- bumpTime2 :: SU2Member -> SU2Member -> Move ()
- whenS :: SBool -> Move () -> Move ()
- move1 :: SU2Member -> Move ()
- move2 :: SU2Member -> SU2Member -> Move ()
- type Actions = [(SBool, SU2Member, SU2Member)]
- run :: Actions -> Move [Status]
- isValid :: Actions -> SBool
- solveN :: Int -> IO Bool
- solveU2 :: IO ()

# Modeling the puzzle

data U2Member Source #

U2 band members. We want to translate this to SMT-Lib as a data-type, and hence the deriving mechanism.

Constructors

Bono |
Edge |
Adam |
Larry |

Instances

Eq U2Member Source # |
Methods (==) :: U2Member -> U2Member -> Bool # (/=) :: U2Member -> U2Member -> Bool #
Data U2Member Source # |

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> U2Member -> c U2Member #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c U2Member #

toConstr :: U2Member -> Constr #

dataTypeOf :: U2Member -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c U2Member) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c U2Member) #

gmapT :: (forall b. Data b => b -> b) -> U2Member -> U2Member #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> U2Member -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> U2Member -> r #

gmapQ :: (forall d. Data d => d -> u) -> U2Member -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> U2Member -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> U2Member -> m U2Member #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> U2Member -> m U2Member #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> U2Member -> m U2Member #

Ord U2Member Source # |
Methods compare :: U2Member -> U2Member -> Ordering # (<) :: U2Member -> U2Member -> Bool # (<=) :: U2Member -> U2Member -> Bool # (>) :: U2Member -> U2Member -> Bool # (>=) :: U2Member -> U2Member -> Bool # max :: U2Member -> U2Member -> U2Member # min :: U2Member -> U2Member -> U2Member #
Read U2Member Source # |
Methods readsPrec :: Int -> ReadS U2Member # readList :: ReadS [U2Member] # readPrec :: ReadPrec U2Member # readListPrec :: ReadPrec [U2Member] #
Show U2Member Source # |
Methods showsPrec :: Int -> U2Member -> ShowS # show :: U2Member -> String # showList :: [U2Member] -> ShowS #
HasKind U2Member Source # |

Methods

kindOf :: U2Member -> Kind Source #

hasSign :: U2Member -> Bool Source #

intSizeOf :: U2Member -> Int Source #

isBoolean :: U2Member -> Bool Source #

isBounded :: U2Member -> Bool Source #

isReal :: U2Member -> Bool Source #

isFloat :: U2Member -> Bool Source #

isDouble :: U2Member -> Bool Source #

isInteger :: U2Member -> Bool Source #

isUninterpreted :: U2Member -> Bool Source #

showType :: U2Member -> String Source #

SymWord U2Member Source # |

Methods

forall :: String -> Symbolic (SBV U2Member) Source #

forall_ :: Symbolic (SBV U2Member) Source #

mkForallVars :: Int -> Symbolic [SBV U2Member] Source #

exists :: String -> Symbolic (SBV U2Member) Source #

exists_ :: Symbolic (SBV U2Member) Source #

mkExistVars :: Int -> Symbolic [SBV U2Member] Source #

free :: String -> Symbolic (SBV U2Member) Source #

free_ :: Symbolic (SBV U2Member) Source #

mkFreeVars :: Int -> Symbolic [SBV U2Member] Source #

symbolic :: String -> Symbolic (SBV U2Member) Source #

symbolics :: [String] -> Symbolic [SBV U2Member] Source #

literal :: U2Member -> SBV U2Member Source #

unliteral :: SBV U2Member -> Maybe U2Member Source #

fromCW :: CW -> U2Member Source #

isConcrete :: SBV U2Member -> Bool Source #

isSymbolic :: SBV U2Member -> Bool Source #

isConcretely :: SBV U2Member -> (U2Member -> Bool) -> Bool Source #

mkSymWord :: Maybe Quantifier -> Maybe String -> Symbolic (SBV U2Member) Source #

SatModel U2Member Source # |
Methods parseCWs :: [CW] -> Maybe (U2Member, [CW]) Source # cvtModel :: (U2Member -> Maybe b) -> Maybe (U2Member, [CW]) -> Maybe (b, [CW]) Source #

type SU2Member = SBV U2Member Source #

Symbolic shorthand for a `U2Member`

bono :: SU2Member Source #

Shorthands for symbolic versions of the members

edge :: SU2Member Source #

Shorthands for symbolic versions of the members

adam :: SU2Member Source #

Shorthands for symbolic versions of the members

larry :: SU2Member Source #

Shorthands for symbolic versions of the members

type Time = Word32 Source #

Model time using 32 bits

type STime = SBV Time Source #

Symbolic variant for time

crossTime :: U2Member -> Time Source #

Crossing times for each member of the band

sCrossTime :: SU2Member -> STime Source #

The symbolic variant.. The duplication is unfortunate.

data Location Source #

Location of the flash

Constructors

Here |
There |

Instances

Eq Location Source # |
Methods (==) :: Location -> Location -> Bool # (/=) :: Location -> Location -> Bool #
Data Location Source # |

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Location -> c Location #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Location #

toConstr :: Location -> Constr #

dataTypeOf :: Location -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Location) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Location) #

gmapT :: (forall b. Data b => b -> b) -> Location -> Location #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Location -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Location -> r #

gmapQ :: (forall d. Data d => d -> u) -> Location -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Location -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Location -> m Location #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Location -> m Location #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Location -> m Location #

Ord Location Source # |
Methods compare :: Location -> Location -> Ordering # (<) :: Location -> Location -> Bool # (<=) :: Location -> Location -> Bool # (>) :: Location -> Location -> Bool # (>=) :: Location -> Location -> Bool # max :: Location -> Location -> Location # min :: Location -> Location -> Location #
Read Location Source # |
Methods readsPrec :: Int -> ReadS Location # readList :: ReadS [Location] # readPrec :: ReadPrec Location # readListPrec :: ReadPrec [Location] #
Show Location Source # |
Methods showsPrec :: Int -> Location -> ShowS # show :: Location -> String # showList :: [Location] -> ShowS #
HasKind Location Source # |

Methods

kindOf :: Location -> Kind Source #

hasSign :: Location -> Bool Source #

intSizeOf :: Location -> Int Source #

isBoolean :: Location -> Bool Source #

isBounded :: Location -> Bool Source #

isReal :: Location -> Bool Source #

isFloat :: Location -> Bool Source #

isDouble :: Location -> Bool Source #

isInteger :: Location -> Bool Source #

isUninterpreted :: Location -> Bool Source #

showType :: Location -> String Source #

SymWord Location Source # |

Methods

forall :: String -> Symbolic (SBV Location) Source #

forall_ :: Symbolic (SBV Location) Source #

mkForallVars :: Int -> Symbolic [SBV Location] Source #

exists :: String -> Symbolic (SBV Location) Source #

exists_ :: Symbolic (SBV Location) Source #

mkExistVars :: Int -> Symbolic [SBV Location] Source #

free :: String -> Symbolic (SBV Location) Source #

free_ :: Symbolic (SBV Location) Source #

mkFreeVars :: Int -> Symbolic [SBV Location] Source #

symbolic :: String -> Symbolic (SBV Location) Source #

symbolics :: [String] -> Symbolic [SBV Location] Source #

literal :: Location -> SBV Location Source #

unliteral :: SBV Location -> Maybe Location Source #

fromCW :: CW -> Location Source #

isConcrete :: SBV Location -> Bool Source #

isSymbolic :: SBV Location -> Bool Source #

isConcretely :: SBV Location -> (Location -> Bool) -> Bool Source #

mkSymWord :: Maybe Quantifier -> Maybe String -> Symbolic (SBV Location) Source #

SatModel Location Source # |
Methods parseCWs :: [CW] -> Maybe (Location, [CW]) Source # cvtModel :: (Location -> Maybe b) -> Maybe (Location, [CW]) -> Maybe (b, [CW]) Source #

type SLocation = SBV Location Source #

Symbolic variant of `Location`

here :: SLocation Source #

Shorthands for symbolic versions of locations

there :: SLocation Source #

Shorthands for symbolic versions of locations

data Status Source #

The status of the puzzle after each move

This type is equipped with an automatically derived `Mergeable` instance because each field is `Mergeable`. A `Generic` instance must also be derived for this to work, and the `DeriveAnyClass` language extension must be enabled. The derived `Mergeable` instance simply walks down the structure field by field and merges each one. An equivalent hand-written `Mergeable` instance is provided in a comment below.

Constructors

Status |

Fields

- time :: STime

  elapsed time

- flash :: SLocation

  location of the flash

- lBono :: SLocation

  location of Bono

- lEdge :: SLocation

  location of Edge

- lAdam :: SLocation

  location of Adam

- lLarry :: SLocation

  location of Larry

Instances

Generic Status Source # |
Associated Types type Rep Status :: * -> * # Methods from :: Status -> Rep Status x # to :: Rep Status x -> Status #
Mergeable Status Source # |
Methods symbolicMerge :: Bool -> SBool -> Status -> Status -> Status Source # select :: (SymWord b, Num b) => [Status] -> Status -> SBV b -> Status Source #
Mergeable a => Mergeable (Move a) Source # | Mergeable instance for `Move` simply pushes the merging the data after run of each branch starting from the same state.
Methods symbolicMerge :: Bool -> SBool -> Move a -> Move a -> Move a Source # select :: (SymWord b, Num b) => [Move a] -> Move a -> SBV b -> Move a Source #
type Rep Status Source # |

type Rep Status = D1 (MetaData "Status" "Data.SBV.Examples.Puzzles.U2Bridge" "sbv-5.14-J8DYRkzlBsXA5yWbKEMnUd" False) (C1 (MetaCons "Status" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "time") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 STime)) ((:*:) (S1 (MetaSel (Just Symbol "flash") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 SLocation)) (S1 (MetaSel (Just Symbol "lBono") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 SLocation)))) ((:*:) (S1 (MetaSel (Just Symbol "lEdge") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 SLocation)) ((:*:) (S1 (MetaSel (Just Symbol "lAdam") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 SLocation)) (S1 (MetaSel (Just Symbol "lLarry") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 SLocation))))))

start :: Status Source #

Start configuration, time elapsed is 0 and everybody is `here`

type Move a = State Status a Source #

A puzzle move is modeled as a state-transformer

peek :: (Status -> a) -> Move a Source #

Read the state via an accessor function

whereIs :: SU2Member -> Move SLocation Source #

Given an arbitrary member, return his location

xferFlash :: Move () Source #

Transferring the flash to the other side

xferPerson :: SU2Member -> Move () Source #

Transferring a person to the other side

bumpTime1 :: SU2Member -> Move () Source #

Increment the time, when only one person crosses

bumpTime2 :: SU2Member -> SU2Member -> Move () Source #

Increment the time, when two people cross together

whenS :: SBool -> Move () -> Move () Source #

Symbolic version of `when`

move1 :: SU2Member -> Move () Source #

Move one member, remembering to take the flash

move2 :: SU2Member -> SU2Member -> Move () Source #

Move two members, again with the flash

# Actions

type Actions = [(SBool, SU2Member, SU2Member)] Source #

A move action is a sequence of triples. The first component is symbolically True if only one member crosses. (In this case the third element of the triple is irrelevant.) If the first component is (symbolically) False, then both members move together

run :: Actions -> Move [Status] Source #

Run a sequence of given actions.

# Recognizing valid solutions

isValid :: Actions -> SBool Source #

Check if a given sequence of actions is valid, i.e., they must all cross the bridge according to the rules and in less than 17 seconds

# Solving the puzzle

solveN :: Int -> IO Bool Source #

See if there is a solution that has precisely `n` steps

solveU2 :: IO () Source #

Solve the U2-bridge crossing puzzle, starting by testing solutions with increasing number of steps, until we find one. We have:

    >>> solveU2
    Checking for solutions with 1 move.
    Checking for solutions with 2 moves.
    Checking for solutions with 3 moves.
    Checking for solutions with 4 moves.
    Checking for solutions with 5 moves.
    Solution #1:
     0 --> Edge, Bono
     2 <-- Edge
     4 --> Larry, Adam
    14 <-- Bono
    15 --> Edge, Bono
    Total time: 17
    Solution #2:
     0 --> Edge, Bono
     2 <-- Bono
     3 --> Larry, Adam
    13 <-- Edge
    15 --> Edge, Bono
    Total time: 17
    Found: 2 solutions with 5 moves.

Finding all possible solutions to the puzzle.