kosaraju.c

#include <stdio.h>
#include <stdlib.h>

struct stack {
     int           state;
     void         *current;
     struct stack *next;
};

struct graph {
     int           value;
     int           state;
     struct stack *incoming;
     struct stack *outgoing;
};

void create(struct stack **stack)
{
     *stack = NULL;
}

void push(int state, void *value, struct stack **stack)
{
     struct stack *new = malloc(sizeof (struct stack));
     new->state   = state;
     new->current = value;
     new->next    = *stack;
     *stack       = new;
}

int pop(int *state, void **value, struct stack **stack)
{
     struct stack *old = *stack;
     if (!old)  return 0;
     if (state) *state = old->state;
     if (value) *value = old->current;
     
     *stack = old->next;
     free(old);
     return 1;
}

void destroy(struct stack **stack)
{
     while (pop(NULL, NULL, stack));
}

void connect(struct graph *source, struct graph *target)
{
     push(0, target, &source->outgoing);
     push(0, source, &target->incoming);
}

void paths(struct graph *nodes, int *offsets)
{
     int count, current;
     
     while (count = *offsets++)
          while (current = *offsets++, count--)
               connect(nodes + current, nodes + *offsets);
}

void visit(struct stack *neighbors, struct stack **visited)
{
     int           state;
     void         *current;
     struct graph *graph;
     struct stack *schedule;
     
     create(&schedule);
     push(0, neighbors, &schedule);
     
     while (pop(&state, &current, &schedule))
          if (!state && current) {
               neighbors = current;
               graph     = neighbors->current;
               push(0, neighbors->next, &schedule);
               
               if (!graph->state) {
                    graph->state = 1;
                    push(1, graph, &schedule);
                    push(0, graph->outgoing, &schedule);
               }
          }
          else if (state)
               push(0, current, visited);
}

void assign(struct stack *neighbors)
{
     struct graph *graph;
     struct stack *schedule;
     
     create(&schedule);
     push(0, neighbors, &schedule);
     
     while (pop(NULL, &neighbors, &schedule))
          if (neighbors) {
               graph = neighbors->current;
               push(0, neighbors->next, &schedule);
               
               if (graph->state) {
                    graph->state = 0;
                    push(0, graph->incoming, &schedule);
                    printf("%d ", graph->value);
               }
          }
}

void kosaraju(struct stack *neighbors)
{
     struct graph *graph;
     struct stack *visited;
     
     create(&visited);
     visit(neighbors, &visited);
     
     while (pop(NULL, &graph, &visited))
          if (graph->state) {
               graph->state = 0;
               assign(graph->incoming);
               printf("%d\n", graph->value);
          }
}

int main()
{
     struct graph graph[16];
     struct stack dummy = { 0, graph, NULL };
     
     int offsets[] = {
          8, 0, 1, 2, 0, 3, 4, 0, 5, 7,
          6, 0, 9, 10, 11, 12, 9, 11,
          1, 1, 12,
          6, 3, 5, 6, 7, 8, 6, 15,
          4, 5, 13, 14, 13, 15,
          1, 8, 15,
          1, 10, 13,
          0
     };
     
     for (int i = 0; i < 16; i++) {
          graph[i].value = i;
          graph[i].state = 0;
          create(&graph[i].incoming);
          create(&graph[i].outgoing);
     }
     
     paths(graph, offsets);
     kosaraju(&dummy);
     
     for (int i = 0; i < 16; i++) {
          destroy(&graph[i].incoming);
          destroy(&graph[i].outgoing);
     }
}

kosaraju.sml

datatype 'a node = Node of 'a * bool ref * 'a node list ref * 'a node list ref

fun node x = Node (x, ref false, ref nil, ref nil)
fun mark (Node (_, r, _, _)) = !r before r := true
fun unmark (Node (_, r, _, _)) = !r before r := false

fun value (Node (x, _, _, _)) = x
fun sources (Node (_, _, ref xs, _)) = xs
fun targets (Node (_, _, _, ref ys)) = ys

fun connect (m, n) =
  let
    val Node (_, _, _, ns) = m
    val Node (_, _, ms, _) = n
  in
    ms := m :: !ms;
    ns := n :: !ns
  end

datatype 'a step = One of 'a | Many of 'a list

fun visit (ms, nil) = ms
  | visit (ms, One m :: ss) = visit (m :: ms, ss)
  | visit (ms, Many nil :: ss) = visit (ms, ss)
  | visit (ms, Many (n :: ns) :: ss) =
    if mark n then
      visit (ms, Many ns :: ss)
    else
      visit (ms, Many (targets n) :: One n :: Many ns :: ss)

fun assign (xs, nil) = xs
  | assign (xs, nil :: ss) = assign (xs, ss)
  | assign (xs, (n :: ns) :: ss) =
    if unmark n then
      assign (value n :: xs, sources n :: ns :: ss)
    else
      assign (xs, ns :: ss)

fun assigns (xs, nil) = xs
  | assigns (xs, n :: ns) =
    if unmark n then
      let
        val x = sources n :: nil
        val x = value n :: assign (nil, x)
      in
        assigns (x :: xs, ns)
      end
    else
      assigns (xs, ns)
*)

fun kosaraju xs = assigns (nil, visit (nil, Many xs :: nil))

fun make (n, is, ijs) =
  let
    val xs = Vector.tabulate (n, node)
    fun item i = Vector.sub (xs, i)
    fun step (i, j) = connect (item i, item j)
    fun path (i :: j :: js) = (step (i, j); path (j :: js))
      | path _ = ()
  in
    map item is before app path ijs
  end

val is = 0 :: nil
val ijs =
  [0, 1, 2, 0, 3, 4, 0, 5, 7] ::
  [0, 9, 10, 11, 12, 9, 11] ::
  [1, 12] ::
  [3, 5, 6, 7, 8, 6, 15] ::
  [5, 13, 14, 13, 15] ::
  [8, 15] ::
  [10, 13] ::
  nil

val ns = make (16, is, ijs)
val xs = kosaraju ns