Programming Corner from Icon Newsletter 25

Pattern Words

procedure patword(s)   # Solution 1
   static letters

   initial letters := string(&lcase)

   out := "" every c := !s do
      if not find(c,out) then out ||:= c
   return map(s, out, letters[1+:*out]))
end

procedure patword(s)   # Solution 2
   local numbering, orderS, orderset, patlbls
   static labels, revnum
   initial {
      labels := &lcase || &lcase
      revnum := reverse(&cset)
      }

# 1: Map each character of s into another character, such
# that the  new characters are in increasing order left
# to right (note that the map function chooses the
# rightmost character of its second argument so things
# must be reversed).

# 2: Map each of these new characters into contiguous
# letters.

   (numbering := revnum[1 : *s + 1]) |
      stop("word too long")
   orderS := map(s, reverse(s), numbering)
   rderset := string(cset(orderS))
   (patlbls := labels[1 : *orderset + 1]) |
      stop("too many characters")
   return map(orderS, orderset, patlbls)
end

procedure patword(s)   # Solution 3
   static backwards, letters

   initial {
      backwards := reverse(&ascii)
      letters := string(&lcase)
      }

   z := reverse(s)
   z := map(z,z,backwards[1:*z + 1])
   cz := cset(z)
   return reverse(map(z,cz,map(cz,cz,
     letters[1:*cz + 1])))
end

Solution 1    1.15
Solution 2    1.00
Solution 3    1.51

Environment Variables

procedure main()
   while s := read() do
      write(getenv(s))
end
procedure getenv(s)
   local pipe, line
   static environment

   initial {
      environment := table()
      pipe := open("printenv","pr")
      while line := read(pipe) do
         line ? environment[tab(upto('='))] :=
            (move(1),tab(0))
      close(pipe)
      }

   return \environment[s]
end

Benchmarking Icon Expressions

a1 := list(l000)
a2 := []
every 1 to 1000 do put(a2,&null)

a1[1]       0.1084
a1[1000]    0.1084
a2[1]       0.1084
a2[1000]    0.2914

Primes

Here is a sequence of modifications of the prime program in the last Newsletter. The first program is the original submission. After these are modifications that attempt to restrict the range of iteration for checking if the current number is composite. Although the latter programs look more cumbersome (a lot of co-expression creation and invocation), they are actually competitive in speed for large numbers of primes. This is probably due to the fact that the sieve is more discriminating than the simpler programs. (You can also contrast these programs with the sieve in sample programs distributed with UNIX Icon systems, which isn't lazy. It is much faster than any of these.)

procedure main()
   every write((i := 2) | (|i := i + 1) &
     (not(i = (2 to i) * (2 to i))) & i)
end

procedure main()
   every write(i := seq(2) &
      (not(i = (2 to i) * (2 to i))) & i)
end

procedure main()
   every write(i := seq(2) &
      (not(i = (l := (2 to i^0.5)) *
         (l to i))) & i)
end

procedure main()
   every write(i := seq(2) &
      (not (i = (k := 2 to i/(2))*
         (i/(k)))) & i)
end

This program produces the primes lazily using the basic sieve technique and co-expressions. Nested creation of co-expressions eats space and causes (co-expression?) stack overflow. This is a modified version of a program by Robert Henry, and is a translation of a Miranda program.

procedure main(arglist)
   every write(sieve(create seq(2)))
end

procedure modcheck(s, p)
   repeat if ((x := @s) % p) ~= 0
   then suspend x
end

procedure sieve(e)
   suspend (p := @e)
   every suspend sieve(create modcheck(e, p)) end

procedure main(arglist)
   every write(sieve(create seq(2)))
end

Here's a modified version of the sieve program. Elimination of tail recursion in the sieve lets the program run longer than the more straightforward version of this program.

procedure main()
   every write(sieve(create seq(2)))
end

# Check that every value in s is relatively
# prime to p

procedure modcheck(s, p)
   while x := @s do if (x % p) ~= 0
   then suspend x
end

# Sieve of Eratothsenes, sans tail recursion

procedure sieve(e)
   repeat {
      suspend p := @e
      e := create modcheck(e, p)
      }
end

And here's the one from the distributed sample programs:

# This program illustrates the use of sets in
# implementing the classical sieve algorithm
# for computing prime numbers.

procedure main(arglist)
   local limit, s, i

   limit := arglist[1] | 100
   s := set([])
   every member(s,i := 2 to limit) do
      every delete(s,i + i to limit by i)
   primes := sort(s)
   write("There are ",*primes,
     " primes in the first ",limit,"
        integers.")
   write("The primes are:")
   every write(right(!primes,*limit + 1))
end

Queens Never Die

global n, solution

procedure main(args)
   local i

   n := args[1] | 8      # 8 queens by default
   if not(0 < integer(n)) then stop("usage [ n ]")
   solution := list(n)   # a list of column solutions
   write(n,"-Queens:")
   every show(q(1))      # show the result
end

# q(c) -- place queens in columns c through n in all
# possible ways. Suspend with a list of row positions
# for columns c through n

procedure q(c)
   local r
   static up, down, rows

   initial {
      up := list(2*n-1,0)
      down := list(2*n-1,0)
      rows := list(n,0)
      }
   every (r := 1 to n,if 0 = rows[r] = up[n+(r-c)] =
      down[r+c-1] then rows[r] <- up[n+(r-c)] <-
      down[r+c-1] <- 1) do suspend {
         if c = n then [r] else [r] ||| q(c + 1)
      }
end
# Show the solution on a chess board. The argument is
# a list of row positions for columns 1 through n.

procedure show(solution)
   static count, line, border
   initial {
      count := 0
      line := repl("| ",n) || "|"
      border := repl("----",n) || "-"
      }

   write("solution: ", count+:=1)
   write(" ", border)
   every line[4*(!solution -- 1) + 3] <- "Q" do {
      write(" ", line)
      write(" ", border)
      }
   write()
end