share/contrib/prim/prim.mac

   1 /*
   2 I am putting this macsyma implementation of Prim's algorithm in the public
   3 domain.  It is derived from the implementation of the algorithm
   4 in Horowitz and Sahni's book, Fundamentals of Computer Algorithms.
   5 They mention the algorithm first appeared in the Bell System Technical
   6 Journal, in 1957.
   7 dan.stanger@ieee.org
   8 */
   9 prim_cost[0,0]:inf; /* initialize a hashed array */
  10 cost(ii,jj):=block([e,i,j],
  11    if ii > jj then (i:jj,j:ii) else (i:ii,j:jj),
  12    e:prim_cost[i,j],
  13    if arraymake(prim_cost,[i,j]) = e then inf else e
  14 );
  15 fromNode(l):=first(l)$
  16 toNode(l):=second(l)$
  17 /* E array of nodes, COST cost function */
  18 prim(E,COST,n):=block(
  19       [T,mincost,NEAR,k,l],
  20    ?mlocal(NEAR),
  21    array(NEAR,n),
  22    mincost:inf,
  23    for i:1 thru n do block([c,kk,ll],
  24       kk:fromNode(E[i]),ll:toNode(E[i]),
  25       if (c:COST(kk,ll)) < mincost then block(mincost:c,k:kk,l:ll)
  26    ),
  27    T:[[k,l]],
  28    for i:1 thru n do if COST(i,l) < COST(i,k) then NEAR[i]:l else NEAR[i]:k,
  29    NEAR[k]:0,NEAR[l]:0,
  30    for i:2 thru n-1 do block([j:0,maxcost:inf],
  31       for jj:1 thru n do block(
  32          if NEAR[jj] # 0 and COST(jj,NEAR[jj]) < maxcost then block(
  33             maxcost:COST(jj,NEAR[jj]), j:jj)
  34       ),
  35       if j > 0 then block(
  36          T:cons([j, NEAR[j]],T),
  37          mincost:mincost+COST(j,NEAR[j]),
  38          NEAR[j]:0,
  39          for k:1 thru n do block(
  40             if NEAR[k] # 0 and COST(k,NEAR[k]) > COST(k,j) then NEAR[k]:j
  41          )
  42       )
  43    ),
  44    ?MUNLOCAL(),
  45    T
  46 )$
  47