Phone

tl;dr: anybody want to add me on Line or tell/remind me about other phone chat apps? betaveros as always.

Wow, talk about uninspired post titles.

I got a new phone today. Or, well, it’s second-hand, actually. I try to make electronics last a long time, but I think this was justified given the state of my last phone’s screen:

Besides, I’m going off to college and all. Anyway, the phone is pretty cool. It’s a slick shade of red, it came with a cover and everything, and it has one of those fancy 3x3-grid locks. How secure are those again?

Well, we could just find the answer on StackOverflow, but that’s boring.

*ahem* Here we go, Literate Haskell. Plumbing:

> import Control.Applicative
> import Control.Arrow
> import Control.Monad
> import Control.Monad.Trans
> import Control.Monad.Trans.State
> import Text.Printf

I use the below function alarmingly often. In fact I was planning to blog about it and its application to various math puzzles that crop up, as well as how it fits perfectly into StateT [a] []. But then I realized I didn’t have the motivation to do so because I don’t think I have any readers who would understand. Instead, because this is part of a filler post, I can just focus on its usage here. Whew! What it does is, it considers all the ways to pick one element from the list, and gives you each element together with the list without that element. This is useful to emulate how the dots in our 3x3 lock can’t be reused.

> spliceOne :: [a] -> [(a, [a])]
> spliceOne [] = []
> spliceOne (x:xs) = (x, xs) : map (second (x:)) (spliceOne xs)

We need to decide on a representation for the dots. We’ll just use pairs of Ints, coordinates of the dots. Yay.

> type Dot = (Int, Int)

Next, we need a way to test if two certain dots are allowed to be adjacent in our path. How the lock works is, if you try to connect two dots whose midpoint is another dot, it will automatically include the midpoint if you haven’t yet. In effect, you’re banned from connecting two dots if a dot exists at their midpoint and hasn’t yet been used. So we’ll need to see whether there’s a dot at the midpoint of two given dots.

> avg :: Int -> Int -> Maybe Int
> avg a b = case (a + b) `quotRem` 2 of
>     (m, 0) -> Just m
>     _ -> Nothing
>
> midpoint :: Dot -> Dot -> Maybe Dot
> midpoint (r, c) (r', c') = liftA2 (,) (avg r r') (avg c c')

With these functions, we can decide whether two dots can be adjacent in our chosen path, or equivalently whether it’s valid to choose one dot based on the previously chosen dot, if we are also given the list of available dots that still haven’t been chosen. (I kind of want to call the variable rem or remain or remaining, but the first shadows Haskell’s built-in remainder function, the second sounds like the wrong part of speech, and the third is too long for me. Oh well. (Although “avail” is a verb too, so that’s a silly justification.)) You might be wondering why this function takes that list instead of the list of used dots; we could write it either way, but this is much easier and requires simpler state to fit into our monads later.

> type LegalityPredicate = [Dot] -> Dot -> Dot -> Bool
> isLegal :: LegalityPredicate
> isLegal avail a b = maybe True (`notElem` avail) $ midpoint a b

Now, onto the process of modeling the actual process of picking dots. Here come the monad transformers! Our core is the list monad for simulating forking universes or nondeterministic choice, onto which we slap a StateT transformer to record the state of our lock — our previously selected dot (in a Maybe since there is no previously selected dot for our first choice) and the list of which dots we still haven’t chosen yet — which is all the information we need to test for legality. If you didn’t understand that sentence, it’s okay. Congratulations on reading this far. You have permission to bother me to explain this to you privately or in another blog post.

> type LockState = (Maybe Dot, [Dot])
> initState :: LockState
> initState = (Nothing, liftA2 (,) [1..3] [1..3])
>
> pickNext :: LegalityPredicate -> StateT (Maybe Dot, [Dot]) [] Dot
> pickNext lp = do
>     (prev, avail) <- get
>     (next, avail') <- lift $ spliceOne avail
>     forM_ prev $ guard . lp avail next
>     put (Just next, avail')
>     return next
>
> countPaths :: LegalityPredicate -> Int -> Int
> countPaths lp len = length $
>     evalStateT (replicateM len (pickNext lp)) initState

Our solution is sum $ map (countPaths isLegal) [4..9]. 389112 ways. It’s harder to brute-force than a four-digit PIN, at least.

But now that we’ve got this far, it seems a pity to give up now, especially given the flexibility we’ve baked into our functions. What if we look at paths that only move between adjacent dots, including diagonally adjacent dots? Here’s the predicate:

> isAdjacent :: Dot -> Dot -> Bool
> isAdjacent (r, c) (r', c') = all ((<= 1) . abs) [r - r', c - c']

This isn’t a LegalityPredicate, but it’s a const away. sum $ map (countPaths (const isAdjacent)) [4..9] gives us 10096 ways. Somewhat surprisingly, still a hair’s breadth harder to brute-force than a four-digit PIN.

We can also easily write, for example, a predicate to look at paths only moving between orthogonally adjacent dots. Once we do this we see there are only 576 such paths. Security is pretty low here.

> isOrthogonallyAdjacent :: Dot -> Dot -> Bool
> isOrthogonallyAdjacent (r, c) (r', c') =
>     sum (map abs [r - r', c - c']) <= 1

Here’s a report and main function to print everything in nice tabular form.

> report :: String -> LegalityPredicate -> IO ()
> report title lp = do
>     putStrLn title
>     putStrLn $ replicate 13 '='
>     let cs = map (id &&& countPaths lp) [4..9]
>     putStrLn "Len |  Paths"
>     forM_ cs . uncurry $ printf "%3d | %6d\n"
>     printf "Total %6d\n" . sum $ map snd cs
>     putStrLn ""
>
> main :: IO ()
> main = do
>     report "Legal" isLegal
>     report "Adjacent" $ const isAdjacent
>     report "Orthogonally Adjacent" $ const isOrthogonallyAdjacent

And the output:

Legal
=============
Len |  Paths
  4 |   1624
  5 |   7152
  6 |  26016
  7 |  72912
  8 | 140704
  9 | 140704
Total 389112

Adjacent
=============
Len |  Paths
  4 |    496
  5 |   1208
  6 |   2240
  7 |   2984
  8 |   2384
  9 |    784
Total  10096

Orthogonally Adjacent
=============
Len |  Paths
  4 |     80
  5 |    104
  6 |    128
  7 |    112
  8 |    112
  9 |     40
Total    576

Of course, there are still interesting classes of paths that our LegalityPredicate can’t handle: for example, paths that don’t self-intersect in the plane. Writing a program that can handle counting the number of such paths, or possibly other interesting classes, is left as an exercise to the reader.

*ahem* Um, where were we?

Oh. Right. New phone. Darn. I nerd-sniped myself. What else did I want to say? It’s really convenient to own a smartphone, but some people are worried that smartphone overuse is making my generation antisocial and unhealthy — the Chinese term is 低頭族 — and although I know some excellent snarky comebacks…

…I have to agree somewhat. But I myself already tend to be antisocial when my laptop is available, and this probably won’t be much worsened with my smartphone because it doesn’t have Vim or an interactive Haskell prompt. Instead I’ll just be an optimist, refrain from installing any addictive games on my smartphone, and hope that I get more social connectivity out of it instead.

We’ll see. I’m new to the smartphone chat scene; I put myself on Line right away because my mom wants to chat with me through it. If you want to, add me and/or tell me about other chat apps I should be on.

Signing off for the streak. Bye.

P.S. If you don’t like code, here’s the other picture I took on my phone so far. No, there’s no special reason.