program an_log_n_parallel_connectivity_algorithm_by_Shiloach_and_Vishkin; (* An O(log n) Parallel Connectivity Algorithm *) (* Yossi Shiloach (IBM Israel) and Uzi Vishkin (Comp Sci. Dep. Haifa) *) (* Journal of Algorithms 57-67 (1982) *) const max = 31; type edge = array [1..2] of integer; edges = array [0..max] of edge; vector = array [0..max] of integer; var E : edges; n, (* number of vertices *) m (* number of edges *), dosm (* number of oriented edges *), dosmMenosUno : integer; O, C, (* pseudo components *) Stagnant : vector; stage,newStage : integer; procedure reading; var i : integer; begin write('N£mero de v‚rtices: '); readln(n); writeln('Lectura de ARISTAS (dos n£meros entre 1 y ',n, '). 0 0 para terminar.'); i := 0; repeat write('Arista ',i,'-‚sima: '); read(E[i][1]); readln(E[i][2]); i := i+1; if i = max then E[i][1] := 0; until (E[i-1][1] <= 0) or (E[i-1][2] <= 0); i := i-1; m := i; dosm := 2*i; dosmMenosUno := dosm-1; while (i < dosm) do begin E[i][1] := E[i-m][2]; E[i][2] := E[i-m][1]; i := i+1; end; writeln('grafo con ',m,' aristas.'); i := 0; while (i < dosm) do begin write('(',E[i][1],',',E[i][2],') '); i := i+1; if (i mod 10) = 0 then writeln; end; writeln; end (* procedure reading *); procedure writing; var i : integer; begin i := 1; writeln('C'); while (i<=n) do begin write('(',i,',',C[i],') '); if (i mod 10) = 0 then writeln; i := i+1; end; writeln; writeln('Stagnant'); i := 1; while (i<=n) do begin write('(',i,',',stagnant[i],') '); if (i mod 10) = 0 then writeln; i := i+1; end; read(i); end (* writing *); begin reading; parallel 1..n do begin C[name] := name; Stagnant[name] := 0; end; stage := 1; newStage := 1; while stage = newStage do begin writeln('Stage = ',stage); (* STEP 1 *) parallel 1..n do begin O[name] := C[name]; C[name] := C[C[name]]; (* shortcutting *) if O[name] <> C[name] then Stagnant[C[name]] := stage; end; writeln('STEP 1'); writing; (* STEP 2 *) parallel 0..dosmMenosUno do var i,j : integer; begin i := E[name][1]; j := E[name][2]; if C[i] = O[i] then if C[i] > C[j] then begin C[C[i]] := C[j]; if C[C[i]] = C[j] then Stagnant[C[j]] := stage; end; end; writeln('STEP 2'); writing; (* STEP 3 *) parallel 0..dosmMenosUno do var i,j : integer; begin i := E[name][1]; j := E[name][2]; if (C[i] = C[C[i]]) and (stagnant[C[i]] < stage) then if C[i] <> C[j] then C[C[i]] := C[j]; end; writeln('STEP 3'); writing; parallel 1..n do begin (* STEP 4 *) C[name] := C[C[name]]; (* shortcutting *) end; writeln('STEP 4'); writing; (* STEP 5 *) parallel 1..n do begin if Stagnant[name] = stage then newStage := newStage+1; end; stage := stage+1; end (* while stage = newStage *); writeln('RESULTADOS: '); writing; end.