Blogged by Ujihisa. Standard methods of programming and thoughts including Clojure, Vim, LLVM, Haskell, Ruby and Mathematics written by a Japanese programmer. github/ujihisa

Saturday, October 13, 2012

Mergesort in Haskell, Clojure and Scheme

In Haskell

Mergesort requires O(1) index access so I used Data.Vector instead of List.

import qualified Data.Vector as V

-- length (sort2 x y) == 2
-- sorted (sort2 x y) is true
sort2 :: Ord a => a -> a -> V.Vector a
sort2 x y = if x < y then V.fromList [x, y] else V.fromList [y, x]

-- contract: sorted xs && sorted ys
-- length (merge xs ys) == length xs + length ys
-- sorted (merge xs ys) is true
merge :: Ord a => V.Vector a -> V.Vector a -> V.Vector a
merge xs ys = case (xs V.!? 0, ys V.!? 0) of
  (Nothing, _) -> ys
  (_, Nothing) -> xs
  (Just x, Just y) -> if x < y
    then x `V.cons` merge (V.tail xs) ys
    else y `V.cons` merge xs (V.tail ys)

-- length (mergeSort xs) == length xs
-- sorted (mergeSort xs) is true
mergeSort' :: Ord a => V.Vector a -> V.Vector a
mergeSort' xs = case V.length xs of
  0 -> xs
  1 -> xs
  2 -> sort2 (V.head xs) (V.last xs)
  otherwise -> let (a, b) = split2 xs in
               merge (mergeSort' a) (mergeSort' b)

mergeSort :: Ord a => [a] -> [a]
mergeSort = V.toList . mergeSort' . V.fromList


-- contract: length xs > 2
-- (a, b) = split2 xs => length a + length b == length xs
split2 :: Ord a => V.Vector a -> (V.Vector a, V.Vector a)
split2 xs = (V.take (V.length xs `div` 2) xs, V.drop (V.length xs `div` 2) xs)

main = do
  print $ mergeSort [3, 1, 4, 1, 5, 9, 2]

In Clojure

(defn sort2 [x y]
  (if (< x y) [x y] [y x]))

(defn merge2 [xs ys]
  (cond
    (empty? xs) ys
    (empty? ys) xs
    :else
    (let [x (first xs) y (first ys)]
      (if (< x y)
        (cons x (merge2 (rest xs) ys))
        (cons y (merge2 (rest ys) xs))))))

(defn merge-sort [xs]
  (cond
    (> 2 (count xs)) xs
    (= 2 (count xs)) (apply sort2 xs)
    :else (let [[a b] (split-at (/ (count xs) 2) xs)]
            (merge2 (merge-sort a) (merge-sort b)))))

(prn (merge-sort [3 1 4 1 5 9 2]))

Scheme (Gauche)

With List (slow)

(use srfi-1)

(define (sort2 x y)
  (if (< x y) (list x y) (list y x)))

(define (nil? xs)
  (eq? xs '()))

(define (merge2 xs ys)
  (cond
    ((nil? xs) ys)
    ((nil? ys) xs)
    ((let ((x (car xs))
           (y (car ys)))
       (if (< x y)
         (cons x (merge2 (cdr xs) ys))
         (cons y (merge2 xs (cdr ys))))))))

(define (merge-sort xs)
  (cond
    ((> 2 (length xs)) xs)
    ((= 2 (length xs)) (apply sort2 xs))
    ((receive (a b) (split-at xs (/ (length xs) 2))
       (merge2 (merge-sort a) (merge-sort b))))))

(print (merge-sort '(3 1 4 1 5 9 2 6)))

With Vector (fast)

(use srfi-43)

(define (sort2 x y)
  (if (< x y) (vector x y) (vector y x)))

(define (merge2 xs ys)
  (cond
    ((vector-empty? xs) ys)
    ((vector-empty? ys) xs)
    ((let ((x (~ xs 0))
           (y (~ ys 0)))
       (if (< x y)
         (vector-append (vector x) (merge2 (vector-copy xs 1 -1) ys))
         (vector-append (vector y) (merge2 xs (vector-copy ys 1 -1))))))))

(define (merge-sort xs)
  (cond
    ((> 2 (vector-length xs)) xs)
    ((= 2 (vector-length xs)) (sort2 (~ xs 0) (~ xs 1)))
    ((let ((a (vector-copy xs 0 (div (vector-length xs) 2)))
           (b (vector-copy xs (div (vector-length xs) 2) -1)))
       (merge2 (merge-sort a) (merge-sort b))))))

(print (merge-sort #(3 1 4 1 5 9 2 6)))

Tuesday, September 18, 2012

Quicksort in Lua

function rest(xs)
  local ys = {}
  for i = 2, #xs do
    table.insert(ys, xs[i])
  end
  return ys
end

function concat(xs, ys)
  local zs = {}
  for _, v in ipairs(xs) do
    table.insert(zs, v)
  end
  for _, v in ipairs(ys) do
    table.insert(zs, v)
  end
  return zs
end

function qsort(xs)
  if (#xs < 2) then
    return xs
  end
  local p, xs = xs[1], rest(xs)
  local lesser, greater = {}, {}
  for _, x in ipairs(xs) do
    if x < p then
      table.insert(lesser, x)
    else
      table.insert(greater, x)
    end
  end
  return concat(qsort(lesser), concat({p}, qsort(greater)))
end

xs = {3, 1, 4, 1, 5, 9}
for _, x in ipairs(qsort(xs)) do
  io.write(x .. ' ')
end
print()
-- to check if the original xs isn't destroyed
for _, x in ipairs(xs) do
  io.write(x .. ' ')
end

This works, but the code looks more complicated than it should be.

I rewrote it with using Underscore.lua and it made the code much easier to read.

_ = require 'underscore'

function concat(xs, ys)
  return _(ys):reduce(xs, function(m, x)
    return _(m):push(x)
  end)
end

function qsort(xs)
  if (#xs < 2) then
    return xs
  end
  local p, xs = xs[1], _(xs):rest()
  return concat(
    _(qsort(_(xs):select(function(x) return x < p end))):push(p),
    qsort(_(xs):select(function(x) return x >= p end)))
end

xs = {3, 1, 4, 1, 5, 9}
_(qsort(xs)):each(function(x)
  io.write(x .. ' ')
end)
print()
_(xs):each(function(x)
  io.write(x .. ' ')
end)

Sunday, September 16, 2012

Eval in Lua

assert(loadstring(string.format('return %s', something)))()

The call of assert is only for debug-friendly.

Freeciv on Mac OS X

If you haven't play Freeciv, it's a good opportunity to try it. It's a freesoftware which is based on Civilization™. I've been playing Freeciv recently.

It's very easy to install Freeciv on Gentoo Linux: just emerge it. It's not very easy to install it on Mac OS X Snow Leopard.

There are 3 ways to install Freeciv on Mac OS X Snow Leopard. (1) 2.1.9 binary package for Snow Leopard, (2) 2.3.1 with sdl on Homebrew's Homebrew-games, or (3) jinhao's patched version of Homebrew formula. Dont choose (1) or (2).

Freeciv has 2 ways to provide GUI interface; sdl and gtk2. sdl interface is very inconvenient. gtk2 interface is much much better but it needs lots of compiling. Still I recommend gtk2 version for everybody.

Note that don't start Freeciv server on Mac OS X. I don't know why but it consumes all the CPU power. Singleplay in Freeciv simply means it starts server and connects itself. Start a server on a Gentoo machine and connect there to play.

Enjoy!

Sunday, September 9, 2012

English Words Lookup/Completion on Gentoo

When I used Mac OS X, I used look command a lot.

$ look standa
standage
standard
standardbred
standardizable
standardization
standardize
standardized
standardizer
standardwise

A Vim plugin neco-look makes your Vim auto-complete English words, using look command internally.

I had been looking for how to use the look command on Gentoo Linux. I finally found that how to do that today.. just install the following packages.

  • sys-apps/util-linux
  • sys-apps/miscfiles

I used e-file command to find portage packages which depend on look command and its dependency /usr/share/dict/words. Install app-portage/pfl to use e-file.

Friday, September 7, 2012

DNS Lookup in Scala

import javax.naming.directory.{InitialDirContext, Attribute}
import javax.naming.NamingException
import scala.collection.JavaConversions._

object L {
    def main(args: Array[String]) {
        println('ip, lookupIp(args.head))
    }

    def lookupIp(host: String): List[String] = {
        val attributes = try {
            new InitialDirContext getAttributes ("dns:/%s" format host)
        } catch {
            case _: NamingException => return Nil
        }
        val list = {
            val attributeEnumeration = attributes.getAll
            var list = List[Attribute]()
            while (attributeEnumeration.hasMore)
                list = attributeEnumeration.next :: list
            attributeEnumeration.close
            list.reverse
        }
        list map (x => x.getID -> x.get.toString) flatMap {
            case ("A", x) => List(x)
            case ("CNAME", x) => lookupIp(x)
            case (_, x) => Nil
        }
    }
}

Sunday, September 2, 2012

Minecraft MOD in Clojure

http://github.com/ujihisa/cloft

I've been writing Clojure for this Minecraft server MOD. This MOD, cloft, uses Bukkit API and is compatible with Minecraft client version 1.3.1+, including the latest stable version 1.3.2.

This MOD was originally based on clj-minecraft made by Deon Moolman.

I'm also running my own minecraft server with using cloft. If you are interested in playing, feel free to ask me on Twitter.

Followers