Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
Generate a random 3x3 unlock pattern for Android devices
File: Lockpattern.hs
This programm calculates a pattern for the 3x3 lock screen in Android
devices. It outputs the path in form of a matrix with numbered
finger positions.
import System.Random
import Data.Maybe
import Data.List
main :: IO()
main = do
seed <- getStdGen
let allpoints = [(x,y) | x<-[1..3],y<-[1..3]]
let lockpattern = swipe seed [] Nothing allpoints -- do the magic
let numberedpoints = zip [1..9] lockpattern
drawPattern $ map fst $ sortBy outputOrder numberedpoints
-- swipes one line at a time until everything was visited
-- check if we pass via points and remove them too, if needed
swipe :: StdGen -> [(Int,Int)] -> Maybe (Int,Int) -> [(Int,Int)] -> [(Int,Int)]
swipe seed lastpattern lastp unvisitedp =
if unvisitedp==[]
then lastpattern
else swipe seed (lastpattern ++ via ++ [(x,y)]) (Just (x,y)) unvisitedp'
via = case viap of
Nothing -> []
Just p -> [p]
(x,y) = pickRand unvisitedp seed
unvisitedpn = filterOut unvisitedp (x,y)
(viap,unvisitedp') = searchCrossings lastp unvisitedpn (x,y)
-- removes one point element
filterOut :: [(Int,Int)] -> (Int,Int) -> [(Int,Int)]
filterOut arr (x,y) = filter (/=(x,y)) arr
-- picks one random point from the available in arr
pickRand :: [(Int,Int)] -> StdGen -> (Int,Int)
pickRand arr seed = arr !! (fst $ randomR (0,length arr-1) seed)
-- search for via points, return and remove them if found
searchCrossings :: Maybe (Int,Int) -> [(Int,Int)] -> (Int,Int) -> (Maybe (Int,Int),[(Int,Int)])
searchCrossings mlastp unvisitedp nextp = case mlastp of
Just lastp -> checkCrossing lastp unvisitedp nextp
Nothing -> (Nothing,unvisitedp)
-- returns the via point and remaining array, if passed across
checkCrossing :: (Int,Int) -> [(Int,Int)] -> (Int,Int) -> (Maybe (Int,Int),[(Int,Int)])
checkCrossing (x',y') unvisitedp (x,y) =
let viap = if not (dx==1 || dy==1)
then find ((==) (if dx==2 then 2 else x,if dy==2 then 2 else y)) unvisitedp
else Nothing
where (dx,dy) = (abs $ x-x',abs $ y-y')
in case viap of
Nothing -> (Nothing,unvisitedp)
Just p -> (Just p,filterOut unvisitedp p)
-- sort order
outputOrder :: (Int,(Int,Int)) -> (Int,(Int,Int)) -> Ordering
outputOrder (_,(a,b)) (_,(c,d)) = if b/=d then compare b d else compare a c
-- outputs a human-readable pattern
drawPattern :: [Int] -> IO()
drawPattern point = do
putStr $ concat $ map (\(x,y) -> if ((y `mod` 3)==2)
then show x ++ "\n\n"
else show x ++ " ") $ zip point [0..]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment