Page 3 of 4 FirstFirst 1234 LastLast
Results 21 to 30 of 37

Thread: Beginners Programming Challenge #20

  1. #21
    Join Date
    Feb 2011
    Location
    Cambridge, ON, CAN
    Beans
    105
    Distro
    Ubuntu 10.10 Maverick Meerkat

    Re: Beginners Programming Challenge #20

    That's very interesting. I've been starting to look at Haskell a little bit, and this gives me all the more reason to progress with it. Thanks for the time guys.

  2. #22
    Join Date
    Apr 2007
    Location
    NorCal
    Beans
    1,149
    Distro
    Ubuntu 10.04 Lucid Lynx

    Re: Beginners Programming Challenge #20

    Quote Originally Posted by andrew1992 View Post
    That's very interesting. I've been starting to look at Haskell a little bit, and this gives me all the more reason to progress with it. Thanks for the time guys.
    Haskell is a very interesting language. Check out Learn You a Haskell for Great Good! for a pretty straightforward introduction.
    Posting code? Use the [code] or [php] tags.
    I don't care, I'm still free. You can't take the sky from me.

  3. #23
    Join Date
    Feb 2009
    Beans
    524
    Distro
    Ubuntu 12.04 Precise Pangolin

    Re: Beginners Programming Challenge #20

    Quote Originally Posted by andrew1992 View Post
    Your example doesn't help me see why those initial values are needed. Let's say you want to take the product of all the values in a list [1, 2, 3, 4, 5]. With my algorithm, an initial value isn't necessary.

    [1, 2, 3, 4, 5]
    [2, 3, 4, 5]
    [6, 4, 5]
    [24, 5]
    120
    In addition to what others have said, what happens if the list passed to your function is the empty list?

    Reduce functions that specify an initial value just return the initial value in that case.

  4. #24
    Join Date
    Feb 2009
    Beans
    524
    Distro
    Ubuntu 12.04 Precise Pangolin

    Re: Beginners Programming Challenge #20

    Here's an implementation in Haskell with filter, map, reverse (returns the list passed to it in opposite order), and a factorial function all implemented in terms of reduce.

    (filter, map, and reverse are all already functions in Haskell Prelude, so I've added ' to the function names to distinguish them from the native versions).

    Code:
    main = do
            print (reduce (+) 0 [1..5]) {-add the numbers from 1 to 5-}
            print (filter' odd [1..10]) {-print the odd numbers 1<=n<=10-}
            print (map' (\x -> x*x) [1..10]) {-Print the squares of 1 to 10-}
            print (reverse' [1..10]) {-Print 1 to 10 in reverse order-}
            print (map' fac [0..9]) {-Print n factorial for 0<=n<=9-}
    
    reduce :: (a -> b -> a) -> a -> [b] -> a
    reduce _ i [] = i
    reduce f i (x:xs) = reduce f (f i x) xs
    
    filter' :: (a -> Bool) -> [a] -> [a]
    filter' f xs = reduce (\ys y -> if f y then ys ++ [y] else ys) [] xs
    
    map' :: (a -> b) -> [a] -> [b]
    map' f xs = reduce (\ys y -> ys ++ [(f y)]) [] xs
    
    reverse' :: [a] -> [a]
    reverse' xs = reduce (\ys y -> y:ys) [] xs
    
    fac :: Integer -> Integer
    fac x = reduce (*) 1 [1..x]

  5. #25
    Join Date
    Apr 2007
    Location
    NorCal
    Beans
    1,149
    Distro
    Ubuntu 10.04 Lucid Lynx

    Re: Beginners Programming Challenge #20

    A bump for more entries. Would anyone who's already made an entry like to try the extra credit?
    Posting code? Use the [code] or [php] tags.
    I don't care, I'm still free. You can't take the sky from me.

  6. #26
    Join Date
    Aug 2005
    Location
    Sweden
    Beans
    407

    Re: Beginners Programming Challenge #20

    gforth implementation, gforth does not have a list type, so I had to implement
    one.

    Most list operations are done through maps, but note that there are
    more than one type of map. Those that modifies the list, and those
    that leave the list unmodified, like the map used for printing the
    contents of a list.
    Reduce is also done with a non-modifying map, but where the function that is applied takes two values from the stack* and leaves one.
    In this way the first application of the function will operate on the
    initial value and the first element, and leave the result on the stack
    for the next iteration which will consume the previous result and the second
    value in the list ...and so on...

    *Forth is a stack-based language

    Code:
    \ create a new node and pop the stack top
    \ into the payload cell
    : +>node ( n -- a )
        3 cells allocate throw
        ( n a )
        0 over cell+ !
        0 over 2 cells + !
        dup -rot !
    ;
    
    \ get the previous node address
    : node- ( a[i] -- a[i-1] )
        dup if cell+ @ then
    ;
    
    \ get the next node address
    : node+ ( a[i] -- a[i+1] )
        dup if 2 cells + @ then
    ;
    
    \ link two nodes together so that they point at each other
    : cons ( a[i] a[i+1] -- a[i+1] )
        dup if 2dup cell+ ! then
        over if 2dup swap 2 cells + ! then
        nip
    ;
    
    \ break the link between two nodes
    : uncons ( a[i] -- a[i-1] a[i] )
        dup node-
        dup if
            dup 2 cells + 0 swap !
        then
        swap
        dup if
            dup cell+ 0 swap !
        then
    ;
    
    \ loop node- until the first node is found
    : find-first ( a[i] -- a[0] )
        dup ( ai ai )
        begin
            nip dup ( ai ai )
            node- dup 0= ( ai ai-1 tf )
        until
        drop
    ;
    
    \ loop node+ until the last node is found
    : find-last ( a[i] -- a[N] )
        dup
        begin
            nip dup
            node+ dup 0=
        until
        drop
    ;
    
    \ uncons node from prev and next and free the node
    : -node ( a[i] -- a[i+1] )
        uncons node+ uncons ( a[i-1] a[i] a[i+1] )
        swap free throw ( a[i-1] a[i+1] )
        cons ( a[i+1] )
    ;
    
    \ apply an xt to all nodes in a list
    : map \ ( a xt( a -- a ) -- )
        begin
            dup >r ( a[i] xt / xt)
            execute ( a[i+1] / xt )
            r> over ( a[i+1] xt a[i+1] )
        0= until
        2drop
    ;
    
    \ Takes an xt (xti) with the stack effect ( n0 -- n1 )
    \ and return an xt (xto) with the stack effect ( a0 -- a1 )
    \ where a are node addresses.
    \ The xti is included in xto so that the xti is applied to
    \ the payload of a0 and the result (n1) is written back to a0
    \ then a node+ is executed yielding a1
    : rw-iter \ ( xt( n -- n ) -- xt( a -- a ) )
        >r :noname r>
            postpone dup postpone >r postpone @
            ( ... n ) compile, ( ... n )
            postpone r@ postpone !
            postpone r> postpone node+
        postpone ; postpone immediate
    ;
    
    \ same as rw-iter, but the expected stack effect of xti
    \ is ( n -- ) and no data is written back to the node
    \ good for printing the content of a list and such
    : ro-iter \ ( xt( n -- ) -- xt( a -- a ) )
        >r :noname r>
            postpone dup postpone >r postpone @
            ( ... n ) compile, ( ... )
            postpone r> postpone node+
        postpone ; postpone immediate
    ;
    
    \ also an iterator, but also expects another list node
    \ on the stack, if the xt returns nonzero, 
    \ creates a new node with the data of the examined one
    \ and conses the it onto this one
    : cons-filter-iter
        >r :noname r>
            postpone dup postpone >r postpone @
            ( ... n ) compile, ( ... n )
            postpone if
                postpone r@ postpone @
                postpone +>node
                postpone cons
            postpone then
            postpone r> postpone node+
        postpone ; postpone immediate
    ;
    
    \ print a list
    : .list ['] . [compile] ro-iter map ;
    
    \ add 1 to all the elements of a list
    : 1+list ['] 1+ [compile] rw-iter map ;
    
    \ delete a list
    : -list ['] -node map ;
    
    \ copies the elements for which the xt returns nonzero
    \ onto a new list
    : filter
        0 -rot [compile] cons-filter-iter map find-first
    ;
    
    \ applies the xt onto the initial argument and the
    \ first member of the list
    \ the xt on the result of the above and the second element
    \ ...
    : reduce ( a n xt -- n )
        [compile] ro-iter map
    ;
    
    : even 2 mod 0= ;
    
    : odd 2 mod 0<> ;
    
    \ creates a list
    : simple-list
        1 +>node
        26 2 do
            i +>node cons
        loop
        find-first
    ;
    
    \ creates a list of lists
    : list-of-lists
        11 +>node
        10 2 do
            10 i + +>node cons
        loop
        find-first
        +>node
        10 2 do
            10 i * 1 + +>node
            10 2 do
                10 j * i + +>node cons
            loop
            find-first +>node cons
        loop
        find-first
    ;
        
    
    \ examples
    
    
    simple-list
    ." the contents of the test list:" cr
    dup .list cr cr
    
    ." the even elements in the list:" cr
    dup ' even filter
    dup .list -list \ the result list is also freed from memory
    cr cr
    
    ." the even elements in the list:" cr
    dup ' odd filter
    dup .list -list
    cr cr
    
    ." the sum of the elements of the list:" cr
    0 over ' + reduce . cr cr
    
    ." the product of the elements of the list:" cr
    1 over ' * reduce . cr cr
    
    ." mapping a function that increases the values in the list" cr
    dup ' 1+ rw-iter map
    dup .list cr cr
    
    -list
    
    
    list-of-lists
    
    \ the same as .list but with a carriage return on the end
    : .row .list cr ;
    
    ." look! here we map another map on a list of lists :)" cr
    dup ' .row ro-iter map cr
    
    \ freeing the data is a question of first deleting the inner lists
    dup ' -list ro-iter map
    -list
    Shell/Output:
    Code:
    leo@patternmaker:~/prog/forth
    $ gforth challenge20.fs
    the contents of the test list:
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 
    
    the even elements in the list:
    2 4 6 8 10 12 14 16 18 20 22 24 
    
    the even elements in the list:
    1 3 5 7 9 11 13 15 17 19 21 23 25 
    
    the sum of the elements of the list:
    325 
    
    the product of the elements of the list:
    2076180480 
    
    mapping a function that increases the values in the list
    2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 
    
    look! here we map another map on a list of lists :)
    11 12 13 14 15 16 17 18 19 
    21 22 23 24 25 26 27 28 29 
    31 32 33 34 35 36 37 38 39 
    41 42 43 44 45 46 47 48 49 
    51 52 53 54 55 56 57 58 59 
    61 62 63 64 65 66 67 68 69 
    71 72 73 74 75 76 77 78 79 
    81 82 83 84 85 86 87 88 89 
    91 92 93 94 95 96 97 98 99 
    
    Gforth 0.7.0, Copyright (C) 1995-2008 Free Software Foundation, Inc.
    Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
    Type `bye' to exit
    Don't peach linux. Melon it!

  7. #27
    Join Date
    Apr 2007
    Location
    NorCal
    Beans
    1,149
    Distro
    Ubuntu 10.04 Lucid Lynx

    Re: Beginners Programming Challenge #20

    Quote Originally Posted by red_Marvin View Post
    gforth implementation, gforth does not have a list type, so I had to implement
    one.
    I don't know forth myself, but I've got a friend whose opinion I trust that I'll ask to take a look at this when judging comes around.
    Posting code? Use the [code] or [php] tags.
    I don't care, I'm still free. You can't take the sky from me.

  8. #28
    Join Date
    Aug 2005
    Location
    Sweden
    Beans
    407

    Re: Beginners Programming Challenge #20

    He will probably say it is very horrible!
    Don't peach linux. Melon it!

  9. #29
    Join Date
    Apr 2007
    Location
    NorCal
    Beans
    1,149
    Distro
    Ubuntu 10.04 Lucid Lynx

    Re: Beginners Programming Challenge #20

    Quote Originally Posted by red_Marvin View Post
    He will probably say it is very horrible!
    If you won again, they'd probably think we're colluding.
    Posting code? Use the [code] or [php] tags.
    I don't care, I'm still free. You can't take the sky from me.

  10. #30

    Re: Beginners Programming Challenge #20

    common lisp has remove-if-not,

    my own implementation

    Code:
    (defun filter (fn lst)
      (cond ((null (car lst)) nil)
            (t (cons (if (funcall fn (car lst))
                         (car lst))
                     (filter fn (cdr lst))))))
    another way of doing it (longer but more correct output)

    Code:
    (defun filter (fn lst)
      (let ((final nil))
        (labels ((main-loop (lst2)
                            (cond ((null (car lst2)) nil)
                                  ((funcall fn (car lst2))
                                   (push (car lst2) final)
                                   (main-loop (cdr lst2)))
                                  (t (main-loop (cdr lst2))))))
          (main-loop lst))
        (reverse final)))
    reduce (must have a start value):

    Code:
    (defun reduc (fn lst start)
      (funcall fn (subseq lst start))
    extra credit:
    Code:
    (defun sum (lst)
      (cond ((null (car lst)) 0)
            (t (+ (car lst)
                  (sum (cdr lst))))))
    
    (defun cat (lsts)
      (let ((final-list nil))
        (mapcar (lambda (lst)
                  (mapcar (lambda (item)
                            (push item final-list))
                          lst))
                lsts)
        (reverse final-list)))
    
    (defun rev (lst)
      (let ((final-list nil))
        (mapcar (lambda (item)
                  (push item final-list))
                lst)
        final-list))
    Code:
    * (reduc #'sum '(1 2 3 4 5) 0)
    
    15
    * (reduc #'sum '(1 2 3 4 5) 2)
    
    12
    * (filter #'oddp '(1 2 3 4 5))
    
    (1 3 5)
    
    * (sum '(1 2 3 4 5))
    
    15
    * (cat '((1 2 3 4 5) (6 7 8 9 0)))
    
    (1 2 3 4 5 6 7 8 9 0)
    
    * (rev '(1 2 3 4 5))
    
    (5 4 3 2 1)
    Last edited by mo.reina; June 21st, 2011 at 12:36 PM.

Page 3 of 4 FirstFirst 1234 LastLast

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •