Los Angeles

Well, it looks like daily programming exercises are difficult to fit into my schedule in Los Angeles. Fortunately, I'm programming at work quite frequently (in LispWorks). It feels great to be programming a real contribution to a real AI project.

Anyway, here are a few programming-related thoughts.

Lesson one: OCaml "feels" more productive, but I am actually more productive when writing in Lisp.

There is no getting around it: Lisp is a messy language. OCaml makes me think about my types, whereas in Lisp I just make a function that spits out whatever kind of data is convenient (such as a list of lists of dotted lists, where (of course!) each level has a specific meaning). What's really great about OCaml is the number of errors that can be caught at compile time by the type checker; problems that might take me a minute or several to debug in Lisp. Yet, when I'm writing OCaml code, I actually end up spending so much time trying to decide the types I should use that the advantage disappears. This may be more my fault than OCaml's fault; there is not really a need to put so much information into my declared types... but since it's there, I want to use it.

In fact, I want to put as much information into my types as possible (to catch as many bugs in my code as possible), to the point where I consider switching to programming in a theorem prover like Coq where I can make a formal specification of my program as a type. This is (probably) silly, but makes me think.

The Qi language has a potentially helpful balance... optional type-checking with a Turing-complete type inference system based on sequent calculus, with prolog-like type inference. This sounds very cool to me, and I've installed it and played around just a bit...

The other productivity tool which Lisp has is simply a larger set of list manipulation functions built in. This would be easy to implement in OCaml, of course. (Perhaps a good project.)

An interesting difference between Lisp and Qi/OCaml is the pervasive use of quotation in Lisp. Quotation in Lisp is awesome; that's why I think metaOCaml should be merged with regular OCaml, say. However, in Lisp quotation seems to be needed too often. Forgetting to add a quote is a common error, as we need to quote almost any complicated literal data we feed to a function. This arises from the fundamentally incorrect implementation of lambda calculus that Lisp uses. Quoting is the opposite of evaluation, which seems natural and elegant until you start using other functional languages. Really, the two should be orthogonal: in lambda calculus, *all* data should "evaluate to itself" like numbers and nil do in Lisp. Qi and OCaml use proper lambda calculus, which means that we don't need to quote all over the place. But, since they don't need it so badly, they lack quotation altogether (at least OCaml does... maybe it's just a feature I haven't read about yet in Qi).

Now, a difference between Qi and OCaml is that Qi still uses lists to express function calls, whereas OCaml uses them as just a data structure. I like the idea in OCaml that parentheses are only ever needed to express grouping; it makes the syntax simpler.

I've started using structures more in my Lisp programs, which helps to reduce some of the messiness that I mentioned.

Oh, one more thing. I decided to stop trying to adapt myself to emacs. Instead, I've discovered a variety of tools for Gedit. It's possible to make a keyboard shortcut to run an arbitrary bash script using the "external tools" facility. I made a shortcut to run the current file in a Lisp session that opens in a shell, and a similar shortcut for testing ocaml code.I've also got Lisp syntax highlighting, and paren matching.

More Fair Scheduling

This is just a small addition to the fair scheduling, to make it reset the priorities before they overflow to negative infinity. The constant should be chosen to make sure this won't happen for the specific system...

I should make testing this code my next priority.

(* Priority Queue *)

(* Tasks are of type unit -> unit *)
type priority_queue = {mutable tasklist: ((unit -> unit) * float) option array; mutable next: int}

let new_priority_queue = {tasklist = Array.make 2 None; next = 1}

let rec sift_up place pq =
  if (place > 1) then match (pq.tasklist.(place), pq.tasklist.(place/2)) with
    (None, p) -> ()
  | (Some (t1,f1), Some (t2,f2)) when f1 <= f2 -> ()
  | (Some (t1,f1), Some (t2,f2)) when f1 > f2 ->
      pq.tasklist.(place)   <- Some (t2, f2);
      pq.tasklist.(place/2) <- Some (t1, f1);
      sift_up (place/2) pq;
  | (q, r) -> raise (Invalid_argument "sift_up");;

let double_size pq =
  pq.tasklist <- Array.append pq.tasklist (Array.make (Array.length pq.tasklist) None);;

let push_item item priority pq =
  (if not (pq.next < Array.length pq.tasklist) then double_size pq);
  pq.tasklist.(pq.next) <- Some (item, priority);
  sift_up pq.next pq;
  pq.next <- (pq.next + 1);;

let rec sift_down place pq =
  if place*2 < Array.length pq.tasklist then
    if place*2+1 < pq.next then
      let (largervalue,largerplace) =
        (match (pq.tasklist.(place*2), pq.tasklist.(place*2+1)) with
          (Some (t1,f1), Some (t2,f2)) when f1 < f2 -> (f2,place*2+1)
        | (Some (t1,f1), Some (t2,f2))              -> (f1,place*2)
        | _ -> raise (Invalid_argument "sift_down") )
      in
      match pq.tasklist.(place) with
        Some (t,f) when f < largervalue ->
          (pq.tasklist.(place) <- pq.tasklist.(largerplace);
           pq.tasklist.(largerplace) <- Some (t,f);
           sift_down largerplace pq )
      | Some (t,f) -> ()
      | _ -> raise (Invalid_argument "sift_down")
    else if place*2 < pq.next then
      match pq.tasklist.(place) with
        Some (t,f) when f < (match pq.tasklist.(place*2) with Some (t,f) -> f | _ -> 0.0) ->
          (pq.tasklist.(place) <- pq.tasklist.(place*2);
           pq.tasklist.(place*2) <- Some (t,f) )
      | Some (t,f) -> ()
      | _ -> raise (Invalid_argument "sift_down");;


let pop_item pq =
  let result = pq.tasklist.(1) in
  pq.tasklist.(1) <- pq.tasklist.(pq.next-1);
  pq.tasklist.(pq.next-1) <- None;
  if pq.next > 1 then pq.next <- pq.next-1;
  sift_down 1 pq;
  result;;

let loop_items pq =
  while not (pq.tasklist.(1) = None) do
    match pop_item pq with
      Some (item,f) ->
    item();
    |  None -> ()
  done;;

(* Fair Scheduler, implemented as a persistent codelet *)

type supertask_data = {parentq: priority_queue;
            childq: priority_queue;
            ratio: float;
            mutable priority: float}

let rec supertask data unit =
  let starttime =
    Unix.gettimeofday() in
  (match (pop_item data.childq) with
    Some (item, f) ->
      item();
  | None -> ());
  let tasktime =
    (Unix.gettimeofday() -. starttime) /. data.ratio  in
  data.priority <- (data.priority -. tasktime);
  push_item
    (supertask data)
    data.priority
    data.parentq;;

let min = -9999.0;
 
let rec reset_utils pq unit =
  Array.iter
    (fun t ->
      match t with
    Some (t, f) -> Some (t, f -. min)
      |    None -> None)
    pq.tasklist;
  push_item (reset_utils pq) min pq;;

Fair Scheduling on a Priority Queue

I'm in St. Luis for a math conference! The time zone is different, but it's still after midnight. This merges the past two projects, implementing the fair scheduler on the priority queue (which should be a performance gain, in theory).

Here is the (untested!) code.

(* Priority Queue *)

(* Tasks are of type unit -> unit *)
type priority_queue = {mutable tasklist: ((unit -> unit) * float) option array; mutable next: int}

let new_priority_queue = {tasklist = Array.make 2 None; next = 1}

let rec sift_up place pq =
  if (place > 1) then match (pq.tasklist.(place), pq.tasklist.(place/2)) with
    (None, p) -> ()
  | (Some (t1,f1), Some (t2,f2)) when f1 <= f2 -> ()
  | (Some (t1,f1), Some (t2,f2)) when f1 > f2 ->
      pq.tasklist.(place)   <- Some (t2, f2);
      pq.tasklist.(place/2) <- Some (t1, f1);
      sift_up (place/2) pq;
  | (q, r) -> raise (Invalid_argument "sift_up");;

let double_size pq =
  pq.tasklist <- Array.append pq.tasklist (Array.make (Array.length pq.tasklist) None);;

let push_item item priority pq =
  (if not (pq.next < Array.length pq.tasklist) then double_size pq);
  pq.tasklist.(pq.next) <- Some (item, priority);
  sift_up pq.next pq;
  pq.next <- (pq.next + 1);;

let rec sift_down place pq =
  if place*2 < Array.length pq.tasklist then
    if place*2+1 < pq.next then
      let (largervalue,largerplace) =
        (match (pq.tasklist.(place*2), pq.tasklist.(place*2+1)) with
          (Some (t1,f1), Some (t2,f2)) when f1 < f2 -> (f2,place*2+1)
        | (Some (t1,f1), Some (t2,f2))              -> (f1,place*2)
        | _ -> raise (Invalid_argument "sift_down") )
      in
      match pq.tasklist.(place) with
        Some (t,f) when f < largervalue ->
          (pq.tasklist.(place) <- pq.tasklist.(largerplace);
           pq.tasklist.(largerplace) <- Some (t,f);
           sift_down largerplace pq )
      | Some (t,f) -> ()
      | _ -> raise (Invalid_argument "sift_down")
    else if place*2 < pq.next then
      match pq.tasklist.(place) with
        Some (t,f) when f < (match pq.tasklist.(place*2) with Some (t,f) -> f | _ -> 0.0) ->
          (pq.tasklist.(place) <- pq.tasklist.(place*2);
           pq.tasklist.(place*2) <- Some (t,f) )
      | Some (t,f) -> ()
      | _ -> raise (Invalid_argument "sift_down");;


let pop_item pq =
  let result = pq.tasklist.(1) in
  pq.tasklist.(1) <- pq.tasklist.(pq.next-1);
  pq.tasklist.(pq.next-1) <- None;
  if pq.next > 1 then pq.next <- pq.next-1;
  sift_down 1 pq;
  result;;

let loop_items pq =
  while not (pq.tasklist.(1) = None) do
    match pop_item pq with
      Some (item,f) ->
    item();
    |  None -> ()
  done;;

(* Fair Scheduler, implemented as a persistent codelet *)

type supertask_data = {parentq: priority_queue;
            childq: priority_queue;
            ratio: float;
            mutable priority: float}

let rec supertask data unit =
  let starttime =
    Unix.gettimeofday() in
  (match (pop_item data.childq) with
    Some (item, f) ->
      item();
  | None -> ());
  let tasktime =
    (Unix.gettimeofday() -. starttime) /. data.ratio  in
  data.priority <- (data.priority -. tasktime);
  push_item
    (supertask data)
    data.priority
    data.parentq;;
 

April 11

Didn't finish what I started; may be finished tomorrow. After that, I probably won't get much opportunity to post for a few days; I'm on the road again.

April 7, 8, 9

Ok. I've been on the road quite a bit the last two days. More emacs-learning (and a little more actual programming) happened, but I didn't manage to get a post up. Today is something along similar lines to the priority queue: a fair scheduler. Written with the help of Emacs ocaml mode.

Thanks to the use of the Unix module, this needs to be linked with unix.cma at compile time (or run in an interpreter which has unix.cma loaded).

type 'qtype taskqueue =
    {queue: 'qtype;
      dotask: unit -> unit;
    target: float;
    mutable error: float}
     
let itertask taskqlist =
  let starttime =
    Unix.gettimeofday()
  and nextq =
    List.fold_left
      (fun a b -> if a.error > b.error then a else b)
      (List.hd taskqlist)
      taskqlist
  in let  nextqerror = nextq.error
  in
  nextq.dotask();
  let tasktime =
    Unix.gettimeofday() -. starttime in
  List.iter
    (fun q -> if q = nextq then
      q.error <- q.error -. nextqerror +. (tasktime /. nextq.target) )
    taskqlist;;

What Happened to April 6?

I missed a day due to trying to figure out Emacs. I've been programming with a plain text editor and command line, so naturally I was pressured by fellow programmers to do things the right way-- choose an IDE. In particular, I was advised to use Emacs. Ideally I'd like to spend just 1 hour a day for these daily exercises, and starting with Emacs took way longer than that.

So far: frustrating.

Development environments have always been a problem for me. They seem to suck up more time than they save (mostly in dealing with configuration). Maybe that's partly because I need to stick with one long-term so that I get a real feel for it; so far, though, I've found it more convenient to just avoid them altogether.

So, I spent a day trying to figure out what exactly I'm supposed to "do" with Emacs. Specifically, I decided to figure out how "do" Common Lisp in Emacs. (Other languages will come later.) I'm still feeling more like it's a pain than a helper, but this tutorial helped me see that it has some advantages. So long as I don't try to do everything in emacs, and avoid the fancy configuration stuff that everyone seems to love, I should be over the 'time-sink' hump.

So that was yesterday. Now maybe I can sit down and do today's post.

MetaOcaml Priority Queue

The idea today was just to make my OCaml priority queue from yesterday into a metaOcaml queue, so that it could queue tasks written in actual OCaml code.

MetaOCaml might sound redundant, but in fact, it simply adds a feature that is missing: quotation, as it exists in Lisp. A quoted piece of code is not executed until we explicitly evaluate it. The biggest difference is that OCaml type-checks everything, even stuff inside quotes! According to the metaocaml paper, if the type of an expression E is t, the type of a quoted expression (written .<E>.) is:

E code

What I found in my install was that it became:

('a, E) code

I have no idea what that 'a is doing there, and it made life difficult! After I put the priority queue together, I tried to write a function which repeatedly took tasks off of the queue and executed them until none remained. However, the interpreter rejected this as ill-typed, complaining that the 'a parameters might not match (more specifically, that 'a is not generalisable).

Perhaps I'll figure that one out for tomorrow. Here is the code for today:

type 'a task = ('a, unit) code

type 'a priority_queue = {mutable tasklist: (('a task) * float) option array; mutable next: int}

let new_priority_queue = {tasklist = Array.make 2 None; next = 1}

let rec sift_up place pq =
  if (place > 1) then match (pq.tasklist.(place), pq.tasklist.(place/2)) with
      (None, p) -> ()
    | (Some (t1,f1), Some (t2,f2)) when f1 <= f2 -> ()
    | (Some (t1,f1), Some (t2,f2)) when f1 > f2 ->
        pq.tasklist.(place)   <- Some (t2, f2);
        pq.tasklist.(place/2) <- Some (t1, f1);
        sift_up (place/2) pq;
    | (q, r) -> raise (Invalid_argument "sift_up");;

let double_size pq =
  pq.tasklist <- Array.append pq.tasklist (Array.make (Array.length pq.tasklist) None);;

let push_item item priority pq =
  (if not (pq.next < Array.length pq.tasklist) then double_size pq);
  pq.tasklist.(pq.next) <- Some (item, priority);
  sift_up pq.next pq;
  pq.next <- (pq.next + 1);;

let rec sift_down place pq =
  if place*2 < Array.length pq.tasklist then
    if place*2+1 < pq.next then
      let (largervalue,largerplace) =
        (match (pq.tasklist.(place*2), pq.tasklist.(place*2+1)) with
            (Some (t1,f1), Some (t2,f2)) when f1 < f2 -> (f2,place*2+1)
          | (Some (t1,f1), Some (t2,f2))              -> (f1,place*2)
          | _ -> raise (Invalid_argument "sift_down") )
        in
          match pq.tasklist.(place) with
              Some (t,f) when f < largervalue ->
                (pq.tasklist.(place) <- pq.tasklist.(largerplace);
                pq.tasklist.(largerplace) <- Some (t,f);
                sift_down largerplace pq )
            | Some (t,f) -> ()
            | _ -> raise (Invalid_argument "sift_down")
    else if place*2 < pq.next then
      match pq.tasklist.(place) with
          Some (t,f) when f < (match pq.tasklist.(place*2) with Some (t,f) -> f | _ -> 0.0) ->
            (pq.tasklist.(place) <- pq.tasklist.(place*2);
            pq.tasklist.(place*2) <- Some (t,f) )
        | Some (t,f) -> ()
        | _ -> raise (Invalid_argument "sift_down");;


let pop_item pq =
  match pq.tasklist.(1) with Some (t,f) ->
      pq.tasklist.(1) <- pq.tasklist.(pq.next-1);
      pq.tasklist.(pq.next-1) <- None;
      if pq.next > 1 then pq.next <- pq.next-1;
      sift_down 1 pq;
      t;
    | None -> .<()>.;;

First Post

The point of this blog is just to get me to write some code every day. If I miss a few days I will try to make several posts. Probably this blog will not be much fun to read regularly, but posting it publicly gives some sense of accountability.

It'll be in Lisp, Ocaml, or whatever I feel like learning.

Today's code is an ocaml priority queue. I might improve it a bit for the next couple of days.

(* This is just a placeholder for real tasks. *)
type task = Task

type priority_queue = {mutable tasklist: (task * float) option array; mutable next: int}

let new_priority_queue = {tasklist = Array.make 2 None; next = 1}

let rec sift_up place pq =
  if (place > 1) then match (pq.tasklist.(place), pq.tasklist.(place/2)) with
      (None, p) -> ()
    | (Some (t1,f1), Some (t2,f2)) when f1 <= f2 -> ()
    | (Some (t1,f1), Some (t2,f2)) when f1 > f2 ->
        pq.tasklist.(place)   <- Some (t2, f2);
        pq.tasklist.(place/2) <- Some (t1, f1);
        sift_up (place/2) pq;
    | (q, r) -> raise (Invalid_argument "sift_up");;

let double_size pq =
  pq.tasklist <- Array.append pq.tasklist (Array.make (Array.length pq.tasklist) None);;

let push_item item priority pq =
  (if not (pq.next < Array.length pq.tasklist) then double_size pq);
  pq.tasklist.(pq.next) <- Some (item, priority);
  sift_up pq.next pq;
  pq.next <- (pq.next + 1);;

let rec sift_down place pq =
  if place*2 < Array.length pq.tasklist then
    if place*2+1 < pq.next then
      let (largervalue,largerplace) =
        (match (pq.tasklist.(place*2), pq.tasklist.(place*2+1)) with
            (Some (t1,f1), Some (t2,f2)) when f1 < f2 -> (f2,place*2+1)
          | (Some (t1,f1), Some (t2,f2))              -> (f1,place*2)
          | _ -> raise (Invalid_argument "sift_down") )
        in
          match pq.tasklist.(place) with
              Some (t,f) when f < largervalue ->
                (pq.tasklist.(place) <- pq.tasklist.(largerplace);
                pq.tasklist.(largerplace) <- Some (t,f);
                sift_down largerplace pq )
            | Some (t,f) -> ()
            | _ -> raise (Invalid_argument "sift_down")
    else if place*2 < pq.next then
      match pq.tasklist.(place) with
          Some (t,f) when f < (match pq.tasklist.(place*2) with Some (t,f) -> f | _ -> 0.0) ->
            (pq.tasklist.(place) <- pq.tasklist.(place*2);
            pq.tasklist.(place*2) <- Some (t,f) )
        | Some (t,f) -> ()
        | _ -> raise (Invalid_argument "sift_down");;


let pop_item pq =
  let result = pq.tasklist.(1) in
    pq.tasklist.(1) <- pq.tasklist.(pq.next-1);
    pq.tasklist.(pq.next-1) <- None;
    if pq.next > 1 then pq.next <- pq.next-1;
    sift_down 1 pq;
    result;;