Tag Archive for "scheme" tag

Haskell-like function definitions in Scheme

June 26th, 2013 by Ivan Lakhturov | 0 Category: Programming | Tags: | |

Haskell allows to decompose arguments straight in a function signature. While pattern matching is implemented in some Scheme-s, it's not applied to the signature. Luckily, we have Scheme macros to alter that.

Let's say we started out with a new language, bootstrapping it with Scheme. And in the beginning we have no lexing / parsing, just redefinitions. First of all, we change the names for the pairs, as that's the cornerstone of Scheme and some other functional languages.

Why not to change those, indeed? Say, what is the meaning of 'cdr'? Perhaps, earlier "Contents of the Decrement part of Register number" meant something. But nowadays - nothing. The only advantage perhaps is that you can quickly write some 'cadadr'-like compositions.

So, we redefine pairs' functions:

  1. (define pair cons)
  2. (define former car)
  3. (define latter cdr)

Then, suppose we want to write a swap function, which interchanges the former and the latter parts of a pair:

  1. (define (swap p) (pair (latter p) (former p)))

Now compare this to the Haskell version:

  1. swap (a, b) = (b, a)

Haskell decomposes a pair into "a" and "b" straight in the function signature. One can argue that it looses "p" variable name for the whole pair. But for that it has a special syntax:

  1. swap pair@(a, b) = (b, a)

Notice, we could not use the "pair" identifier in Scheme version, as we would shadow the constructor.

The Haskell's variant is more declarative. Also, if the variable "p" would have a longer name, we'd suffer, as it's used twice. Let's make use of macros to implement Haskell-like function definitions in Scheme:

  1. (define-syntax
  2.   (syntax-rules ()
  3.     [(_ (function possibly-decomposed-argument) . body)
  4.      (define (function generated-argument-name)
  5.        (match generated-argument-name
  6.          [possibly-decomposed-argument . body]
  7.          [_ (error "input did not match the function definition")]
  8.          ))]
  9.     [(_ identifier expression)
  10.      (define identifier expression)]
  11.     ))

The second transformer is to allow identifier definitions like "(≝ x 10)". The "match" is defined in PLT/Racket and some other implementations. Now we can write our swap-function like this:

  1. ((swap (pair a b)) (pair b a))

or even like this:

  1. ((swap (pair a b)) . ≝ . (pair b a))

- if we remember about the dot-notation of the Scheme's lexer (reader).

However, that will not work. The reason is simple, the redefinitions that we wrote for the pair funcions are executed in the last phase (run-time), but the "match" macro needs it already during the macro-application phase (the expander phase). That "match" does not know about new pair's constructor.

And to mitigate that there is a clumsy "define-match-expander":

  1. (define-match-expander pair
  2.   (syntax-rules () [(_ a b) (cons a b)])
  3.   (syntax-rules () [(_ a b) (cons a b)]))

The first transformer is used in the "match" context, and the second is for everything else (i.e. it replaces our "cons" pair constructor). The transformers are identical, but I didn't manage to declare one separately and re-use. Quick search reveals that others also have some problems with that.

So, now we can imitate Haskell notation. For one parameter and one pattern only, but that could be extended. Haskell, however, also has a limit of one pattern, as to declare a different pattern one needs to repeat a function name on a different line. That's what I don't like in Haskell. It is really enough to write a function name once. Say, in Nemerle with indentation-based syntax one can write:

  1. def fibonacci(i)
  2.   | 0 => 0
  3.   | 1 => 1
  4.   | _ => fibonacci(i - 1) + fibonacci(i - 2)

There are case expressions in Haskell, but those oblige to declare additional identifiers for function's arguments (those could be replaced with _ in Nemerle). And hey! The "case" from Haskell resembles define/match, which is already implemented in PLT Scheme/Racket. And define/match is a good enough substitute for the default Haskell notation, I think. So, instead of "(define (swap p) (pair (latter p) (former p)))" we would write:

  1. (define/match (swap _)
  2.   [((pair a b)) (pair b a)])

A bit too many parentheses to support multiple patterns for one branch (different from normal "match"), but in other respects nice.

So, actually I would choose Haskell-like notation for functions with one pattern, and define/match for many-pattern functions, like Fibonacci one. I guess it's possible to combine these in one ≝-notation. For that we would need to enhance the ≝ macro. But that is already "a topic of the future research", as scientists say (when they don't want (or cannot) continue).

Scientific Literature Browser

April 9th, 2013 by Ivan Lakhturov | 0 Category: Miscellaneous, Programming | Tags: | | |

Recently I've finished the website called Choose Your Textbook. This is a Scientific Literature Browser. One can browse there through the tree of science (the branches are taken from the wiki), and see the short description of those sciences. To the right there is an Amazon search box, where the name of the currently chosen branch is dynamically loaded, thus it shows the (most) relevant books at Amazon for a specific discipline.

Technically speaking, this is a mashup, but part of mashing is done offline. It's with my tools written in Scheme, and it is possible to do that dynamically, as there exist Scheme-s embedded to JS. But not for this project. The tooling converts that specific wiki-page in a chain HTML -> SXML -> (filtering) -> JSON. The latter is embedded to the website's JS. A nice tree / graph renderer called JIT is used to show the tree. JIT does animation / morphing and supports a few layouts. Seems, though, it cannot switch between them dynamically. I've stumbled at some other restrictions also, e.g. couldn't setup decent automatic node sizes.

Despite I've designed the website as an Amazon affiliate, I knew there wouldn't be much popularity. I tried to put a link to Hacker News and to Reddit, but both unsuccessful. So, there are almost no visitors at all. Nevertheless, my point was to try a few things: make my first mashup, write some tooling in Scheme, including DOM-manipulation, try out some web graph renderer, and last but not least, I wanted to skim through the tree of Science looking with one eye on existing appropriate literature list. And those goals are accomplished.

HQ9+, H9+, KL esoterical languages and the beer song

April 4th, 2011 by Ivan Lakhturov | 0 Category: Programming | Tags: |

Let's first sing a beer song (in R6RS Scheme):

  1. #!r6rs
  2. (library (sing-beer-song)
  3.          (export sing-beer-song)
  4.          (import (rnrs))
  6.          (define (sing-beer-song n)
  7.            (define (n-bottles i capital?)
  8.              (string-append
  9.               (cond
  10.                 ((eqv? i -1) (number->string 99))
  11.                 ((and (eqv? i 0) capital?) "No more")
  12.                 ((eqv? i 0) "no more")
  13.                 (else (number->string i)))
  14.               " bottle" (if (eqv? i 1) "" "s")
  15.               " of beer"))
  16.            (define (where?) " on the wall")
  17.            (define (what-to-do? n)
  18.              (if (> n 0) "Take one down and pass it around, "
  19.                  "Go to the store and buy some more, "))
  20.            (string-append
  21.             "\n" (n-bottles n #t) (where?) ", " (n-bottles n #f) ".\n"
  22.             (what-to-do? n) (n-bottles (- n 1) #f) (where?) ".\n"
  23.             (if (> n 0) (sing-beer-song (- n 1)) ""))))

Then let's make an extra library:

  1. #!r6rs
  2. (library (language-utilities)
  3.          (export glue)
  4.          (import (rnrs))
  6.          (define (glue los) (fold-left string-append "" los)))

... and we are ready to write yet-another HQ9+ interpreter:

  1. #!r6rs
  2. (import (rnrs) (sing-beer-song) (language-utilities))
  4. ; HQ9+ interpreter v0.1 (Ivan Lakhturov)
  5. ; http://esolangs.org/wiki/HQ9
  7. (define i 0)
  9. (define (run-program s)
  10.   (define (run-command c)
  11.     (cond
  12.       ((eqv? c #\H) "Hello, World!")
  13.       ((eqv? c #\Q) s)
  14.       ((eqv? c #\9) (sing-beer-song 99))
  15.       ((eqv? c #\+) (set! i (+ i 1)) "") ; (number->string i))
  16.       (else (string c))))
  17.   (glue (map run-command (string->list s))))  
  19. (display (run-program "HQ9+"))

HQ9+ is a joke language, featuring "Hello world" command, quine command, beer-song command and a counter increment (counter cannot be accessed or printed out). Quine implementation here is the classical "quine-cheating", where a program has access to its source. To make the quine more 'honest' somebody designed H9+. This is the same as HQ9+, but without "Q" command, and additionally, all characters on input are ignored, except for H, 9 and +. Then, obviously, "Hello, World!" program will be a quine. Let's implement H9+:

  1. #!r6rs
  2. (import (rnrs) (sing-beer-song) (language-utilities))
  4. ; H9+ interpreter v0.1 (Ivan Lakhturov)
  5. ; http://esolangs.org/wiki/H9
  7. (define i 0)
  9. (define (run-program s)
  10.   (define (run-command c)
  11.     (cond
  12.       ((eqv? c #\H) "Hello, World!")
  13.       ((eqv? c #\9) (sing-beer-song 99))
  14.       ((eqv? c #\+) (set! i (+ i 1)) "") ; (number->string i))
  15.       (else "")))
  16.   (glue (map run-command (string->list s))))  
  18. (display (run-program "Hello, World!"))

And let's implement also a variation of this theme, the esoterical language KL:

  1. #!r6rs
  2. (import (rnrs) (language-utilities))
  4. ; KL interpreter v0.1 (Ivan Lakhturov)
  5. ; http://ivanguide.ru/kl/
  7. (define (run-program s)
  8.   (define (run-command c)
  9.     (cond
  10.       ((eqv? c #\+) "Привет, мир!")
  11.       ((eqv? c #\-) s)
  12.       ((eqv? c #\*)
  13. "Я узнал, что у меня
  14. Есть огpомная семья –
  15. И тpопинка, и лесок,
  16. В поле каждый колосок!
  18. Речка, небо голубое –
  19. Это все мое, pодное!
  20. Это Родина моя!
  21. Всех люблю на свете я!")
  22.       ((eqv? c #\/) "\n")
  23.       (else (string c))))
  24.   (glue (map run-command (string->list s))))  
  26. (display (run-program "+/-/*/extras"))

The semantics is as following: + is printing "Hello, world!" in Russian, - is printing a program's source, / is making a newline, and * print outs a poem from Russian movie "Brother".

To complete the picture, we can mention other close related to HQ9+ joke languages: HQ9++, CHIQRSX9, HQ9+B, HQ9+2D. HQ9++ is 'an object-oriented extension of HQ9+'; not interesting. CHIQRSX9+ adds eval, ROT-13 and sorting of input lines. ROT-13 (Caesar cipher) is a nice exercise to implement, but let's leave it for later. HQ9+B adds Brainfuck: this is definitely a thing to implement, but I will deal with Brainfuck later. HQ9+2D is not properly specified (even for a joke language), but commands it adds remind me 2D Turing-machine, so called Langton's ant. I want to implement and play with different Turing-machines, but later.

Later I will also look through the list of joke languages. For example, the first there is a 'language' 99, which just prints out '99 bottles of beer' song. Anyways, I hope, there could be something exciting in the list.

Problem 4 ver. 4: optimization

December 18th, 2009 by Ivan Lakhturov | 0 Category: Programming | Tags: |

Find the largest palindrome made from the product of two 3-digit numbers.

And the last scratch for now. It is possible to prove that 11 divides a palindromic number. Indeed,

N = \sum_{i=0}^k (10^{2k-i+1} d_i + 10^i d_i) = \sum 10^i d_i (10^{2(k-i)+1} + 1) = \sum 10^i d_i m_i

and here m_i is a multiple of 11 (divisibility by 11 criterion).

The factor 11 can belong to a - and in this case we step just 1 in b. But if 11 doesn't divide a, then we can increase b by 11 each time.

  1.         (define (find-largest-palindrome-using-11 k)
  2.            (let ([m (- (^ 10 k) 1)] [m/10 (^ 10 (- k 1))])
  3.              (let ([m-11 (* 11 (div m 11))])
  4.                (define (iter a b largest-palindrome)
  5.                  (if (< a m/10) largest-palindrome
  6.                      (let ([step (if (= 0 (mod a 11)) 1 11)]
  7.                            [next-a-11? (= 0 (mod (- a 1) 11))])
  8.                        (if (< b m/10) (iter (- a 1) (if next-a-11? m m-11) largest-palindrome)
  9.                            (let ([n (* a b)])
  10.                              (if (<= n largest-palindrome) (iter (- a 1) m largest-palindrome)
  11.                                  (if (palindrome-number? n) (iter (- a 1) m n)
  12.                                      (iter a (- b step) largest-palindrome))))))))
  13.                (iter m m 0))))

This speeds up the previous result around ten times, leaving an asymptotic behavior the same. The memory use is the same O(1).

Let's look at results:
k = 2 => N = 9009
k = 3 => N = 906609
k = 4 => N = 99000099
k = 5 => N = 9966006699
k = 6 => N = 999000000999
k = 7 => N = 99956644665999
k = 8 => N = 9999000000009999
We could improve our algo drastically, if proven that the sought-for palindrome is less or equal n - \sqrt n (and mirrored). I have the feeling that for even k it is equal. But I don't know how to prove it. (I calculated for k = 10 and this does not hold, N = 99999834000043899999).

Problem 4 ver. 3: optimization

December 17th, 2009 by Ivan Lakhturov | 0 Category: Programming | Tags: |

Find the largest palindrome made from the product of two 3-digit numbers.

An author, however, advises a simpler approach. As we are looking for a palindrome a*b, let's iterate a and b in a top-down direction. After finding some palindrome, impose it as a top boundary for palindromes, that is, iterating in the inner loop for b, we stop when a*b cannot be large than that anymore. If we found a new palindrome, it will replace the boundary. Stop condition is finishing the outer loop in a, i.e. when it drops to 2-digits number (k-1, generally speaking).

  1.         (define (find-largest-palindrome-with-cutoffs k)
  2.            (let ([m (- (^ 10 k) 1)] [m/10 (^ 10 (- k 1))])
  3.              (define (iter a b largest-palindrome)
  4.                (if (< a m/10) largest-palindrome
  5.                    (if (< b m/10) (iter (- a 1) m largest-palindrome)
  6.                        (let ([n (* a b)])
  7.                          (if (<= n largest-palindrome) (iter (- a 1) m largest-palindrome)
  8.                              (if (palindrome-number? n) (iter (- a 1) m n)
  9.                                  (iter a (- b 1) largest-palindrome)))))))
  10.              (iter m m 0)))

Complexity in memory now is just O(1). Performance complexity by my impression is better than in the previous variant. The outer loop has n - n/10 steps, so it cannot be less than O(n). Assuming that a desired palindrome (left half of it, actually) lies close to n - \sqrt n (which should be proved, strictly speaking), we make no more than n \cdot \sqrt n = n^{3/2} operations until find it, and no more than the same n^{3/2} afterwards.

This is the worst case, however, and I hope that we find some worse-than-ideal palindrome quick enough. Suppose, we can use the estimate n - \sqrt n ab origin, i.e. the inequality f \cdot g < \sqrt n \cdot \sqrt n = n holds, where f = n - a, g = n - b. Then we can calculate an estimate of operations as area under a curve y = n / x:

\int_1^n \frac n x dx = n \cdot \ln n

So, the actual algo performance is between O(n \ln n) and O(n^\frac 3 2).

Problem 4 ver. 2: optimization

November 29th, 2009 by Ivan Lakhturov | 0 Category: Programming | Tags: |

Find the largest palindrome made from the product of two 3-digit numbers.

Last time we had a straightforward algo with O(n^2) complexity and at least O(n) memory use. Now let's enhance that. Instead of iterating over multipliers it's reasonable to iterate over palindromes, starting from the largest. I.e. over sequence 999999, 998899, 997799, and so on.

Remark. The largest product of two 3-digit numbers is 999 * 999 = 998001. So, in principle, we could start from the palindrome 997799. But this saves just 2 iterations.

Having a palindrome m, we factorize it and look at all the subsets of the factorization. Assume, we have one subset already. Let's name the product of those factors as p. If this number p has k digits (k = 3 for now) and the number m/p has k digits, than we found the palindrome, which is a product of two k-digit numbers.

In Scheme that will be written as:

  1.         (define (find-largest-palindrome-via-factorization k)
  2.            (define (correct-length? m) (= (length (digits m)) k))
  3.            (define (iter l) (let* ([n (make-number-from-digits (append (reverse l) l))]
  4.                                    [factors (map mul-list (subsets (factorize n minimal-factor-sqrt-complexity)))]
  5.                                    [factors (filter correct-length? factors)]
  6.                                    [factors (filter (lambda (m) (correct-length? (/ n m))) factors)])
  7.                               (if (null? factors) (iter (digits (- (make-number-from-digits l) 1))) n)))
  8.            ;(display (list n '= (car factors) '* (/ n (car factors)))))))
  9.            (iter (one-number-multiple-times 9 k)))

Here I used a few new util functions:

  1.         (define (make-number-from-radix list k)
  2.            (define (iter l f) (if (null? l) 0 (+ (* (car l) f) (iter (cdr l) (* f k)))))
  3.            (iter list 1))
  4.          (define (make-number-from-digits list) (make-number-from-radix list 10))

which make numbers out of their base-k representation.

Complexity now is hard to calculate. The worst case scenario gives quite a bad upper boundary. However, the worst case will never be realized.

Looking at what it gives out (9009, 906609, 99000099, 9966006699, 999000000999, ...), I could guess that the required palindrome is found after roughly \sqrt n iterations. So, in total I hope for less than O(n^2) complexity.

The memory use depends on factorizations - we store one whenever a palindrome is taken and lose it when proceed with the next palindrome.

All subsets of a set

July 2nd, 2009 by Ivan Lakhturov | 3 comments Category: Programming | Tags: |

As I already posted in Scheme, a function computing all subsets of a set would be:

  1. #!r6rs
  2. (import (rnrs))
  4. (define (subsets set)
  5.   (define (recursion set rest) (if (null? set) (list rest)
  6.                                    (let ([head (car set)] [tail (cdr set)])
  7.                                      (append (recursion tail rest) (recursion tail (cons head rest))))))
  8.   (recursion set '()))
  10. (display (subsets '(a b c d)))

The same in Haskell:

  1. s = "abcd"
  3. subsets s = ssets (s) []
  4. ssets [] r = [reverse(r)]
  5. ssets (x:xx) r = ssets xx r ++ ssets xx (x:r)
  7. main = do
  8.         putStrLn " Set: "
  9.         print s
  11.         putStrLn " Subsets: "
  12.         print (subsets s)

For imperative languages I'd rather prefer bitwise approach. Here is in C#:

  1. using System;
  3. namespace Subsets
  4. {
  5.     class Program
  6.     {
  7.         static void Main()
  8.         {
  9.             string elements = "abcd";
  10.             for (ulong i = 0; i < Math.Pow(2, elements.Length); i++)
  11.             {
  12.                 ulong set = i;
  13.                 for (int j = 0; j < elements.Length; j++, set >>= 1)
  14.                     if ((set & 0x01) == 1)
  15.                         Console.Write(elements[j]);
  16.                 Console.WriteLine();
  17.             }
  18.         }
  19.     }
  20. }

Problem 2 ver. 2, 3, 4: logarithmic complexity

April 17th, 2009 by Ivan Lakhturov | 0 Category: Programming | Tags: |

Find the sum of all the even-valued terms in the Fibonacci sequence which do not exceed four million

The last time we had the straightforward O(n) solution: building a sequence, filtering out even values and adding them. We can improve a bit, noticing that actually, every third member of the Fibonacci sequence is even. We don't check then for evennes, but just jump over three components each time. This version 2 (I don't publish it here) should be several times faster, but still is O(n) in performance.

We can also express a member of the Fibonacci sequence via the third and sixth members from behind: F_{n} = 4 F_{n-3} + F_{n-6} and compute those values as the values of a new sequence: E_n = 4 E_{n-1} + E_{n-2}. This version 3 is essentially the same as the previous one and again, I don't publish it here.

The drastic improvement is obtained using the expression \sum_{k=0}^{n} F_{3k} = \frac{F_{3n+2}-1}{2} (I've added it and a proof to the wikipedia article, but they immediately reverted my changes as "unsourced" --- this is pathetic). Now the sum is obtained just computing one Fibonacci member, and this can be done with O(log n).

Indeed, we can compute a Fibonacci member exponentiating the appropriate matrix, and this exponentiation, just like usual one, can be done with O(log n). I prefer this solution over using the golden ratio exponentiation formula (again logarithmic complexity), because only integer-operations are involved. So, this is the version 4 of the solution.

  1.         (define (fibonacci-member-logarithmic n) (matrix-2d-a12 (^-2d fibonacci-matrix n)))
  2.          (define (fibonacci-sum-even n) (/ (- (fibonacci-member-logarithmic (+ n 2)) 1) 2))

I quickly outlined a class for 2D matrices and operations with it:

  1.         (define-record-type matrix-2d (fields a11 a12 a21 a22))
  2.          (define identity-matrix-2d (make-matrix-2d 1 0 0 1))
  3.          (define fibonacci-matrix (make-matrix-2d 1 1 1 0))
  4.          (define (*-2d A B) (let ([a11 (matrix-2d-a11 A)]
  5.                                   [a12 (matrix-2d-a12 A)]
  6.                                   [a21 (matrix-2d-a21 A)]
  7.                                   [a22 (matrix-2d-a22 A)]
  8.                                   [b11 (matrix-2d-a11 B)]
  9.                                   [b12 (matrix-2d-a12 B)]
  10.                                   [b21 (matrix-2d-a21 B)]
  11.                                   [b22 (matrix-2d-a22 B)])
  12.                               (make-matrix-2d (+ (* a11 b11) (* a12 b21)) (+ (* a11 b12) (* a12 b22))
  13.                                               (+ (* a21 b11) (* a22 b21)) (+ (* a21 b12) (* a22 b22)))))
  14.          (define (^-2d-linear A n) (apply-n-times identity-matrix-2d n (lambda (x) (*-2d x A))))
  15.          (define (^-2d-logarithmic A n) (if (= n 0) identity-matrix-2d
  16.                                             (if (odd? n) (*-2d A (^-2d-logarithmic A (- n 1)))
  17.                                                 (let ([B (^-2d-logarithmic A (div n 2))]) (*-2d B B)))))
  18.          (define ^-2d ^-2d-logarithmic)

The solution is O(1) in memory and O(log n) in performance - of course, where n denotes the index of a number in the Fibonacci sequence. And we have been questioned about the cutset, where members of a sequence are less than certain number. Then an additional function (closest-fibonacci-index) comes in handy (see the wiki for explanation):

  1.         (define golden-ratio (/ (+ 1 (sqrt 5)) 2))
  2.          (define (closest-fibonacci-index f) (round (log (* f (sqrt 5)) golden-ratio)))
  3. (define (solution-2-optimized-3 n) (fibonacci-sum-even (closest-fibonacci-index n)))

The final touch is asking ourselves about complexity of the (log) function. Well, it can be computed fast enough not to spoil complexity of the algo's main part.

Problem 1 ver. 3: optimization

April 5th, 2009 by Ivan Lakhturov | 0 Category: Programming | Tags: |

Find the sum of all the multiples of 3 or 5 below 1000.

Let us generalize again to a finite set of factors.

There is a formula for the power of finite sets

|A \bigcup B| = |A| + |B| - |A \bigcap B|

which can be generalized to a finite number of finite sets

p(\bigcup\limits_i^n A_i) = \sum\limits_{i_1} p(A_{i_1}) - \sum\limits_{i_1,i_2} p(A_{i_1} \bigcap A_{i_2}) + \sum\limits_{i_1,i_2,i_3} p(A_{i_1} \bigcap A_{i_2} \bigcap A_{i_3}) - ... + (-1)^{n-1} p(\bigcap\limits_i^n A_i)

or in a somewhat less understandable, but concise notation

p(\bigcup\limits_i^n A_i) = \sum\limits_{\alpha \in 2^{\mathbb{N}_n}} (-1)^{|\alpha|-1} p(\bigcap\limits_{j \in \alpha} A_j)

Here p(...) is a measure (i.e. it commutes with the union sign) and can be replaced with |...| --- power of a set sign or, if we are in the natural numbers space, with the sum of elements sign, as in our case. \alpha is not a multiindex, but a subset of the natural numbers cut from 1 to n.

Now by \bigcup_{i=1}^n A_i we denote the set of all the multiples of factors f_i, less than certain number N, where i varies from 1 to n (each A_i is respectively the set of multiples of a factor f_i). We use the above-mentioned formula to compute the measure of the union \bigcup_{i=1}^n A_i via measures of all A_i and measures of all finite intersections of them.

Suppose, we have a number a, prime or not, and the set of all it's multiples A (they include only numbers less than N). Power of this set is of course N \div a (div operation) and the sum of its members can be calculated by the well-known formula for the sum of an arithmetic progression.

As regards all the intersections, it is understandable that we ought to calculate the least common multiple (LCM) of taken factors, and the set-intersection of their multiples will be just a set of its multiples. However, the current version of the solution assumes that we take primes as factors, then the LCM of them is just their product. When I calculate proper LCM in Problem 5 (up to now there is a bruteforce version), I will switch the temp version to it.

Let's see the solution. New util functions:

  1. (define (mul-list list) (fold-left * 1 list))
  2. (define (^ base power) (expt base power))
  3. (define (sum-arithmetic-progression first step n) (/ (* n (+ (* 2 first) (* step (- n 1)))) 2))

The function that calculates subsets of a set:

  1. (define (subsets set)
  2.   (define (recursion set rest) (if (null? set) (list rest)
  3.                                    (let ([head (car set)] [tail (cdr set)])
  4.                                      (append (recursion tail rest) (recursion tail (cons head rest))))))
  5.   (recursion set '()))

Important thing about this function is that it returns the empty set as the first element and the full set as the last element of a result list, all other subsets are in between. The number of subsets of a finite subset is just 2^n, so the complexity is O(2^n) --- it would be better visible with an imperative-iterative version of this function (I'm not posting it here). As regards memory, the function generates all the subsets as lists which in whole contain \sum_{k=1}^n k C^n_k = n 2^{n-1} elements (strange, this neat formula isn't on Wikipedia yet, I should add it there), that is the memory load is O(n 2^n). This is a not-so-good idea to load everything into memory, as we can rewrite this function (and the function that is down here in the post) iteratively with O(n) memory complexity --- taking advantage of combinadics, but for now I am satisfied enough with this version.

Using the formula above the solution now as simple as

  1. (define (sum-multiples-less-than n divisors)
  2.   (define (sum-of-one factor) (sum-arithmetic-progression factor factor (div n factor)))
  3.   (define (lcm-temp factors) (if (null? factors) 0 (mul-list factors)))
  4.   (define (measure subset) (* (^ (- 1) (+ (length subset) 1)) (sum-of-one (lcm-temp subset))))
  5.   (sum-list (map measure (cdr (subsets divisors)))))

With that (cdr) I cut off the empty subset, whose measure is zero (otherwise the (sum-of-one) function has to be a bit more complex).

Let's be careful with notation: n here is actually not the same n, as in the (subsets) function, but the number N up there, the maximum of our multiples-sets. The performance complexity depends on k and N, but we are interested only in complexity, depending on N. Let's assume that k is small comparing to N, which should be the usual case. Then the complexity is roughly speaking O(1), doesn't depend on N, as we wanted (I remind that in the previous version we had O(N) complexity).

The final touches are the regression tests:

  1. (assert (=
  2.          (sum-list (multiples-less-than-bruteforce 10 '(3 5)))
  3.          (sum-multiples-less-than 10 '(3 5))))
  4. (assert (=
  5.          (sum-list (multiples-less-than-bruteforce 1000 '(3 5)))
  6.          (sum-multiples-less-than 1000 '(3 5))))
  7. (assert (=
  8.          (sum-list (multiples-less-than-bruteforce 10000 '(3 5 7 19)))
  9.          (sum-multiples-less-than 10000 '(3 5 7 19))))
  10. ;(assert (=
  11. ;        (sum-list (multiples-less-than-bruteforce 1000 '(3 5 15)))
  12. ;       (sum-multiples-less-than 1000 '(3 5 15))))

The last commented one breaks, of course, as 15 is not prime - the LCM algo should be updated still.

Learned a bit about PLT-Scheme

March 20th, 2009 by Ivan Lakhturov | 0 Category: Programming | Tags:

I've looked through the Quick: An Introduction to PLT Scheme with Pictures document. And what I've learned is:

  • There is a library (#lang slideshow) embedded into PLT-Scheme, which provides some easy-to-use graphic primitives and a GUI library (scheme/gui/base). The first can be used for drawing on GUI's canvases.
  • There is an OOP library (scheme/class). I should look what's the backbone later.
  • PLT has the distribution system for libraries. The first eval of (require (planet something)) downloads from the PLaneT server and caches 'something' locally.

The last is quite nice, I should run through that server and look which libraries are actually implemented.