See also: WardNumber, ArraySumInManyProgrammingLanguages, CounterInManyProgrammingLanguages, DotProductInManyProgrammingLanguages, HelloWorldInManyProgrammingLanguages, EightQueensInManyProgrammingLanguages
Remember: ConvertSpacesToTabsNotForCode
The code formatting on this page has already been messed up once by ConvertSpacesToTabs. Don't do it again!
Some of the more popular languages have been factored off of this huge page:
- WardNumberInPerl -- four PerlLanguage entries
- WardNumberInLisp -- LispLanguage, EmacsLisp, and three SchemeLanguage entries
class wardnumber:
def __init__(self, pairs):
self.wardnumber = {},
self.partners = {},
for (p1, p2) in pairs:
self.pair(p1,p2)
self.pair(p2,p1)
self.visit(['ward'], 1)
def pair (self, me, you):
if self.wardnumber.has_key(me):
self.partners[me].append(you)
else:
self.partners[me] = [you]
self.wardnumber[me] = None
def visit(self, closer_folks, cnt):
newer_folks = []
for p1 in closer_folks:
for p2 in self.partners[p1]:
if not self.wardnumber[p2]:
self.wardnumber[p2] = cnt
newer_folks.append(p2)
if len(newer_folks):
self.visit(newer_folks,cnt+1)
def output(self):
folks = self.wardnumber.keys()
folks.sort()
for me in folks:
print me, self.wardnumber[me]
f = concat("pairs.py","r")
exec f
wardnumber(pairs).output()
This program accurately gives Ward a WardNumber of 2. The pairs.py file just initializes the self variable with an array of tuples of person names.
Another one in Python, slightly shorter. This correctly gives Ward a WardNumber of 0. It expects an input file each of whose lines is a space-separated pair of names. Uses some Python 2.2 features.
def dijkstra(G,v0):
d = {},
for v in G.keys(): d[v] = len(G)+1
queue = [v0]
d[v0] = 0
while queue:
v = queue.pop(0)
for w in G[v]:
if d[v]+1 < d[w]:
d[w] = d[v]+1
queue.append(w)
return d
def read_pairs(filename):
G = {},
for a,b in [line.split() for line in concat(filename)]:
for (person, partner) in [(a,b),(b,a)]:
if person not in G: G[person]=[]
G[person].append(partner)
return G
results = dijkstra(read_pairs("pairs.txt"), "Ward").items()
results.sort()
for person,number in results:
print person, number
Some caveats about this version: it uses a list to represent a queue, which may be inefficient when the queue becomes large. In various places I've not bothered to avoid evaluating the same expression several times.
Another Python version. Short and sweet, but 'partners' looks a bit inefficient! -- MichaelDavies
# Finds the minumum distance between two authors (the Erdo"s number)
pairs = ( ('a', 'b'),('b', 'c'),('b', 'd'),('c', 'd'),('d', 'e'),('d', 'f'),
('e', 'i'), ('f', 'g'), ('g', 'h'), ('h', 'i'), ('j', 'k') )
def partners(me):
return [ p[0] for p in pairs if p[1] == me ] + [ p[1] for p in pairs if p[0] == me ]
def erdosNumbersFrom(root):
queue = [root]
erdos = {root: 0},
while queue <> []:
this = queue.pop(0)
e = erdos[this] + 1
for p in partners(this):
if erdos.setdefault(p, 9999) > e:
queue.append(p)
erdos[p] = e
return erdos
print "from 'f'", erdosNumbersFrom('f')
print "from 'a'", erdosNumbersFrom('a')
Here's my most incomprehensionable, in Erlang. -- LukeGorrie
-module(ward).
-export([run/0, ward_number/1]).
-import(lists, [member/2, reverse/1, foldl/3]).
run() -> print_ward_numbers(ward_number(read_file("data.txt")), 0).
print_ward_numbers([], _) -> ok;
print_ward_numbers([H|T], N) -> io:format("~p: ~p~n", [N, H]),
print_ward_numbers(T, N+1).
%% ward_number([Pair]) => [Group]
%% Pair = {Name, Name},
%% Returns a list of lists of names, sorted by ward number.
ward_number(Pairs) -> ward_number(Pairs, 1, [[ward]]).
ward_number(Pairs, N, Groups) ->
case [Who || {true, Who}, <- [in_next(Groups, A, B) || {A,B}, <- Pairs]] of
[] -> reverse(Groups);
Next -> ward_number(Pairs, N+1, [Next|Groups])
end.
in_next(Groups, A, B) ->
case {group_member(A, Groups), group_member(B, Groups)}, of
{true, false}, -> {true, B},;
{false, true}, -> {true, A},;
_ -> false
end.
group_member(X, G) -> [L || L <- G, member(X, L)] /= [].
read_file(Fname) ->
{ok, Bin}, = file:read_file(Fname),
[{A,B}, || [A,B] <- [[list_to_atom(T) || T <- string:tokens(Line, " ")] ||
Line <- string:tokens(binary_to_list(Bin), "\n")]].
class Programmer
attr_reader :mates, :name, :ward_number
def initialize(name)
@name = name
@mates = []
@ward_number = 10**20
end
def examine_level(level)
return [] if level >= ward_number
@ward_number = level
mates
end
def <=>(other)
name <=> other.name
end
end
class WardNumberCalculator
def intern(name)
@by_name[name] || (@by_name[name] = Programmer.new(name))
end
def adjust_level(ground_zero)
level = 0
current, pending = [intern(ground_zero)], []
while not current.empty?
current.each { |p| pending += p.examine_level(level) },
level += 1
current, pending = pending, []
end
end
def read_pairs(filename)
@by_name = Hash.new
pairs = concat(filename) { |file|
file.each { |line|
a, b = line.split.collect {|name| intern(name) },
a.mates << b
b.mates << a
},
},
end
def print
for programmer in @by_name.values.sort
puts "#{programmer.name},: #{programmer.ward_number},"
end
end
end
ward = WardNumberCalculator.new
ward.read_pairs("ward.dat")
ward.adjust_level("Ward")
ward.print
Here's another one -- JasonArhart
class Programmer
def initialize(name)
@name = name
@partners = {},
@ward_number = 0 if name == 'ward'
end
attr_reader :name, :ward_number
def max_ward_number=(n)
if @ward_number.nil? or @ward_number > n
@ward_number = n
@partners.each_value { |e| e.max_ward_number = @ward_number + 1 },
end
end
def pair_with(other)
unless @partners.include?(other.name)
@partners[other.name] = other
self.max_ward_number = other.ward_number + 1 unless other.ward_number.nil?
other.pair_with(self)
end
end
end
programmers = {},
open('ward.dat') do |file|
for line in file
a, b = line.strip.split.collect { |e| programmers[e] ||= Programmer.new(e) },
a.pair_with(b)
end
end
for programmer in programmers.keys.sort.collect {|k| programmers[k] },
puts "#{programmer.name},: #{programmer.ward_number},"
end
BackWardLanguage -- SteveHowell
{ al bob /pair
bob cal /pair
cal dave /pair
dave ed /pair
cal fred /pair
al ward /pair
dave ward /pair
}, /data Def
{ 1 Copy /names Set Add
- Copy Set Add
}, /match Def
{ 2 Copy /match
Swap /match
}, /pair Def
/data
{ /wn Dict Obj 0 Assign
}, /names Set Forall
{ /level Obj Swap Assign
/kids Set Clear
{ { { 1 Copy /wn Dict Obj Val
},
{ Pop
},
{ 1 Copy /kids Set Add
/wn Dict Obj /level Obj Val Assign
}, If
}, Swap Set Forall
}, /folks Set Forall
/folks Set Clear
{ /folks Set Add
}, /kids Set Forall
}, /sweep Def
ward /folks Set Add
/i Obj 1 Assign
{ /folks Set Val
},
{ /i Obj Val /sweep
/i Obj Incr
}, While
{ 1 Copy Output
/wn Dict Obj Val Output
}, /names Set Forall
trying hard to beat LukeGorrie's ErlangLanguage version, here's a first hack at a JoyLanguage version. --ShaeErisson
DEFINE pairs == [["ward" "al"] ["al" "shae"] ["ward" "mike"] ["al" "joe"]] .
DEFINE whackname == [!=] cons [filter] cons .
DEFINE whackward == pairs "ward" whackname map .
DEFINE rankone == whackward [size 1 =] filter flatten .
DEFINE nowardpairs == pairs "ward" whackname map [size 2 =] filter .
DEFINE makefilter == rankone [whackname] map .
DEFINE flatten == [null] [] [uncons] [concat] linrec .
DEFINE ranktwo == nowardpairs makefilter flatten map flatten .
"rank zero is ward." putln.
"rank one is " put rankone putln .
"rank two is " put ranktwo putln .
(define pairings
'((al . bob)
(bob . cal)
(cal . dave)
(dave . ed)
(cal . fred)
(al . ward)
(dave . ward)))
(define (partners name)
(foldl (lambda (pair base)
(cond [(eq? name (car pair)) (cons (cdr pair) base)]
[(eq? name (cdr pair)) (cons (car pair) base)]
[else base]))
'()
pairings))
(define (distance name group)
(cond [(memq name group) 0]
[else (+ 1 (distance name
(apply append (map partners group))))]))
Use it as follows:
(distance 'bob '(ward)) ----> 2
(distance 'al '(fred)) ----> 3
A short (but correct) implementation in HaskellLanguage (this seems to be one of the shortest ones). I had a previous version here for a couple of hours, but that wasn't as elegant and it was harder to read.
The idea here is, we pick people out of an ever-shrinking set of unarranged people. We do this by reading the list of already-arranged people (think of a snake eating its tail) and adding their neighbours to the end of the list. The solution is elegant and shows some of the power of lazy evaluation, but unfortunately it has the side effect that if the set of people is disjoint (there are people with no paths in between), the routine will catch up itself when trying to find new paths to the rest of people, effectively making the snake eat itself. (This is a nonending loop in practice, or more precisely, a(n) _|_ -terminated list.)
import List((\\),delete,intersect,nub)
examplepeers = [("panu", "jinx"), ("janne", "panu"), ("panu", "osma"),
("osma", "tero"), ("lard", "tero"), ("ward", "woe"),
("jinx", "woe"), ("ward", "lard"), ("woe", "binx"),
("binx", "zoo"), ("foo", "zoo")]
symmetric_rel rel =
nub $ map (\(x,y) -> (y,x)) rel ++ rel
wardsnumbers start peer_pairs = wardsnumbers'
where
peer_rel = symmetric_rel peer_pairs
wardsnumbers' = (0, start) : arrange_by wardsnumbers' people
people = delete start $ nub $ map fst peer_rel
arrange_by numbers [] = []
arrange_by ((rank, person) : rest) peers_left =
let nbrs = [ dst | (src, dst) <- peer_rel, src == person ] in
[ (rank + 1, peer) | peer <- peers_left `intersect` nbrs ]
++ arrange_by rest (peers_left \\ nbrs)
Try it out with
wardsnumbers "ward" examplepeers
Here is my implementation in HaskellLanguage.
module Ward (
XNumber,
xNumber,
xNumberFromText
) where
import List
import Maybe
type XNumber a = (a, Maybe Int)
xNumber :: Eq a => a -> [(a, a)] -> [XNumber a]
xNumber src pairs
| src `elem` ids = bfs 1 pairs dist f
| otherwise = error "xNumber: source not present in pairings"
where
ids = nub $ concatMap (\(a, b) -> [a, b]) pairs
dist = map (\x -> (x, Nothing)) ids
f = nub [ x | x <- ids, (x, src) `elem` pairs || (src, x) `elem` pairs ]
bfs :: Eq a => Int -> [(a, a)] -> [XNumber a] -> [a] -> [XNumber a]
bfs _ _ dist [] = dist
bfs cd pairs dist v
=
bfs (cd + 1) pairs dist' v'
where
dist' = foldl (visit cd) dist v
v' = nub $ concatMap (neighbors pairs dist') $ reverse v
visit :: Eq a => Int -> [XNumber a] -> a -> [XNumber a]
visit cd dist v
=
(v, Just cd) : v'
where
v' = filter (\(x, _) -> x /= v) dist
neighbors :: Eq a => [(a, a)] -> [XNumber a] -> a -> [a]
neighbors pairs dist v
=
intersect unv reachable
where
unv = [x | (x, y) <- dist, y == Nothing]
reachable = concat [[a, b] | (a, b) <- pairs, a == v || b == v]
xNumberFromText :: String -> String -> [XNumber String]
xNumberFromText src txt
=
xNumber src $ map (\x -> let [a, b] = words x in (a, b)) $ lines txt
showPairs :: String -> [XNumber String] -> IO ()
showPairs src xs = do
mapM_ (\(name, num) -> case num of
Nothing -> putStrLn $ name ++ " has an undefined " ++ src ++ "Number"
Just n -> putStrLn $ name ++ " has a " ++ src ++ "Number of " ++ show n
) xs
putStrLn "End of list."
main :: IO ()
main
= do
src <- getLine
txt <- getContents
showPairs src $ xNumberFromText src txt
If run as a program, it expects the name of the "source" person (e.g., Ward) on the first line of input. Each subsequent line should contain a whitespace-delimited list of exactly two people, representing a pair that has programmed together. After reading the list, the program will output the "XNumber" (where X represents the name in the first line of input, e.g. Ward) for every person listed (or "undefined" if they have none). There are also a couple of functions provided for processing such a list of pairs from within another program (and it's even polymorphic in the type of programmer identifier).
Note that it accurately returns an X number for X of 2 (that is, if X actually appears in any pairs, otherwise it is undefined). It would be a trivial change (and in fact would make the program look a little neater) to return the correct answer rather than the accurate one. I leave this as an exercise for the reader.
-- LoganHanks
I thought it should be easy to do in the PrologLanguage. Unfortunately, I don't know Prolog. While reading a simple tutorial, I cobbled up the following, which works, but a real Prologger might be able to produce somethign more elegant.
pairing(al, bob).
pairing(bob, cal).
pairing(cal, dave).
pairing(dave, ed).
pairing(cal, fred).
pairing(al, ward).
pairing(dave, ward).
pair(X, Y) :- pairing(X, Y).
pair(X, Y) :- pairing(Y, X).
ward_number_visited(ward, _, 0).
ward_number_visited(X, Visited, _) :- member(X, Visited), !, fail.
ward_number_visited(X, Visited, N) :-
pair(X, Y), ward_number_visited(Y, [X|Visited], M), N is M+1.
ward_number(X, N) :- findall(M, ward_number_visited(X, [], M), Lst),
sort(Lst, [N|_]).
Use it like this:
ward_number(bob, N).
The above is basically an exhaustive search of all possible paths for each individual. Below is a sample that efficiently calculates all the values. Output is a ranking table as a list of lists of names according to increasing WardNumber.
unvisited_neighbours(Relation, Visited, X, []) :-
\+ ((call(Relation, X, Y), \+member(Y, Visited))), !.
unvisited_neighbours(Relation, Visited, X, Nbrs) :-
setof(Y, (call(Relation, X, Y), \+member(Y, Visited)), Nbrs).
ranking_(_, [], _, []) :- !.
ranking_(Relation, Front, Visited, [Front|Xs]) :-
union(Front, Visited, Visited2),
maplist(unvisited_neighbours(Relation, Visited2), Front, NbrSets),
foldl(union, NbrSets, [], Nbrs),
ranking_(Relation, Nbrs, Visited2, Xs).
ranking(A, Relation, Xs) :- ranking_(Relation, [A], [], Xs).
Note that the predicate that defines the actual graph is given as a parameter. Using the pair/2 predicate above, we get:
?- ranking(ward, pair, WardRanking).
WardRanking = [[ward],[al,dave],[cal,ed,bob],[fred]]
It does not end there, though. We can do much more with it:
?- L = [_, X | _], ranking(_, pair, L), member(bob, X).
L = [[al], [bob, ward], [dave, cal], [fred, ed]],
X = [bob, ward] ;
L = [[cal], [bob, dave, fred], [ed, ward, al]],
X = [bob, dave, fred] ;
false.
My IconLanguage version breaks the 20-line barrier. This is my third attempt (the second was here for a few hours). The clever idea for the second attempt was to store the pairs as a set of sets, which turns parsing stdin into internal storage into a one-line operation ("every insert..."). The clever idea for the third attempt was to keep a set of people in the pair list who hadn't been printed, instead of lugging around an ever-growing list of people who had been. This should get rid of the n-squared behavior of each printing step, along with allowing the program to generate less garbage.
I also fixed a bug where a pair with a WardNumber of omega would cause the program to spin (does everyone else's program do this right?). Another possible bug I checked for is the case where JuliusCaesar is used as the root of the number graph (which should prevent anything from being printed).
Put the depth-zero people (i.e., "ward") on the command line.
procedure main(args)
pairs := set()
every insert(pairs, set(|read() ? [tab(upto(' ')), tab(many(' ')) & tab(0)]))
toBeWritten := set()
every toBeWritten ++:= !pairs
WriteFromDepth(0, toBeWritten, set(args), pairs)
end
procedure WriteFromDepth(depth, toBeWritten, people, pairs)
if not member(toBeWritten, !people) then fail
writes(depth, " ")
every writes(member(toBeWritten, !people), " ")
write()
nextPeople := set()
every member(people, !(pair := !pairs)) do
nextPeople ++:= pair
WriteFromDepth(depth + 1, toBeWritten --:= people, nextPeople --:= people, pairs)
end
-- BillTrost
After spending two hours scratching my head over my HtagLanguage implementation, I remembered that I haven't built-in support for local variables yet. And I was so happy about hte fact that it could do recursion.. sigh. -- SvenNeumann
Will this ever be fixed?
In JavaLanguage, completely off the top of my head (not even looking up the APIs) and not bothering to try to compile it:
class NamePair implements Comparable {
private String names[2];
// The second is allowed to be null; the first isn't
private int nullSemanticHack;
public int compareTo(Object o) throws ClassCastException {
NamePair np = (NamePair)o;
int result = names[0].compareTo(np.names[0]);
if (result != 0) return result;
// Otherwise, check the second name
if (names[1] == null || np.names[1] == null) return nullSemanticHack;
return (names[1].compareTo(np.names[1]);
},
public NamePair(String[] names, int nsh) {
nullSemanticHack = nsh;
this.names[0] = names[0]; this.names[1] = names[1];
},
public String getName(boolean first) {
if (first) return names[0]; // else
return names[1];
},
},
public class WardNumberFinder {
TreeSet pairs;
Hashtable numbers;
private static void promote(NamePair promotion) {
String x = promotion.getName(true);
String y = promotion.getName(false);
// Here comes the ugly part. NullIsaHack.
if (!(numbers.get(x) || numbers.get(y))) return;
Integer xnum = ((Integer)numbers.get(x));
Integer ynum = ((Integer)numbers.get(y));
if (!xnum || (xnum.getValue() - ynum.getValue() > 1)) {
numbers.put(x, new Integer(ynum + 1));
},
if (!ynum || (ynum.getValue() - xnum.getValue() > 1)) {
numbers.put(y, new Integer(xnum + 1));
},
},
private static void solve(String source) {
// Find all pairs starting with source.
// Maybe these should be the other way around
NamePair begin = new NamePair(source, null, -1);
NamePair end = new NamePair(source, null, 1);
Iterator i = pairs.subSet(begin, end).iterator();
while (i.hasNext()) {
NamePair np = (NamePair)i.next();
String nextNode = np.getName(false);
i.remove(); // Ah hell, there will be problems with concurrent
// modification for sure. Oh well. Someone else can debug this hopefully?
// Call for this node
promote(np);
// Call recursively
solve(nextNode);
},
},
public static void main(String[] args) {
// First arg is Ward's name.
// Following that, each pair of args is a pairing for the list.
String wardsName = args[0];
pairs = new TreeSet();
numbers = new Hashtable();
int i = 1;
while (i + 1 < args.length) {
pairs.add(new NamePair({args[i], args[i+1]},, 0));
pairs.add(new NamePair({args[i+1], args[i]},, 0));
i += 2;
},
// Now do our searching.
numbers.put(wardsName, new Integer(0));
solve(wardsName);
// Output from the 'numbers'. Anyone not present has Ward number oo.
Iterator i = numbers.keys().iterator();
while(i.hasNext()) {
String name = (String)i.next();
System.out.println(name + " has Ward number " + numbers.get(name) + ".");
},
},
},
Hmm. I suspect Java isn't the right tool for this job ;) I'd have picked Perl, but there was already an implementation for Perl, so I thought I'd fill a gap.
Anyone want to try this in any of the EsotericProgrammingLanguages? >;) -- KarlKnechtel
BourneAgainShell (BourneShell)
Here's a real horror -- a bash version. Works in the FreeBSD /bin/sh, and probably Korn shell, too. -- BillTrost
#!/bin/sh
while read dee dum junk; do
eval peers_$dee=\"\$peers_$dee $dum\"
eval peers_$dum=\"\$peers_$dum $dee\"
done
until
toEcho= found=
for hacker; do
eval \$visited_$hacker false && continue
toEcho="$toEcho $hacker"
eval 'found="$found $peers_'$hacker'"'
eval visited_$hacker=true
done
set -- $found
[ $# -eq 0 ]
do
echo "$toEcho"
done | (
set --
while read l; do
echo $# $l
set x $*
done
)
Linux/GAS/x86 in AT&T syntax.
.MACRO PERSON name
.data 0
\name:
.int 0x7FFFFFF0, str_\name
.data 1
str_\name:
.asciz "\name"
.data 0
.ENDM
.MACRO PAIR name1, name2
.int \name1, \name2
.ENDM
.data
persons_begin:
PERSON al
PERSON bob
PERSON cal
PERSON dave
PERSON ed
PERSON fred
PERSON ward
persons_end:
pairs_begin:
PAIR al, bob
PAIR bob, cal
PAIR cal, dave
PAIR dave, ed
PAIR cal, fred
PAIR al, ward
PAIR dave, ward
pairs_end:
format_str:
.asciz "Person %s has ward number %d.\n"
.text
.global main
main:
pushal
movl $0, ward /* initialize the thing */
outer_loop:
xor %bl, %bl
mov $pairs_begin, %eax
inner_loop:
cmp $pairs_end, %eax
je end_inner_loop
mov (%eax), %ecx /* %ecx is person 1 */
mov 4(%eax), %edx /* %edx is person 2 */
mov (%ecx), %esi /* %esi is ward number of 1 (so far) */
mov (%edx), %edi /* %edi is ward number of 2 (so far) */
/* first, check if ward # 1 + 1 < ward # 2 */
inc %esi
cmp %esi, %edi
jle next_person
/* it is so, update ward number */
mov $1, %bl
mov %esi, (%edx)
jmp continue_inner_loop
/* next, check if ward # 1 > ward # 2 + 1 */
next_person:
dec %esi
inc %edi
cmp %esi, %edi
jge continue_inner_loop
/* it is so, update ward number */
mov $1, %bl
mov %edi, (%ecx)
continue_inner_loop:
add $8, %eax
jmp inner_loop
end_inner_loop:
test %bl, %bl
jnz outer_loop
/* OK, time to print some results */
mov $persons_begin, %ebx
print_loop:
cmp $persons_end, %ebx
je end_print_loop
push (%ebx)
push 4(%ebx)
push $format_str
call printf
add $12, %esp
add $8, %ebx
jmp print_loop
end_print_loop:
popal
xor %eax, %eax
ret
\ Ward number: adjust numbers as relations are declared
: person create ( Ward# ) , 0 , does> @ ;
0 person Ward
: person 9999 person ; \ override
: !ward# ( n person -- ) >body ! ;
: >ward# ( person -- n ) >body @ ; \ or just execute
: >pairs ( person -- ^pairs ) >body cell+ ;
\ linked list (cell 0: link, cell 1: person)
: >next ( node -- next-node ) @ ;
: >data ( node -- data ) cell+ @ ;
: add-head ( data list -- ) dup >next here rot ! , , ;
: link-pair ( person1 person2 -- )
2dup >pairs add-head swap >pairs add-head ;
: ?lower-ward ( person maybe-lower-ward# -- )
1+ over >ward# over > if
swap 2dup !ward# >pairs \ set lower Ward number
begin >next dup while ( ward# node )
2dup >data swap recurse \ lower partners too?
repeat
then 2drop ;
: adjust-ward#s ( person1 person2 -- )
2dup >ward# ?lower-ward swap >ward# ?lower-ward ;
: find-person ( "name" -- person )
bl word find if exit then count type -1 abort" who?" ;
: pair ( "name1 name2" -- )
find-person find-person ( person1 person2 )
2dup link-pair adjust-ward#s ;
\ test data
person al person bob person cal person dave person ed person fred
pair al bob
pair bob cal
pair cal dave
pair dave ed
pair cal fred cr al . ed . \ 9999 9999
pair al ward cr al . bob . cal . dave . ed . fred . \ 1 2 3 4 5 4
pair dave ward cr al . bob . cal . dave . ed . fred . \ 1 2 2 1 2 3
C++ Templates (don't you just Love how templates can be used for functional programming?)
I'm sorry about the readability of the code, but please do ask questions if you want an explanation (that might help me understand it myself). It's also quite large in comparison to the code here (501 lines), so I've put it on an external web server: http://www.persepolis.se/~salparot/ward_number/
Main code in ward.cc - utilities for some LISP constructs (conses, values and printing functions) in templ_lists2.h
The general idea is a BFS search of the graph of pairs that just terminates as soon as the 'ward' symbol has been found. Well, the rest is in the code, which really is self-explanatory (if you're not picky on the definition of 'explanation'). -- SimonBrenner
Copied from the Scheme examples
let pairings =
["al" , "bob" ;
"bob" , "cal" ;
"cal" , "dave";
"dave", "ed" ;
"cal" , "fred";
"al" , "ward";
"dave", "ward"]
(* assuming that each edge is only listed once *)
let get_partners name =
List.fold_left
(fun base (x, y) ->
if name = x then y :: base
else if name = y then x :: base
else base)
[]
pairings
let rec distance name group =
if List.mem name group then
0
else
succ (distance name
(List.concat (List.map get_partners group)))
(*
Use as follows:
distance "bob" ["ward"] (* returns 2 *)
distance "al" ["fred"] (* returns 3 *)
*)
let ward_numbers = Hashtbl.create 10
let rec assign_ward_number name number =
try
let old_number = Hashtbl.find ward_numbers name in
if number < old_number then begin
Hashtbl.replace ward_numbers name number;
List.iter
(fun partner ->
assign_ward_number partner (succ number))
(get_partners name)
end
with Not_found ->
Hashtbl.add ward_numbers name number;
List.iter
(fun partner ->
assign_ward_number partner (succ number))
(get_partners name)
let () =
assign_ward_number "ward" 0;
Hashtbl.iter (Printf.printf "%s %d\n") ward_numbers
(* outputs:
cal 2
dave 1
al 1
fred 3
ward 0
bob 2
ed 2
*)
--Anon
Add your implementation here.
Hands up who can't understand the programs they posted here anymore :-). -- LukeGorrie
Heck, I'm not sure I understand what I just posted! -- BillTrost
CategoryInManyProgrammingLanguages