Saturday, December 10, 2016

October 2016 1Liner 1HaskellADay problem and solutions

  • October 21st, 2016:
    You have l1 :: [(v, [(k, x)])]
    You need the transformation l2 :: [(k, [(v, x)])]
    Redistribute v and k in one line
    Props for elegance
    • Francisco T @aiceou redist xs = fromListWith (++) $ concat $ (map f xs) where f (a,ys) = map (\(x,y) -> (x,[(a,y)])) ys ... but k has to be 'Ord'

Wednesday, November 30, 2016

November 2016 1HaskellADay Problems and Solutions

Tuesday, November 1, 2016

October 2016 1HaskellADay Problems and Solutions

Saturday, October 22, 2016

September 2016 1HaskellADay 1Liners Problems and Solutions

  • September 15th, 2016:
    Given [1..n], create an infinite list of lists [[1.. n], [n+1 ... n+n], [n+n+1 ... 3n], ...]
    counting :: [Integer] -> [[Integer]]
    • joomy @cattheory
      counting = (map . (+) . fromIntegral . length) >>= iterate
  • September 30th, 2016: The reverse of August's one-liner:
    f :: (Maybe a, b) -> Maybe (a,b)
    define f. Snaps for elegance.

Sunday, October 2, 2016

September 2016 1HaskellADay problems and solutions

Thursday, September 15, 2016

August 2016 1HaskellADay 1Liners

  • August 20th, 2016: maybeify :: (a, Maybe b) -> Maybe (a, b)
    Define maybeify. Snaps for elegance.
    • Hardy Jones @st58 sequence
    • Bruno @Brun0Cad mapM id
    • Thomas D @tthomasdd {-# LANGUAGE TupleSections #-}
      mabeify (x,mY) = maybe Nothing (return . (x,)) mY
    • Андреев Кирилл @nonaem00 import "category-extras" Control.Functor.Strong
      maybeify = uncurry strength
    • bazzargh @bazzargh I can't beat 'sequence', but: uncurry (fmap.(,))
    • Nick @crazy_fizruk distribute (from Data.Distributive)

Thursday, September 1, 2016

August 2016 1HaskellADay Problems and Solutions

August 2016


  




  • August 25th, 2016: Today's #haskell exercise looks at historical prices of #bitcoin
    Today's #haskell solution is worth $180k ... five years ago. I wonder what it will be worth 5 years hence? 
     
  • August 23rd, 2016: Enough diving into the node's data, let's look at the structure of the related nodes for today's #haskell problem. The structure of tweets and related data for today's #haskell solution 
  • August 22nd, 2016: Today's #haskell problem is parsing twitter hashtags and a bit of data fingerprinting/exploration of same. BOOM! Today's #haskell solution analyzes hashtags twitter-users ('tweeps') use
  • August 19th, 2016: For today's #haskell exercise we look at unique users in a set of twitter graph-JSONToday's #haskell solution gives us a list of users, then their tweets, from twitter graph-JSON data 
  • August 18th, 2016: For today's #haskell problem we extract and reify URLs from twitter graph-JSON. Today's #haskell solution extract URLs from twitter data as easily as looking up the URLs in a JSON map.
  • August 17th, 2016: For today's #haskell problem we explore the relationships from and to tweets and their related data. Today's #haskell solution relates data to tweets extracted from graph-JSON 
  • August 16th, 2016: For today's #haskell exercise we begin converting nodes in a graph to more specific types (Tweets are up first). We create some JSON Value-extractors and with those find the tweets in graph JSON in today's #Haskell solution 
  • August 15th, 2016: Today's #haskell exercise looks at twitter data as labeled/typed nodes and relations in JSON  

    Okay! For today's #haskell solution we discover our node and relation types in twitter data-as-graphs JSON! 
  • August 10th, 2016: Today's #Haskell problem we look at the big data-problem: getting a grasp of large indices of tweets in graph JSON. Today's #Haskell solution time-stamps and gives 'small-data' indices to tweets from graph JSON 
  • August 9th, 2016: For today's #haskell problem we extract the tweets from rows of graph data encoded in JSON. Today's #Haskell solution extracts the tweets from graph JSON and does some simple queries
  • August 8th, 2016: For today's #haskell problem we look at reading in the graph of a twitter-feed as JSON and just a bit of parsing. We leverage the Cypher library for today's #haskell solution to look at 100 rows of tweets encoded as JSON 
  • August 5th, 2016: Today's #Haskell problem we go for the Big Kahuna: solving a Kakuro puzzle
    Okay, we have a #Haskell solution ... finally ... maybe. The solver took too long, so I solved it myself faster :/ 
  • August 4th, 2016: Today's #Haskell exercise looks at (simple) constraints of unknown values for a sum-solverToday's #Haskell solution also uses QBits to solve constrained unknowns 
  • August 3rd, 2016: Today's #haskell problem provides the cheatsheet: "What are the unique 4-number sums to 27?" We round-trip the Set category for today's #haskell solution
  • August 2nd, 2016: Today's #haskell exercise looks at solving our sums when we know some of the numbers alreadyQBits actually work nicely for today's #Haskell solution 
  • August 1st, 2016: For today's #Haskell exercise we play the 'Numbers Game.' The #haskell solution is a guarded combine >>= permute in the [Int]-domain. I like the Kleisli category; ICYMI.
  • Saturday, August 20, 2016

    1Liners for July 2016


    • July 14th, 2016: So you have x :: [a] in the IO monad, and the function f :: a -> b What is the expression that gets you IO [b]?

    Sunday, July 31, 2016

    July 2016 1HaskellADay Problems and Solutions

    July 2016

    Thursday, July 14, 2016

    1HaskellADay 1Liners June 2016

    • June 13th, 2016:
      You want this list: [1, -1, 1, -1, ...]
      How would you produce this value in #Haskell ?
      • Wai Lee Chin Feman @wchinfeman
        https://gist.github.com/skatenerd/08d70c45499e1610206a
        (set plop to be identity, and set transformstate to be (*) -1)
      • Philipp Maier @AkiiZedd `iterate negate 1
      • Patrick Mylund @pmylund concat $ repeat [1, (-1)]
        • Gary Fixler @gfixler No need for the parens in a list.
      • Jeff Foster @fffej and Kevin Meredith @Gentmen
        iterate (* (- 1)) 1
      • Spencer Janssen @spencerjanssen and Андреев Кирилл @nonaem00
        cycle [1, -1]
        • Philipp Maier @AkiiZedd:
          I’m curious: Since concat is O(n) wouldn’t it take more and more time depending on how many items you take?
        • Patrick Mylund @pmylund Looks like they compile to the same thing https://gist.github.com/patrickmn/9a92ab2a088018b2c0631f3bcfd60ebe
        • Philipp Maier @AkiiZedd I’m actually surprised the compiler can optimise this away :o Thanks for showing me ddump-simpl!
        • Eyal Lotem @EyalL concat is foldr (++), not foldl. O(1) work is done to produce the next item. [1,-1]++([1,-1]++(...
      • David Turner @DaveCTurner I'd actually write 'cycle [1,-1]' but I like the elegant, alliterative obscurity of   'iterate negate 1'
      • Fatih Karakurt @karakfa alt=1:[-x|x<-alt]