Currying for map in Scheme - haskell

I understand Haskell syntax.
I want to curry (partially apply) a function called "play-note", and pass one argument "manually," and the second with a map.
If I could write it in Haskell, I'd say:
playNote :: Time -> Instrument -> Int -> Int -> Int -> Int -> Music -- made up, but just to give you an idea
notes = [46, 47, 35, 74]
loopGo = True
loop time = do mapM_ (playNote' time) notes
if loopGo then (loop (time+(second/2))) else return () -- time element removed
playNote' time pitch = playNote time drums pitch 80 11025 9 -- ignore extra args
In Scheme, here's the best I've got:
(define notes '(46 47 35 74))
(define *loop-go* #t)
(define play-note-prime
(lambda (time2)
(lambda (pitch)
(play-note time2 drums pitch 80 11025 9)))) ; drums is another variable
(define loop
(lambda (time)
(map (play-note-prime time) notes)
(if *loop-go*
(callback (+ time (/ *second* 2)) 'loop (+ time (/ second 2)))))) ; time element is more sophisticated here
The Scheme version "compiles," but doesn't do what I expect it to (curry the 1st arg, then the 2nd). Help? Thanks!
Edit:
The essence of my problem is not being able to define a function which takes two arguments, in a way that the following code produces the right result:
map ({some function} {some value; argument 1}) {some list; each element will be an argument 2}

To answer my own question:
The function needs to be defined as taking arguments "piecemeal": in other words, it's not really currying. I was trying that above, but wasn't getting it right.
A function which is partially applied needs to be described as a lambda or chain of lambdas, each accepting exactly the number of arguments it'll be passed (in descending order of when they will be recieved).
A working example:
(define nums '(3 3 1 2))
(define f
(lambda (num1)
(lambda (num2)
(expt num1 num2))))
(define ans (map (f 5) nums))
(print ans)
Defining f as accepting all arguments will not work:
(define f
(lambda (num1 num2)
(expt num1 num2))) ; Can't be curried

You're right -- one way to do it in scheme is to manually create lambdas. This would of course be a pain to implement in a general, correct way, i.e. checking numbers of arguments (don't want to have too many!).
Here's how Clojure (another LISP dialect) does it:
http://clojuredocs.org/clojure_core/clojure.core/partial
Is the source ugly? Maybe. Does it work? Sure.

Unless I'm missing something, wouldn't cut or cute from srfi-26 provide what you need? Then its just a question of whether your scheme implementation provides it (I think that most do)

Related

Implement a self-reference/pointer in a pure/functional language (Elm/Haskell)

Abstract Problem:
I'd like to implement a self-reference / pointer in Elm.
Specific Problem:
I'm writing a toy LISP interpreter in Elm inspired by mal.
I'm attempting to implement something like letrec to support recursive and mutually-recursive bindings (the "self reference" and "pointers" I'm mentioning above).
Here's some example code:
(letrec
([count (lambda (items)
(if (empty? items)
0
(+ 1 (count (cdr items)))
)
)
])
(count (quote 1 2 3))
)
;=>3
Note how the body of the lambda refers to the binding count. In other words, the function needs a reference to itself.
Deeper Background:
When a lambda is defined, we need to create a function closure which consists of three components:
The function body (the expression to be evaluated when the function is called).
A list of function arguments (local variables that will be bound upon calling).
A closure (the values of all non-local variables that may be referenced within the body of the function).
From the wikipedia article:
Closures are typically implemented with [...] a representation of the function's lexical environment (i.e., the set of available variables) at the time when the closure was created. The referencing environment binds the non-local names to the corresponding variables in the lexical environment at the time the closure is created, additionally extending their lifetime to at least as long as the lifetime of the closure itself. When the closure is entered at a later time, possibly with a different lexical environment, the function is executed with its non-local variables referring to the ones captured by the closure, not the current environment.
Based on the above lisp code, in creating the lambda, we create a closure whose count variable must be bound to the lambda, thereby creating an infinite/circular/self-reference. This problem gets further complicated by mutually-recursive definitions which must be supported by letrec as well.
Elm, being a pure functional language, does not support imperative modification of state. Therefore, I believe that it is impossible to represent self-referencing values in Elm. Can you provide some guidance on alternatives to implementing letrec in Elm?
Research and Attempts
Mal in Elm
Jos von Bakel has already implemented mal in Elm. See his notes here and the environment implementation here. He's gone to great lengths to manually build a pointer system with its own internal GC mechanism. While this works, this seems like massive amounts of struggle. I'm craving a pure functional implementation.
Mal in Haskell
The mal implementation in Haskell (see code here) uses Data.IORef to emulate pointers. This also seems like hack to me.
Y-Combinator/Fixed Points
It seems possible that the Y-Combinator can be used to implement these self references. There seems to be a Y* Combinator that works for mutually recursive functions as well. It seems logical to me that there must also exist a Z* combinator (equivalent to Y* but supports the eager evaluation model of Elm). Should I transform all of my letrec instances so that each binding is wrapped around a Z*?
The Y-Combinator is new to me and my intuitive mind simply does not understand it so I'm not sure if the above solution will work.
Conclusion
Thank you very much for reading! I have been unable to sleep well for days as I struggle with this problem.
Thank You!
-Advait
In Haskell, this is fairly straightforward thanks to lazy evaluation. Because Elm is strict, to use the technique below, you would need to introduce laziness explicitly, which would be more or less equivalent to adding a pointer indirection layer of the sort you mentioned in your question.
Anyway, the Haskell answer might be useful to someone, so here goes...
Fundamentally, a self-referencing Haskell value is easily constructed by introducing a recursive binding, such as:
let mylist = [1,2] ++ mylist in mylist
The same principle can be used in writing an interpreter to construct self-referencing values.
Given the following simple S-expression language for constructing potentially recursive / self-referencing data structures with integer atoms:
data Expr = Atom Int | Var String | Cons Expr Expr | LetRec [String] [Expr] Expr
we can write an interpreter to evaluate it to the following type, which doesn't use IORefs or ad hoc pointers or anything weird like that:
data Value = AtomV Int | ConsV Value Value deriving (Show)
One such interpreter is:
type Context = [(String,Value)]
interp :: Context -> Expr -> Value
interp _ (Atom x) = AtomV x
interp ctx (Var v) = fromJust (lookup v ctx)
interp ctx (Cons ca cd) = ConsV (interp ctx ca) (interp ctx cd)
interp ctx (LetRec vs es e)
= let ctx' = zip vs (map (interp ctx') es) ++ ctx
in interp ctx' e
This is effectively a computation in a reader monad, but I've written it explicitly because a Reader version would require using the MonadFix instance either explicitly or via the RecursiveDo syntax and so would obscure the details.
The key bit of code is the case for LetRec. Note that a new context is constructed by introducing a set of potentially mutually recursive bindings. Because evaluation is lazy, the values themselves can be computed with the expression interp ctx' es using the newly created ctx' of which they are part, tying the recursive knot.
We can use our interpreter to create a self-referencing value like so:
car :: Value -> Value
car (ConsV ca _cd) = ca
cdr :: Value -> Value
cdr (ConsV _ca cd) = cd
main = do
let v = interp [] $ LetRec ["ones"] [Cons (Atom 1) (Var "ones")] (Var "ones")
print $ car $ v
print $ car . cdr $ v
print $ car . cdr . cdr $ v
print $ car . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr $ v
Here's the full code, also showing an alternative interp' using the Reader monad with recursive-do notation:
{-# LANGUAGE RecursiveDo #-}
{-# OPTIONS_GHC -Wall #-}
module SelfRef where
import Control.Monad.Reader
import Data.Maybe
data Expr = Atom Int | Var String | Cons Expr Expr | LetRec [String] [Expr] Expr
data Value = AtomV Int | ConsV Value Value deriving (Show)
type Context = [(String,Value)]
interp :: Context -> Expr -> Value
interp _ (Atom x) = AtomV x
interp ctx (Var v) = fromJust (lookup v ctx)
interp ctx (Cons ca cd) = ConsV (interp ctx ca) (interp ctx cd)
interp ctx (LetRec vs es e)
= let ctx' = zip vs (map (interp ctx') es) ++ ctx
in interp ctx' e
interp' :: Expr -> Reader Context Value
interp' (Atom x) = pure $ AtomV x
interp' (Var v) = asks (fromJust . lookup v)
interp' (Cons ca cd) = ConsV <$> interp' ca <*> interp' cd
interp' (LetRec vs es e)
= mdo let go = local (zip vs vals ++)
vals <- go $ traverse interp' es
go $ interp' e
car :: Value -> Value
car (ConsV ca _cd) = ca
cdr :: Value -> Value
cdr (ConsV _ca cd) = cd
main = do
let u = interp [] $ LetRec ["ones"] [Cons (Atom 1) (Var "ones")] (Var "ones")
let v = runReader (interp' $ LetRec ["ones"] [Cons (Atom 1) (Var "ones")] (Var "ones")) []
print $ car . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr $ u
print $ car . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr $ v
A binding construct in which the expressions can see the bindings doesn't require any exotic self-reference mechanisms.
How it works is that an environment is created for the variables, and then the values are assigned to them. The initializing expressions are evaluated in the environment in which those variables are already visible. Thus if those expressions happen to be lambda expressions, then they capture that environment, and that's how the functions can refer to each other.
An interpreter does this by extending the environment with the new variables, and then using the extended environment for evaluating the assignments. Similarly, a compiler extends the compile-time lexical environment, and then compiles the assignments under that environment, so the running code will store values into the correct frame locations. If you have working lexical closures, the correct behavior of functions being able to mutually recurse just pops out.
Note that if the assignments are performed in left to right order, and one of the lambdas happens to be dispatched during initialization, and then happens to make a forward call to one of lambdas through a not-yet-assigned variable, that will be a problem; e.g.
(letrec
([alpha (lambda () (omega)]
[beta (alpha)] ;; problem: alpha calls omega, not yet stored in variable.
[omega (lambda ())])
...)
Note that in the R7RS Scheme Report, P16-17, letrec is in fact documented as working like this. All the variables are bound, and then they are assigned the values. If the evaluation of an init expression refers to the same variable that is being initialized, or to later variables not yet initialized, R7RS says that it is an error. The document also specifies a restriction regarding the use of continuations captured in the initializing expressions.
The U combinator
I am late to the party here, but I got interested and spent some time working out how to do this in a Lisp-family language, specifically Racket, and thought perhaps other people might be interested.
I suspect that there is lots of information about this out there, but it's seriously hard to search for anything which looks like '*-combinator' now (even now I am starting a set of companies called 'Integration by parts' and so on).
You can, as you say, do this with the Y combinator, but I didn't want to do that because Y is something I find I can understand for a few hours at a time and then I have to work it all out again. But it turns out that you can use something much simpler: the U combinator. It seems to be even harder to search for this than Y, but here is a quote about it:
In the theory of programming languages, the U combinator, U, is the mathematical function that applies its argument to its argument; that is U(f) = f(f), or equivalently, U = λ f . f(f).
Self-application permits the simulation of recursion in the λ-calculus, which means that the U combinator enables universal computation. (The U combinator is actually more primitive than the more well-known fixed-point Y combinator.)
The expression U(U), read U of U, is the smallest non-terminating program, [...].
(Text from here, which unfortunately is not a site all about the U combinator other than this quote.)
Prerequisites
All of the following code samples are in Racket. The macros are certainly Racket-specific. To make the macros work you will need syntax-parse via:
(require (for-syntax syntax/parse))
However note that my use of syntax-parse is naïve in the extreme: I'm really just an unfrozen CL caveman pretending to understand Racket's macro system.
Also note I have not ruthlessly turned everything into λ: there are lets in this code, use of multiple values including let-values, (define (f ...) ...) and so on.
Two versions of U
The first version of U is the obvious one:
(define (U f)
(f f))
But this will run into some problems with an applicative-order language, which Racket is by default. To avoid that we can make the assumption that (f f) is going to be a function, and wrap that form in another function to delay its evaluation until it's needed: this is the standard trick that you have to do for Y in an applicative-order language as well. I'm only going to use the applicative-order U when I have to, so I'll give it a different name:
(define (U/ao f)
(λ args (apply (f f) args)))
Note also that I'm allowing more than one argument rather than doing the pure-λ-calculus thing.
Using U to construct a recursive functions
To do this we do a similar trick that you do with Y: write a function which, if given a function as argument which deals with the recursive cases, will return a recursive function. And obviously I'll use the Fibonacci function as the canonical recursive function.
So, consider this thing:
(define fibber
(λ (f)
(λ (n)
(if (<= n 2)
1
(+ ((U f) (- n 1))
((U f) (- n 2)))))))
This is a function which, given another function, U of which computes smaller Fibonacci numbers, will return a function which will compute the Fibonacci number for n.
In other words, U of this function is the Fibonacci function!
And we can test this:
> (define fibonacci (U fibber))
> (fibonacci 10)
55
So that's very nice.
Wrapping U in a macro
So, to hide all this the first thing to do is to remove the explicit calls to U in the recursion. We can lift them out of the inner function completely:
(define fibber/broken
(λ (f)
(let ([fib (U f)])
(λ (n)
(if (<= n 2)
1
(+ (fib (- n 1))
(fib (- n 2))))))))
Don't try to compute U of this: it will recurse endlessly because (U fibber/broken) -> (fibber/broken fibber/broken) and this involves computing (U fibber/broken), and we're doomed.
Instead we can use U/ao:
(define fibber
(λ (f)
(let ([fib (U/ao f)])
(λ (n)
(if (<= n 2)
1
(+ (fib (- n 1))
(fib (- n 2))))))))
And this is all fine ((U fibber) 10) is 55 (and terminates!).
And this is really all you need to be able to write the macro:
(define-syntax (with-recursive-binding stx)
(syntax-parse stx
[(_ (name:id value:expr) form ...+)
#'(let ([name (U (λ (f)
(let ([name (U/ao f)])
value)))])
form ...)]))
And this works fine:
(with-recursive-binding (fib (λ (n)
(if (<= n 2)
1
(+ (fib (- n 1))
(fib (- n 2))))))
(fib 10))
A caveat on bindings
One fairly obvious thing here is that there are two bindings constructed by this macro: the outer one, and an inner one of the same name. And these are not bound to the same function in the sense of eq?:
(with-recursive-binding (ts (λ (it)
(eq? ts it)))
(ts ts))
is #f. This matters only in a language where bindings can be mutated: a language with assignment in other words. Both the outer and inner bindings, unless they have been mutated, are to functions which are identical as functions: they compute the same values for all values of their arguments. In fact, it's hard to see what purpose eq? would serve in a language without assignment.
This caveat will apply below as well.
Two versions of U for many functions
The obvious generalization of U, U*, to many functions is that U*(f1, ..., fn) is the tuple (f1(f1, ..., fn), f2(f1, ..., fn), ...). And a nice way of expressing that in Racket is to use multiple values:
(define (U* . fs)
(apply values (map (λ (f)
(apply f fs))
fs)))
And we need the applicative-order one as well:
(define (U*/ao . fs)
(apply values (map (λ (f)
(λ args (apply (apply f fs) args)))
fs)))
Note that U* is a true generalization of U: (U f) and (U* f) are the same.
Using U* to construct mutually-recursive functions
I'll work with a trivial pair of functions:
an object is a numeric tree if it is a cons and its car and cdr are numeric objects;
an objct is a numeric object if it is a number, or if it is a numeric tree.
So we can define 'maker' functions (with an '-er' convention: a function which makes an x is an xer, or, if x has hyphens in it, an x-er) which will make suitable functions:
(define numeric-tree-er
(λ (nter noer)
(λ (o)
(let-values ([(nt? no?) (U* nter noer)])
(and (cons? o)
(no? (car o))
(no? (cdr o)))))))
(define numeric-object-er
(λ (nter noer)
(λ (o)
(let-values ([(nt? no?) (U* nter noer)])
(cond
[(number? o) #t]
[(cons? o) (nt? o)]
[else #f])))))
Note that for both of these I've raised the call to U* a little, simply to make the call to the appropriate value of U* less opaque.
And this works:
(define-values (numeric-tree? numeric-object?)
(U* numeric-tree-er numeric-object-er))
And now:
> (numeric-tree? 1)
#f
> (numeric-object? 1)
#t
> (numeric-tree? '(1 . 2))
#t
> (numeric-tree? '(1 2 . (3 4)))
#f
Wrapping U* in a macro
The same problem as previously happens when we raise the inner call to U* with the same result: we need to use U*/ao. In addition the macro becomes significantly more hairy and I'm moderately surprised that I got it right so easily. It's not conceptually hard: it's just not obvious to me that the pattern-matching works.
(define-syntax (with-recursive-bindings stx)
(syntax-parse stx
[(_ ((name:id value:expr) ...) form ...+)
#:fail-when (check-duplicate-identifier (syntax->list #'(name ...)))
"duplicate variable name"
(with-syntax ([(argname ...) (generate-temporaries #'(name ...))])
#'(let-values
([(name ...) (U* (λ (argname ...)
(let-values ([(name ...)
(U*/ao argname ...)])
value)) ...)])
form ...))]))
And now, in a shower of sparks, we can write:
(with-recursive-bindings ((numeric-tree?
(λ (o)
(and (cons? o)
(numeric-object? (car o))
(numeric-object? (cdr o)))))
(numeric-object?
(λ (o)
(cond [(number? o) #t]
[(cons? o) (numeric-tree? o)]
[else #f]))))
(numeric-tree? '(1 2 3 (4 (5 . 6) . 7) . 8)))
and get #t.
As I said, I am sure there are well-known better ways to do this, but I thought this was interesting enough not to lose.

"Reversing" a hook in J

I want to put the operation which takes all the items in a list which are greater than 2 into a pointless (as in not explicitly capturing the argument in a variable) function in J. I wanted to do this by using ~ with a hook, like f =: ((> & 2) #)~ but it seems like neither that nor ((> & 2) #~) works.
My reasoning was that my function has the form (f y) g y where y is the list, f is (> & 2), and g is #. I would appreciate any help!
Everything is OK except you mixed the order of the hook. It's y f (g y) so you want
(#~ (>&2)) y
Hooks have the form f g and the interpretation, when applied to a single argument (i.e. monadically) is (unaltered input) f (g input). So, as Eelvex noted, you'd phrase this as a hook like hook =: #~ >&2 . Also, as kaledic noted, the idiom (#~ filter) is extremely common in J, so much that it's usually read as a cohesive whole: keep-items-matching-filter.*
If you wanted a point-free phrasing of the operation which looks similar, notationally, to the original noun-phrase (y > 2) # y , you might like to use the fork >&2 # ] where ] means "the unaltered input" (i.e. the identity function) or even (] # 2:) # ] or some variation.
(*) In fact, the pattern (f~ predicate) defines an entire class of idioms, like (<;.1~ frets) for cutting an array into partitions and (</.~ categories) for classifying the items of an array into buckets.

What would be a good or efficient way to get the list of alphabet used in a string

Put it simply, how to get a list non-repeated letters from a string in Common Lisp?
e.g:
"common"
-> ("c" "o" "m" "n") or in characters, (#\c #\o #\m #\n)
I'd care less about the order and type, if it is in string or character.
"overflow" -> (o v e r f l w)
"tomtomtom" -> (t o m)
etc...
What I was thinking is to collect the first letter of the original string,
Then use the function;
(remove letter string)
collect the first letter of now, removed letter string and append it to the already collected letters from before.
It sounds like recursion but if recursively calling would loose the previously collected *letter*s list, right? I also doubt if there is any built-in functions for this.
Furthermore, I don't want to use set or any of them since I want
to do this completely in functional style.
Thanks for your time.
CL-USER> (remove-duplicates (coerce "common" 'list))
(#\c #\m #\o #\n)
Or you can even do it simply as:
CL-USER> (remove-duplicates "common")
"comn"
There may be certain better possibilities to do that, if you can make some assumptions about the text you are dealing with. For instance, if you are dealing with English text only, then you could implement a very simple hash function (basically, use a bit vector 128 elements long), so that you wouldn't need to even use a hash-table (which is a more complex structure). The code below illustrates the idea.
(defun string-alphabet (input)
(loop with cache =
(coerce (make-array 128
:element-type 'bit
:initial-element 0) 'bit-vector)
with result = (list input)
with head = result
for char across input
for code = (char-code char) do
(when (= (aref cache code) 0)
(setf (aref cache code) 1
(cdr head) (list char)
head (cdr head)))
finally (return (cdr result))))
(string-alphabet "overflow")
;; (#\o #\v #\e #\r #\f #\l #\w)
Coercing to bit-vector isn't really important, but it is easier for debugging (the printed form is more compact) and some implementation may actually optimize it to contain only so many integers that the platform needs to represent so many bits, i.e. in the case of 128 bits length, on a 64 bit platform, it could be as short as 2 or 3 integers long.
Or, you could've also done it like this, using integers:
(defun string-alphabet (input)
(loop with cache = (ash 1 128)
with result = (list input)
with head = result
for char across input
for code = (char-code char) do
(unless (logbitp code cache)
(setf cache (logior cache (ash 1 code))
(cdr head) (list char)
head (cdr head)))
finally (return (cdr result))))
but in this case you would be, in your worst case, create 128 big integers, which is not so expensive after all, but the bit-vector might do better. However, this might give you a hint, for the situation, when you can assume that, for example, only letters of English alphabet are used (in which case it would be possible to use an integer shorter then machine memory word).
Here some code in Haskell, because I am not so familiar with Lisp, but as they're both functional, I don't think, it will be a problem for translating it:
doit :: String -> String
doit [] = []
doit (x:xs) = [x] ++ doit (filter (\y -> x /= y) xs)
So what does it? You've got a String, if it's an empty String (in Haskell [] == ""), you return an empty String.
Otherwise, take the first element and concatenate it to the recursion over the tail of the String, but filter out those elements, which are == first element.
This Function filter is only syntactic sugar for a specific map-function, in Lisp called remove-if as you can reread here: lisp filter out results from list not matching predicate

Unable to find bug in my Haskell program (Puzzle #2 from Project Euler)

SPOILER ALERT: Don't look at this if you are trying to solve Project Euler's problem #2 on your own w/o looking at the answer.
I've already completed problem #2 of Project Euler (computing the sum of all even Fibonacci(n) numbers less than or equal to 4 million) - I'm using these problems to practice my C/Ada skills, to revisit my Common Lisp and to learn Haskell.
When I'm trying to re-implement my solution in Haskell, I'm running into a problem. In classical fashion, it is calculating the wrong answer. However, I think my Haskell implementation resembles my Common Lisp one (which does produce the correct result.)
The algorithm only computes the Fibonacci number for n where n % 3 == 0. This is because
We need to sum only the even-valued Fibonacci numbers F(n) <= 4M, and
(n % 3 == 0) <--> (F(n) % 2 == 0)
Here is the Haskell implementation:
uber_bound = 40000000 -- Upper bound (exclusive) for fibonacci values
expected = 4613732 -- the correct answer
-- The implementation amenable for tail-recursion optimization
fibonacci :: Int -> Int
fibonacci n = __fibs (abs n) 0 1
where
-- The auxiliary, tail-recursive fibs function
__fibs :: Int -> Int -> Int -> Int
__fibs 0 f1 f2 = f1 -- the stopping case
__fibs n f1 f2 = __fibs (n - 1) f2 (f1 + f2)
-- NOT working. It computes 19544084 when it should compute 4613732
find_solution :: Int
find_solution = sum_fibs 0
where
sum_fibs :: Int -> Int
sum_fibs n =
if fibs > uber_bound
then
0 -- stopping condition
else
-- remember, (n % 3 == 0) <--> (fib(n) % 2 == 0)
-- so, seek the next even fibs by looking at the
-- the next n = n#pre + 3
fibs + sum_fibs (n + 3)
where
fibs = fibonacci n
actual = find_solution
problem_2 = (expected == actual)
The thing is printing 19544084 when the correct answer is 4613732. My Common Lisp solution (which does work) is below.
I thought my Haskell implementation would resemble it, but I'm missing something.
(set `expected 4613732) ;; the correct answer
;; tail-recursive fibonacci
(defun fibonacci (n)
(labels
( ;; define an auxiliary fibs for tail recursion optimization
(__fibs (n f1 f2)
(if (<= n 0)
f1 ;; the stopping condition
(__fibs
(- n 1) ;; decrement to ensure a stopping condition
f2
(+ f1 f2))))
) ;; end tail_rec_fibs auxiliary
(__fibs n 0 1)
);; end labels
) ;; end fibonacci
(defun sum_fibs(seed)
(let*
((f (fibonacci seed)))
(if (> f 4000000)
0
;; else
(+ f (sum_fibs (+ 3 seed)))
);; end if
);; end of let
);; end of sum-fibs
(defun solution () (sum_fibs 0))
(defun problem_2 ()
(let
(
(actual (solution))
)
(format t "expected:~d actual:~d" expected actual)
(= expected actual)
)
) ;; end of problem_2 defun
What on Earth am I doing wrong? Granted that I'm using a Neanderthal approach to learning Haskell (I'm currently just re-implementing my Lisp on Haskell as opposed to learning idiomatic Haskell, the coding/problem solving approach that goes with the language.)
I'm not looking for somebody to just give me the solution (this is not a can i haz the codez?). I'm looking more, but much more for an explanation of what I'm missing in my Haskell program. Where is the bug, or am I missing a very specific Haskell idiosyncratic evaluation/pattern matching thing? Thanks.
You have a typo
uber_bound = 40000000
when it should be
uber_bound = 4000000
Just for reference, a more idiomatic solution would be to generate a list of all the Fibonacci numbers (lazy evaluation is really useful for this), and then use takeWhile, filter and sum.
This will be more efficient too, since tail recursion is rarely helpful in Haskell (lazy evaluation gets in the way), and since the element of the list are shared (if the list is define appropriately) each Fibonacci number is computed exactly once.
deleted, wasn't supposed to give a spoiler. dbaupp's suggestions are good. There's a well known expression using zipWith but I think it's too clever--there are more straightforward ways.

How to transform Scheme program into Haskell?

I'm going to transform a scheme program into Haskell but I'm having a hard time learning all about Haskell. If you are familiar with SICP, I`m tasked to answer Exercises 3.63, 3.64, 3.65, 3.66 and 3.71. I have already found the answers to these problems but they are written in scheme. Here is the question and answer in 3.63:
Exercise 3.63. Louis Reasoner asks why the sqrt-stream procedure was not written in the following more straightforward way, without the local variable guesses:
(define (sqrt-stream x)
(cons-stream 1.0
(stream-map (lambda (guess)
(sqrt-improve guess x))
(sqrt-stream x))))
Alyssa P. Hacker replies that this version of the procedure is considerably less efficient because it performs redundant computation.
Explain Alyssa's answer.
Would the two versions still differ in efficiency if our implementation of delay used only (lambda () <exp>) without using the optimization provided by memo-proc (section 3.5.1)?
Answer:
In Louis Reasoner’s procedure, (sqrt-stream x) is recursively called inside (sqrt-stream x). However, the two streams are not the same variable. Therefore redundant computation is performed. In the original version, a local variable guesses is used.
(define (sqrt-stream x)
(define guesses
(cons-stream 1.0
(stream-map (lambda (guess)
(sqrt-improve guess x))
guesses)))
guesses)
(display-stream (sqrt-stream 2))
Here is the Haskell code that I wrote and it's not working:
module Main
where
guess = 1:: Double
x=0
do
if ((guess*guess) = x)
then y = (x + guess) / x
guess = y
else
sqrt x = guess
Please help me fix my codes. I need them next week.
I'll also try the other ones and post them here if there there will be errors again. Hope you can help me.Thanks a lot.
Your Haskell code looks wrong on so many levels (e.g. do is no loop construct, you can't assign a new value to guess). I can only guess what you want. Here is a function calculating the square root:
sqrt' :: Double -> Double
sqrt' n = loop n
where loop guess | abs (guess - improve guess) < 0.00000000001 = improve guess
| otherwise = loop $ improve guess
improve guess = 0.5 * (guess + n / guess)
Here is a version which gives you the list of approximations (until it doesn't change anymore):
sqrt' :: Double -> [Double]
sqrt' n = takeChanging $ iterate (\ guess -> 0.5 * (guess + n / guess)) n
where takeChanging (x:y:ys) | abs (x-y) < 0.00000000001 = [x]
| otherwise = x : takeChanging (y:ys)

Resources