What I did on my winter vacation, or "ro ,noitacav retniw ym no did I tahW"

Poking through some of my old delicious links, I found a post about finding palindromes in O(n) time that I'd always meant to come back to, but never did.

So I played around with it during my vacation to Virginia Beach with my family this year.

It took me a while to grok the algorithm in full, but once I did, I realized that it could be adapted to operate on list input (rather than array input) and produce results lazily. This has the benefit of being able to do stuff like take 100 . maximalPalindromeLengths $ repeat (), but I haven't thought of any practical benefit yet, since it still requires O(n) memory, so it's not appropriate for streaming data.

Here's my variation, though it's in a real repos if you want to play around with it:

	module Palindrome where
	-- an adaptation of Johan Jeuring's algorithm for finding maximal palindrome lengths
	-- (http://johanjeuring.blogspot.com/2007/08/finding-palindromes.html)
	import Control.Arrow ((***))
	-- find the maximal lengths of the palindromes
	-- centered before, on, and after each element in the list
	maximalPalindromeLengths :: Eq a => [a] -> [Int]
	maximalPalindromeLengths as = grow 0 [] as as []
	where -- grow n lz rz as log
	-- n - confirmed length of palindrome centered at the current position
	-- lz rz - zipper for elements at the start of the palindrome
	-- as - elements after the palindrome
	-- log - reversed list of maximal palindrome lengths found so far
	--
	-- The log is kept to exploit the mirror property of palindromes:
	-- any item contained in a palindrome that occurs to the left of the
	-- center reoccurs in the mirror position to the right of the center.
	--
	-- This is also true for any other palindrome whose center overlaps
	-- the first palindrome - they have a matching palindrome that mirrors
	-- them on the other side of the first's center (though the palindrome
	-- may be extended or truncated if it is not wholey contained in the
	-- first).
	grow :: Eq a => Int -> [a] -> [a] -> [a] -> [Int] -> [Int]
	-- if the items bordering the palindrome match,
	-- extend the palindrome to include those items and continue
	grow n (a':lz) rz (a:as) log | (a' == a) = grow (n+2) lz (a':rz) as log
	-- if we've reached the end of the list
	-- replay as much as the log as possible, trimming
	-- lengths that would run over
	grow n lz rz [] log = n : zipWith min log [n-1,n-2..0]
	-- if we can't expand an empty palindrome,
	-- try growing the next non-empty palindrome
	grow 0 lz rz as log = 0 : grow 1 lz rz (tail as) (0:log)
	-- if we can't expand a non-empty palindrome,
	-- any preceeding palindromes that are wholey contained within
	-- this one are repeated (in reverse order) on the other side of the center
	-- while the boarding one is the kernel for the next to grow
	grow n lz rz as log = n :
	let (replay, n') = (map fst *** (uncurry min . head)) .
	break (uncurry (>=)) $
	zip log [n-1,n-2..0]
	(xs,ys) = splitAt (n - n') rz
	in replay ++ grow n' (reverse xs ++ lz) ys as (reverse replay ++ n : log)

view raw Palindrome.hs hosted with ❤ by GitHub

Thrill Digger and expected value

I got my copy of Skyward Sword last week, and so far, I've been having a blast. Recently, though, I was running Link up a volcano, on his way to find Zelda, and I got sidetracked by a mini-game called Thrill Digger.

Fortunately, I could take my time, and play around with it without worrying about Zelda too much.

So Thrill Digger is a gambling game. You pay a fee to play, then get to choose points on a grid - some grid points contain money, some contain bombs. You get to keep choosing points until you find a bomb, and which point the game ends. You get to keep all the money you find.

Money in Hyrule comes in a few denominations:

• Green Rupees are worth 1
• Blue Rupees are worth 5
• Red Rupees are worth 20
• Silver Rupees are worth 100
• Gold Rupees are worth 300
• Black Rupees (aka Rupoors) are worth -10

There are three levels of play:

The Beginner difficulty costs 30 Rupees to play, and consists of twenty spaces in a 5x4 grid. Of these spots, four are bombs. The grid is guaranteed to hold a number of both Green and Blue Rupees, with a small chance of a Red Rupee.

The Intermediate difficulty costs 50 Rupees to play, and consists of thirty spots in a 6x5 grid. Of these spots, four are Rupoors and four are bombs. The grid contains mostly Blue and Red Rupees, while Green and Silver Rupees are fairly rare.

The Expert difficulty costs 70 Rupees to play, and consists of forty spots in an 8x5 grid. Of these spots, eight are Rupoors and eight are bombs. Most spots contain Red Rupees, and occasional sightings of Blue, Silver, and Gold Rupees have been observed.

Now here's where the game gets interesting.

The type of Rupee in a dig spot identifies how many Bombs and Rupoors are in the eight spots around it, as follows:

• Green Rupee: 0 spots
• Blue Rupee: 1-2 spots
• Red Rupee: 3-4 spots
• Silver Rupee: 5-6 spots
• Gold Rupee: 7-8 spots

This makes it quite hard to determine exactly how many spots are covered. Link can uncover all spots around Green Rupees without harm, while it's probably a very good idea to avoid all spots around a Gold Rupee.

Rupoors identify as a bomb for the purposes of which type of Rupees surround it, and will subtract 10 Rupees from Link's current total, but do not end the game

This makes the game somewhat like an imprecise version of Minesweeper (with a bit of Memory for flavor, since what grid spots used to contain before you dug there is not displayed).

In Minesweeper, however, the goal is to discover the mine locations. There's no cost to starting a new game, and no extrinsic value to revealing that a square does not contain a bomb.

By placing an upfront cost on playing, and shifting the goal from "discovering the mine locations" to "find as much money as possible", this changes the nature of the game. We want to get close to bombs and rupoors (so as to find high-denomination currency), but avoid them.

With this explicit cost/reward structure, we could calculate the expected value of a game of Thrill Digger. Even more, we could construct a Thrill Digger assistant, which, given the current game state, could advise us on the most advantageous location to dig next.

Sound like fun? I know it does to me :) So look for something in this space about my Thrill Digger assistant in the future.

Calculating the sum of digits without division

So I was looking at the ant puzzle (thanks reddit), and I really hated the way they calculated the sum of the digits.

In Haskell:

sumOfDigits 0 = 0
sumOfDigits n | n < 0     = sumOfDigits (abs n)
              | otherwise = r + sumOfDigits q
  where (q,r) = n `quotRem` 10

It just seemed inelegant - there must be a way to find the sum of the digits without using division and modulus. Especially since
I'll be doing it over and over, for a bunch of sequential numbers.

Consider two sequential numbers.

• Most of the time the difference in the sum of their digits is just one.
• Except when we move from x9 to (x+1)0, then the difference is 8
• Except when we move from x99 to (x+1)00, then the difference is 17
• ...
• Except when we move from x999..9 to (x+1)000..0, then the differce is 9t-1

So in general, the difference between the sum of digits between x and x+1 is 1, minus 9 every tenth,
minus another 9 every hundredth, etc.

This sounds like something I can just calculate:

... zipWith subtract (every 1000 9) . zipWith subtract (every 100 9) . zipWith (every 10 9) $ repeat 1
  where every n k = replicate (n-1) 0 ++ (k : every n k)

Except I've got an infinite number of zipWiths to go through before I get to my most common case. Maybe what I need to do is invert it - start with the most common case on the outside, and have my less common cases inside.

At this point, note that we if we take the list of differences, subtract nine from each, and then put nine ones between each, we get the list of differences back:

listOfDiffs :: [Int]
listOfDiffs = concat $ nineOnes : map (\a -> (a - 9) : nineOnes) listOfDiffs
  where nineOnes = replicate 9 1

This seems like something I can generalize:

spread :: (a -> a) -> [a] -> [a]
spread f as = as'
  where as' = concat $ as : map (\a -> f a : as) as'

listOfDiffs :: [Int]
listOfDiffs = spread (subtract 9) (replicate 9 1)

Giving a simple way to enumerate all the sums of digits for all the numbers:

sumOfDigits :: [Int]
sumOfDigits = scanl (+) 0 listOfDiffs

Ponder this... in Haskell

So, I got a solution accepted for IBM's Ponder This... puzzle from August despite only finding two of the three solutions. Here's what I sent them (see if you can spot my error):

Here's my solution in the form of a literate haskell program. I fully understand if it is found insufficiently elegant (for the tl;dr version - I found two possible triangles, (4,4,4) and (4,4,6)).

module TrianglePuzzle where
import Control.Monad (guard, MonadPlus)

Initially, Charlie only knows the perimeter.

charlie0 :: (Integral e) => Perimeter e -> [Triangle e]
charlie0 = havingPerimeter

And Ariella only knows the area

ariella0 :: (Integral e) => Squarea e -> [Triangle e]
ariella0 = havingSquarea

After Ariella’s confession that she can’t solve the puzzle, Charlie knows that it can’t be any of the triangles that have unique area.

charlie1 :: (Integral e) => Perimeter e -> [Triangle e]
charlie1 = filter (not . unique . ariella0 . squarea) . charlie0

After Charlie announced that he’s solved it, Ariella knows that one of her possible triangles must be a unique solution for Charlie, given its perimeter and her confession.

ariella1 :: (Integral e) => Squarea e -> [Triangle e]
ariella1 = filter (identically $ charlie1 . perimeter) . ariella0
  where identically f a = f a == [ a ]

So which triangles satisfy all these conditions? It suffices to check that Ariella can solve the puzzle uniquely, since her solution includes a check that Charlie can as well.

solutions :: (Integral e) => [Triangle e]
solutions = concat . filter unique $ map (ariella1 . MkSquarea) [ 3.. ]

Now, optimally, I’d have a closed form solution, rather than an exhaustive infinite search, but until then, I know that it’s possible that

• either the triangle (4,4,4) (so Charlie was given 12 and Ariella was given 4√3)
• or the triangle (4,4,6) (so Charlie was given 14 and Ariella was given 3√7)

are possible solutions.

main = print $ take 2 solutions -- prints [(4,4,4), (4,4,6)]

Appendix: How to enumerate integer-sided triangles given their perimeter or area.

Given a triangle with sides of integer length a, b, and c, s.t.

a ≤ b ≤ c
a + b > c

The formula for the perimiter of the triangle is

perimeter :: (Num e) => Triangle e -> Perimeter e
perimeter (a,b,c) = MkPerimeter $ a + b + c

Given a perimeter p, we can enumerate all the triangles of integer size with that perimeter.

havingPerimeter :: (Integral e) => Perimeter e -> [Triangle e]
havingPerimeter (MkPerimeter p) = do

The longest edge of the triangle is smallest when one of three equal edges, and largest when just less than half of the perimeter (since the other two edges’s sum must be greater).

  c <- [ p `ceilingDiv` 3 .. (p - 1) `floorDiv` 2 ]

The next longest edge must be at least half of the remaining perimeter, but no longer than the largest edge.

  b <- [ (p - c) `ceilingDiv` 2 .. c ]

The smallest edge can be calculated directly using the perimeter and the other two.

  let a = p - c - b
  return (a,b,c)

The formula for the area of the triangle (a,b,c) is

area = (1/4)√s
s = 2a²b² - c⁴ + 2a²c² - b⁴ + 2b²c² - a⁴

area :: (Floating e) => Triangle e -> e
area t = sqrt (unSquarea $ squarea t) / 4

squarea :: (Num e) => Triangle e -> Squarea e
squarea (a,b,c) = MkSquarea $ term (a*b) c + term (a*c) b + term (b*c) a
  where term x y = 2*x^2 - y^4

Given an area r, we can enumerate all the triangles that have that area.

havingArea :: (RealFrac e) => e -> [Triangle e]
havingArea r = map cast . havingSquarea . MkSquarea . round $ 16 * r^2
  where cast (a,b,c) = (fromIntegral a, fromIntegral b, fromIntegral c)

Though it may be easier to reason in terms of a multiple of the area squared, s, so we can confine ourselves to integer operations.

havingSquarea :: (Integral e) => Squarea e -> [Triangle e]
havingSquarea (MkSquarea s) = do

The smallest side is at least one, and is its largest when all three sides are equal, which tells us:

s ≥ 2a² a² - a⁴ + 2a² a² - a⁴ + 2a² a² - a⁴ = 3a⁴

  a <- takeWhile (\a -> 3*a^4 <= s) [1..]

The next largest side is at least as large as the first, but we can do better than that sometimes. If we rearrange the definition of s, we can use the quadratic formula to solve for c², yielding

c² = (a² + b²) ± √( 4a²b² - s )

Since our solutions are non imaginary, this constrains

4a²b² - s ≥ 0
4a²b² ≥ s

We can cap the size of the second edge by stating that it can only be as large as the third edge, which gives

s ≥ 2a²b² - b⁴ + 2a²b² - b⁴ + 2b²b² - a⁴ ⇒
s ≥ 4a²b² - a⁴ ⇒
s + a⁴ ≥ 4a²b²

So we can combine all three constraints to get possible values for b.

  b <- let check cmp b = cmp $ 4*a^2*b^2 in
       takeWhile (check (<= s + a^4)) $ 
       dropWhile (check (< s))          $
       [ a .. ]

Now we can just use the quadratic formula to solve for c

y <- integralSqrt (4*a^2*b^2 - s)
c2 <- let x = a^2 + b^2 in 
      if y == 0 
       then [x] 
       else [x-y, x+y]
c <- integralSqrt c2
return (a,b,c)

Now that we have these tools, we can reason through the problem.

Utilities:

Let’s use a simple type for triangles (no need to get fancy), but since confusing a perimeter value and an area value could get bad, let’s wrap those up.

type Triangle e = (e,e,e)

newtype Perimeter e = MkPerimeter { unPerimeter :: e } deriving (Show, Eq)

newtype Squarea e = MkSquarea { unSquarea :: e } deriving (Show, Eq)

It’s handy to have some easily doing basic integer operations, like div with ceiling or floor, or a way to find integral square roots.

ceilingDiv :: (Integral e) => e -> e -> e
ceilingDiv n d = (n + d - 1) `div` d


floorDiv :: (Integral e) => e -> e -> e
floorDiv = div

integralSqrt :: (MonadPlus m, Integral i) => i -> m i
integralSqrt i = do
 let x' = sqrt $ fromIntegral i
 let x = round x'
 guard $ x' == fromIntegral x
 return x

Identifying a list that contains a unique element comes up a couple times.

unique :: [a] -> Bool
unique [_] = True
unique  _  = False

Liner Notes for Rachel's Birthday Mix

1. Home by Edward Sharpe & The Magnetic Zeros
   

   I had this in a mix for you, and then heard it in a commercial while hanging out
   at my in-laws. So I figured I better lead with it, so you could listen to it
   quickly, before you started associating it with insurance, or whatever. I have
   a thing for songs that are dialogues.
   

2. This Too Shall Pass by OK Go
   

   So you've probably one of the two videos for this. I actually prefer the
   marching band one to the Rube Goldberg one, but that might just be because
   I saw the marching band one first. Plus, camoflauged brass section!
   

3. Daniel by Bat for Lashes
   

   A bit more mellow than the previous songs, but kinda hauntingly beautiful.
   

4. The Great Defector by Bell X1
   

   I keep finding these songs that remind me of the Talking Heads. Which is a good
   thing, because there is no more Talking Heads.
   

5. How Soon Is Now by smithsproject
   

   Apparently this lady (Janice Whaley) is attempting to cover every Smiths song.
   Quite the undertaking, neh?
   

6. No More Little Lion Man by Mumford & Sons
   

   There's a sound that guitars can make that's like the breaking silence that
   rushes before a storm. It bodes. And after capturing you with that, this
   just shows off some fast picking.
   

7. Flash by Queen
   

   This is the song that got me started liking Queen. Jason was giving me a ride
   somewhere, and this was playing on his stereo. I had no idea who Flash was,
   and Jason was flabbergasted.
   

8. Hard Times by John Legend & The Roots (feat. Black Thought)
   

   Kar and I went to see the Roots this fall. It was a great show - but it went
   so late that we had to leave early. Lots of fun, a little funk, and a guy
   dancing all over the stage with a tuba.
   

9. In The Midnight by Langhorne Slim
   

   I challenge you not to want to get up and dance.
   

10. Sixteen Feet - Cantina Band by Dominic Sagolla
    

    I would be abandoning my duties as a little brother if I didn't include something
    at least a little bit silly or Star Wars related.
    

11. Men Without Ties by Paul Westerberg
    

    Paul Westerberg is one of those artists I didn't really notice until recently
    (barring a duet with Joan Jett). And I figured that if I was going to include
    any of his music on here, that this one was the most apropos, coming from me.
    

12. Mongrel Heart by Broken Bells
    

    I was actually thinking about putting another song of theirs on here (The High Road),
    but I decided to go for something else off the same album, because I figured you'd
    already heard it. If not, check it out - it's a major earworm. Half of the band
    is DangerMouse, who is also half of Gnarls Barkley.
    

13. Weight of the World by Pigeon John
    

    The other day, I was looking through a used DVD store for a copy of the Addams Family
    for Kar, and I heard this over the stereo. I recognized it, but didn't know from where.
    When I got home, I realized that I owned it. I own more music than I've listened to,
    but I try to keep tabs on the music I actually like.
    

14. Owner of a Lonely Heart by Yes
    

    Pure 80s, and there's nothing wrong with that.
    

15. The Mines of Mozambique by Bruce Cockburn
    

    I know you like Bruce Hornsby, and I figured one Bruce is much like another.
    

16. Sweep the Leg by No More Kings
    

    Really, the original Karate Kid movie prejudices you against the Johnny character.
    You don't know what he's going on, other than an sensei who's obviously got skewed
    priorities.
    

17. You Turn The Screws by Cake
    

    A little outro from Cake to get the groove going.
    

18. Born Slippy by Kupek
    

    Trainspotting might not be your favorite movie in the world (I know it's not mine),
    but the original version of this song is one of my favorites off the soundtrack.
    This is a cover by a guy who did a comic book I like, and I thought it was nifty.
    

To those who sympathize with Juan Williams

I understand the root of your fear. We were all afraid. Nine years ago, when the towers fell, and the pentagon collapsed, we were terrified. At first, we didn't know what was going on, or how long it would go on for. We had no sense of what was safe. In this, we were all united.

Where I stop sympathizing with you is that you have kept your fear. We are in a war. We are continuing to strike at those who would harm us, to work for the safety of our selves and our nation. The only thing our enemies want is our fear. And you are giving it to them.

You are an adult, so you have the capacity to deal with your fear in an adult fashion. Do so, because you are an American and have a responsibility to do so. As the quote says "the only thing we have to fear is fear itself." The most they can take from us is our lives. They cannot take our dreams, our ideals, our nation. Only our fear can.

Fear can cause us to destroy our laws and traditions in pursuit of safety. Fear can make us suspect our own citizens are enemies, dividing us against ourselves. Fear is the root of panics and riots. And all we have to do is stand up, and decide to be unafraid.

The statistics are there if you cared to look for them. A minuscule fraction of the Muslims in the world are terrorists. A similar fraction of Christians are terrorists. Same with just about any religious group. Terrorism is one of the least likely ways to die. You're more likely to be killed by a loved one.

I would say remain a willfully ignorant coward if you must, but I can't. I share a nation with you. I need to work with you, live with you. I need you to continue on with me so we can build a future. I need you to conquer your fears and educate yourself. Do so.

This needs to be my new icon