🎉 Exercism Research is now launched. Help Exercism, help science and have some fun at research.exercism.io 🎉
Sign up Log in
Avatar of glennj

glennj's solution

to List Ops in the Tcl Track

Published at Mar 06 2020 · 0 comments
Instructions
Test suite
Solution

Note:

This exercise has changed since this solution was written.

Implement basic list operations.

In functional languages list operations like length, map, and reduce are very common. Implement a series of basic list operations, without using existing functions.

The precise number and names of the operations to be implemented will be track dependent to avoid conflicts with existing names, but the general operations you will implement include:

  • append (given two lists, add all items in the second list to the end of the first list);
  • concatenate (given a series of lists, combine all items in all lists into one flattened list);
  • filter (given a predicate and a list, return the list of all items for which predicate(item) is True);
  • length (given a list, return the total number of items within it);
  • map (given a function and a list, return the list of the results of applying function(item) on all items);
  • foldl (given a function, a list, and initial accumulator, fold (reduce) each item into the accumulator from the left using function(accumulator, item));
  • foldr (given a function, a list, and an initial accumulator, fold (reduce) each item into the accumulator from the right using function(item, accumulator));
  • reverse (given a list, return a list with all the original items, but in reversed order);

The Tcl apply command

The test cases may look confusing. You are expected to implement this:

set myList {alpha beta gamma delta}
listOps::filter $myList {{word} {expr {[string length $word] == 4}}

Why does that last argument have so many braces?

Recall that the proc command is defined as:

proc procName argList body

Tcl has an apply command:

apply func ?arg1 arg2 ...?

this "func" is a two element list {argList body} that is essentially an anonymous proc (or "lambda"). The apply command invokes that anonymous proc, passing it the arguments it needs.

As an example, these are equivalent:

# using proc
proc myReverse {str} {return [string reverse $str]}
puts [myReverse "Hello, World!"]

# using apply
puts [apply {{str} {string reverse $str}} "Hello, World!"]

# or, store the func in a variable
set func {{str} {string reverse $str}}
puts [apply $func "Hello, World!"]

Using apply makes it simpler to pass around blocks of code.

Ref: apply, proc.

Submitting Incomplete Solutions

It's possible to submit an incomplete solution so you can see how others have completed the exercise.

Running the tests

To run the test suite, execute one of the following commands:

tclsh list-ops.test            # Will stop testing after the first failure.
RUN_ALL=1 tclsh list-ops.test  # Will run all tests and report all failures.

Feedback, Issues, Pull Requests

The exercism/tcl repository on GitHub is the home for all of the Tcl exercises on Exercism.

If you have feedback about an exercise, or want to help implementing a new one, head over there and create an issue. We'll do our best to help you!

Source

list-ops.test

#!/usr/bin/env tclsh
set version 2.4.0
package require tcltest
namespace import ::tcltest::*
source "list-ops.tcl"

proc fail_fast {} {
    return [expr {
        ![info exists ::env(RUN_ALL)]
        || [string is boolean -strict $::env(RUN_ALL)]
        && !$::env(RUN_ALL)
    }]
}

proc failed {} {
    return [expr {$::tcltest::numTests(Failed) > 0}]
}

if {[fail_fast]} {
    proc test args {
        if {[failed]} {::tcltest::configure -skip *}
        uplevel [list ::tcltest::test {*}$args]
    }
}

proc cleanupTests {} {
    set failed [failed]
    uplevel 1 ::tcltest::cleanupTests
    if {$failed} {exit 1}
}

if {$::argv0 eq [info script]} {

    set appendCases {
        list-ops-1.1 "append empty lists" {} {} {}
        list-ops-1.1 "append empty list to list" {} {1 2 3 4} {1 2 3 4}
        list-ops-1.1 "append non-empty lists" {1 2} {2 3 4 5} {1 2 2 3 4 5}
    }

    foreach {name description list1 list2 result} $appendCases {
        test $name $description -body {
            listOps::append list1 $list2
            set list1
        } -returnCodes ok -result $result
    }

    set concatCases {
        list-ops-2.1 "concat empty list" {} {}
        list-ops-2.2 "concat list of lists" {{1 2} {3} {} {4 5 6}} {1 2 3 4 5 6}
        list-ops-2.3
            "concat list of nested lists"
            {{{1} {2}} {{3}} {{}} {{4 5 6}}}
            {1 2 3 {} {4 5 6}}
    }

    foreach {name description lists result} $concatCases {
        test $name $description -body {
            listOps::concat $lists
        } -returnCodes ok -result $result
    }

    set filterCases {
        list-ops-3.1 "filter empty list" {} {x {expr {$x % 2 == 1}}} {}
        list-ops-3.2 "filter non-empty list" {1 2 3 5} {x {expr {$x % 2 == 1}}} {1 3 5}
    }

    foreach {name description list func result} $filterCases {
        test $name $description -body {
            listOps::filter $list $func
        } -returnCodes ok -result $result
    }

    set lengthCases {
        list-ops-4.1 "length empty list" {} 0
        list-ops-4.2 "length non-empty list" {1 2 3 4} 4
    }

    foreach {name description list result} $lengthCases {
        test $name $description -body {
            listOps::length $list
        } -returnCodes ok -result $result
    }

    set mapCases {
        list-ops-5.1 "map empty list" {} {x {expr {$x + 1}}} {}
        list-ops-5.2 "map non-empty list" {1 3 5 7} {x {expr {$x + 1}}} {2 4 6 8}
    }

    foreach {name description list func result} $mapCases {
        test $name $description -body {
            listOps::map $list $func
        } -returnCodes ok -result $result
    }

    set foldlCases {
        list-ops-6.1 "foldl empty list" {} 2 {{x y} {expr {$x * $y}}} 2
        list-ops-6.2
            "foldl direction independent function applied to non-empty list"
            {1 2 3 4} 5 {{x y} {expr {$x + $y}}} 15
        list-ops-6.3
            "foldl direction dependent function applied to non-empty list"
            {2 5} 5 {{x y} {expr {$x / $y}}} 0
    }

    foreach {name description list initial func result} $foldlCases {
        test $name $description -body {
            listOps::foldl $list $initial $func
        } -returnCodes ok -result $result
    }

    set reverseCases {
        list-ops-7.1 "reverse empty list" {} {}
        list-ops-7.2 "reverse non-empty list" {1 3 5 7} {7 5 3 1}
        list-ops-7.3
            "reverse list of lists is not flattened"
            {{1 2} {3} {} {4 5 6}} {{4 5 6} {} 3 {1 2}}
    }

    foreach {name description list result} $reverseCases {
        test $name $description -body {
            listOps::reverse $list
        } -returnCodes ok -result $result
    }

    set foldrCases {
        list-ops-8.1 "foldr empty list" {} 2 {{x y} {expr {$x * $y}}} 2
        list-ops-8.2
          "foldr direction independent function applied to non-empty list"
          {1 2 3 4} 5 {{x y} {expr {$x + $y}}}
          15
        list-ops-8.3
          "foldr direction dependent function applied to non-empty list"
          {2 5} 5 {{x y} {expr {$x / $y}}} 2
    }

    foreach {name description list initial func result} $foldrCases {
        test $name $description -body {
            listOps::foldr $list $initial $func
        } -returnCodes ok -result $result
    }

    cleanupTests
}
# Trying to reuse these custom procs as much as possible.
#
# Core list functionality used:
# - `foreach` to iterate over a list
# - `{}` to construct an empty list
# - `list` to construct a list with elements
# - `{*}` to spread a list
#
namespace eval listOps {}

proc listOps::append {listname values} {
    upvar 1 $listname list
    set list [list {*}$list {*}$values]
}

proc listOps::foldl {list initial func} {
    set accum $initial
    foreach elem $list {
        set accum [uplevel 1 [list apply $func $accum $elem]]
    }
    return $accum
}

proc listOps::foldr {list initial func} {
    set accum $initial
    foreach elem [listOps::reverse $list] {
        set accum [uplevel 1 [list apply $func $elem $accum]]
        # order of args is swapped:            ^^^^^ ^^^^^^
    }
    return $accum
}

# just about everything else can be implemented with foldl

proc listOps::reverse {list} {
    listOps::foldl $list {} {{reversed elem} {
        list $elem {*}$reversed
    }}
}

proc listOps::concat {listOfLists} {
    listOps::foldl $listOfLists {} {{accum list} {
        listOps::append accum $list
        set accum
    }}
}

proc listOps::length {list} {
    listOps::foldl $list 0 {{len _} {expr {$len + 1}}}
}

proc listOps::filter {list func} {
    # ugh,  a bit of quoting hell here: we want to substitute 
    # this proc's $func but we have to protect the elem variable
    # and all the command substitutions.
    #
    # using a string template and the `format` command.
    #
    set foldFunc {{filtered elem} {
        if {[uplevel 1 [list apply {%s} $elem]]} {
            listOps::append filtered $elem
        }
        set filtered
    }}

    listOps::foldl $list {} [format $foldFunc $func]

    # the more straightforward way to do it
    #
    ## set filtered {}
    ## foreach elem $list {
    ##     if {[uplevel 1 [list apply $func $elem]]} {
    ##         listOps::append filtered $elem
    ##     }
    ## }
    ## return $filtered
}

proc listOps::map {list func} {
    # same commentary as above
    set foldFunc {{mapped elem} {
        listOps::append mapped [uplevel 1 [list apply {%s} $elem]]
        set mapped
    }}

    listOps::foldl $list {} [format $foldFunc $func]

    # the more straightforward way to do it
    #
    ## set mapped {}
    ## foreach elem $list {
    ##     listOps::append mapped [uplevel 1 [list apply $func $elem]]
    ## }
    ## return $mapped
}

Community comments

Find this solution interesting? Ask the author a question to learn more.

What can you learn from this solution?

A huge amount can be learned from reading other people’s code. This is why we wanted to give exercism users the option of making their solutions public.

Here are some questions to help you reflect on this solution and learn the most from it.

  • What compromises have been made?
  • Are there new concepts here that you could read more about to improve your understanding?