PROGRAM hamil; USES crt; (********************** Representation for large integers: *********) CONST digits = 8; (* digits*3 = maximum number of digits used for counting *) TYPE count_t = ARRAY[1..digits]OF word; PROCEDURE assign(VAR c, s : count_t); VAR i : byte; BEGIN FOR i := 1 TO digits DO c[i] := s[i]; END; PROCEDURE assign_word(VAR c : count_t; w : word); VAR i : byte; BEGIN c[1] := w; FOR i := 2 TO digits DO c[i] := 0; END; PROCEDURE print_count(c : count_t); VAR i : byte; f : boolean; BEGIN f := TRUE; FOR i := digits DOWNTO 1 DO IF f THEN IF (c[i] = 0) AND (i <> 1) THEN write(' ') ELSE BEGIN write(c[i]:3); f := FALSE END ELSE write(c[i] DIV 100, (c[i] DIV 10) MOD 10, c[i] MOD 10); END; VAR carry_error : boolean; PROCEDURE add_to(VAR sum, add : count_t); VAR i : byte; carry : word; BEGIN carry := 0; FOR i := 1 TO digits DO BEGIN sum[i] := sum[i] + add[i] + carry; IF sum[i] > 999 THEN BEGIN sum[i] := sum[i] - 1000; carry := 1; END ELSE carry := 0; END; IF carry > 0 THEN carry_error := TRUE; END; (*********************** CONSTS ***************) CONST tsize = 8; tsizem1 = 7; TYPE num = 1..tsize; numm1 = 1..tsizem1; (******************* PRE_STATE ****************) VAR corners : ARRAY[num] OF byte; size, sizem1 : byte; pre_state : ARRAY[num] OF boolean; not_fixed : ARRAY[num] OF boolean; PROCEDURE init_pre_state; VAR i : num; BEGIN FOR i := 1 TO size DO BEGIN pre_state[i] := corners[i] = 0; not_fixed[i] := corners[i] = 1; END; END; FUNCTION no_next_pre_state : boolean; VAR i : byte; go : boolean; BEGIN i := 0; go := TRUE; WHILE go AND (i < size) DO BEGIN inc(i); IF not_fixed[i] THEN IF pre_state[i] THEN pre_state[i] := FALSE ELSE go := FALSE END; IF NOT go THEN pre_state[i] := TRUE; no_next_pre_state := go END; (******************* BRIDGE ****************) VAR bridge : ARRAY[numm1] OF boolean; PROCEDURE init_bridge; VAR i : num; BEGIN FOR i := 1 TO sizem1 DO bridge[i] := FALSE END; FUNCTION no_next_bridge : boolean; VAR i : byte; go : boolean; BEGIN i := 0; go := TRUE; WHILE go AND (i < sizem1) DO BEGIN inc(i); IF bridge[i] THEN bridge[i] := FALSE ELSE go := FALSE END; IF NOT go THEN bridge[i] := TRUE; no_next_bridge := go END; (******************** STATES ***************) TYPE t_state_repr = ARRAY[num] OF byte; TYPE p_state = ^t_state; p_bridge = ^t_bridge; t_state = RECORD repr : t_state_repr; bridges : p_bridge; old_c , new_c : count_t; next : p_state; END; t_bridge = RECORD from_state : p_state; next : p_bridge; END; VAR all_states : p_state; nr_states, cur_state_nr, nr_bridges : integer; PROCEDURE init_all_states; VAR i : byte; BEGIN nr_states := 1; nr_bridges := 0; cur_state_nr := 0; new(all_states); WITH all_states^ DO BEGIN FOR i := 1 TO size DO repr[i] := 0; bridges := NIL; next := NIL END; END; FUNCTION compair(a, b : t_state_repr) : boolean; VAR i : byte; eq : boolean; BEGIN eq := TRUE; i := 0; WHILE (i < size) AND eq DO BEGIN inc(i); eq := a[i] = b[i]; END; compair := eq; END; PROCEDURE add_connection(old_state : p_state; new_state_repr : t_state_repr); VAR ref_state : p_state; bridge : p_bridge; BEGIN inc(nr_bridges); ref_state := all_states; WHILE (NOT compair(ref_state^.repr, new_state_repr)) AND (ref_state^.next <> NIL) DO ref_state := ref_state^.next; IF (NOT compair(ref_state^.repr, new_state_repr)) THEN BEGIN inc(nr_states); new(ref_state^.next); ref_state := ref_state^.next; ref_state^.repr := new_state_repr; ref_state^.bridges := NIL; ref_state^.next := NIL; END; new(bridge); bridge^.next := ref_state^.bridges; bridge^.from_state := old_state; ref_state^.bridges := bridge; END; VAR state : t_state_repr; (* representatie van huidige state *) PROCEDURE print_state; VAR i : byte; BEGIN FOR i := 1 TO size DO BEGIN gotoxy(1,2*i); IF state[i] > 0 THEN write('-- ',state[i],' --'); END; END; PROCEDURE print_bridge; VAR i : byte; BEGIN FOR i := 1 TO sizem1 DO BEGIN gotoxy(8,2*i+1); IF bridge[i] THEN write('|'); END; END; FUNCTION bridge_fits_to_state{bridge, state} : boolean; VAR i, c : byte; correct : boolean; BEGIN { clrscr; } { print_state; } { print_bridge; } { gotoxy(1,19); } { write('bridge_fits_to_state'); } correct := TRUE; i := 0; c := 0; WHILE (i < size) AND correct DO BEGIN inc(i); IF (c > 0) AND (state[i] > 0) AND ((c = state[i]) OR ((i < size) AND bridge[i])) THEN correct := FALSE ELSE IF (i < sizem1) AND bridge[i] THEN IF state[i] > 0 THEN c := state[i] ELSE IF c = 0 THEN c := 255 ELSE ELSE c := 0 END; { IF correct THEN write(' is correct') ELSE write(' is not correct'); } { REPEAT UNTIL readkey <> #0; } bridge_fits_to_state := correct; END; PROCEDURE print_corners; VAR i : byte; BEGIN FOR i := 1 TO size DO BEGIN gotoxy(8,2*i); write(corners[i]); END; END; PROCEDURE make_corners{state,bridge -> corners}; VAR i : byte; BEGIN FOR i := 1 TO size DO IF state[i] > 0 THEN corners[i] := 1 ELSE corners[i] := 0; FOR i := 1 TO sizem1 DO IF bridge[i] THEN BEGIN inc(corners[i]); inc(corners[i+1]); END; { print_corners; } END; PROCEDURE print_pre_state; VAR i : byte; BEGIN FOR i := 1 TO size DO BEGIN gotoxy(10,2*i); IF pre_state[i] THEN write('-- --'); END; END; VAR new_state : t_state_repr; PROCEDURE print_new_state; VAR i : byte; BEGIN FOR i := 1 TO size DO BEGIN gotoxy(13,2*i); IF new_state[i] > 0 THEN write(new_state[i]); END; { REPEAT UNTIL readkey <> #0; } END; PROCEDURE walk{state, bridge, corners}(VAR p, mark : byte); VAR j : integer; scan, not_found : boolean; BEGIN scan := TRUE; inc(mark); WHILE scan DO BEGIN IF (p > 1) AND (bridge[p-1]) THEN WHILE (p > 1) AND bridge[p-1] DO BEGIN dec(p); inc(mark); END ELSE IF (p < size) AND bridge[p] THEN WHILE (p < size) AND bridge[p] DO BEGIN inc(p); inc(mark); END; IF state[p] > 0 THEN BEGIN j := 0; not_found := TRUE; WHILE (j < size) AND not_found DO BEGIN inc(j); IF (p <> j) AND (state[p] = state[j]) THEN not_found := FALSE; END; IF not_found THEN scan := FALSE ELSE BEGIN p := j; inc(mark); END; IF corners[p] = 1 THEN scan := FALSE; END ELSE scan := FALSE; END; END; FUNCTION make_new_state{state, bridge, pre_state -> new_state} : boolean; VAR i, v, p, mark, disp : byte; BEGIN { gotoxy(1,21); } { write('make_new_state'); } FOR i := 1 TO size DO new_state[i] := 0; v := 0; mark := 0; disp := 0; FOR i := 1 TO size DO IF pre_state[i] AND (new_state[i] = 0) THEN BEGIN inc(v); new_state[i] := v; p := i; walk(p, mark); IF (new_state[p] = 0) AND pre_state[p] THEN new_state[p] := v ELSE inc(disp); END; IF mark > 0 THEN make_new_state := (mark = size) AND (disp <= 2) ELSE IF bridge[1] THEN BEGIN dec(corners[1]); dec(corners[2]); bridge[1] := FALSE; p := 1; walk(p, mark); IF p = 2 THEN make_new_state := FALSE ELSE BEGIN p := 2; walk(p, mark); make_new_state := mark = size END; bridge[1] := TRUE; inc(corners[1]); inc(corners[2]); END ELSE BEGIN p := 1; walk(p, mark); make_new_state := mark = size; END; { print_new_state; } { gotoxy(1,22); } { write(' (marked = ',mark,', disp = ',disp,')'); } { REPEAT UNTIL readkey <> #0; } END; PROCEDURE print_states(walk_state : p_state); VAR b : p_bridge; i : byte; nr : integer; PROCEDURE new_line; BEGIN inc(nr); IF nr < 21 THEN writeln ELSE BEGIN nr := 2; writeln; write('Press for more.'); REPEAT UNTIL readkey <> #0; gotoxy(1, wherey); clreol; END END; BEGIN clrscr; highvideo; write(' THE GRAMMER '); gotoxy(1,24); writeln('("... a ... -> b" means there is a rule A -> a B.)'); normvideo; window(1,2,79,23); nr := 1; WHILE walk_state <> NIL DO BEGIN b := walk_state^.bridges; WHILE b <> NIL DO BEGIN IF wherex > 78 - size THEN BEGIN new_line; write(' ':size,' '); END; FOR i := 1 TO size DO BEGIN write(b^.from_state^.repr[i]); END; b := b^.next; write(' '); END; IF wherex > 75 - size THEN BEGIN new_line; write(' ':size, ' '); END; write('-> '); WITH walk_state^ DO BEGIN FOR i := 1 TO size DO write(repr[i]); END; new_line; walk_state := walk_state^.next; END; window(1,1,80,24); gotoxy(1,24); clreol; END; PROCEDURE print_connection; VAR i : byte; BEGIN FOR i := 1 TO size DO BEGIN gotoxy(1,i*2+4); IF state[i] = 0 THEN write(' +') ELSE write('--(',state[i],')--+'); IF new_state[i] = 0 THEN write(' ') ELSE write('--(',new_state[i],')--'); IF i < size THEN BEGIN gotoxy(8,i*2+5); IF bridge[i] THEN write('|') ELSE write(' ') END END END; (******************* counting ***********************) PROCEDURE init_counting(walk_state : p_state); BEGIN assign_word(walk_state^.old_c, 1); assign_word(walk_state^.new_c, 0); walk_state := walk_state^.next; WHILE walk_state <> NIL DO BEGIN assign_word(walk_state^.new_c, 0); assign_word(walk_state^.old_c, 0); walk_state := walk_state^.next; END; END; PROCEDURE pre_next_step(walk_state : p_state); BEGIN assign_word(walk_state^.old_c, 0); assign_word(walk_state^.new_c, 0); walk_state := walk_state^.next; WHILE walk_state <> NIL DO BEGIN assign(walk_state^.old_c, walk_state^.new_c); assign_word(walk_state^.new_c, 0); walk_state := walk_state^.next; END; END; PROCEDURE next_step_counting(walk_state : p_state); VAR b : p_bridge; i : byte; BEGIN WHILE walk_state <> NIL DO BEGIN b := walk_state^.bridges; WHILE b <> NIL DO BEGIN add_to(walk_state^.new_c, b^.from_state^.old_c); b := b^.next; END; walk_state := walk_state^.next; END; END; (******************* hoofdprogramma ******************) VAR next_state : p_state; i : integer; input_string : string[20]; code : integer; BEGIN clrscr; highvideo; writeln(' COUNTING HAMILTON PATHS'); normvideo; writeln; writeln('This program calculates the number of distinct hamilton paths'); writeln('for the product graph of two line graphs.'); writeln('It asks for the number of points of one of these line graphs,'); writeln('and calculates the number of distint hamilton paths where'); writeln('the number of points of the other line graph varies from one to'); writeln('a certain number n (which is determined by the maximum size of'); writeln('representation of numbers that is used by the program).'); writeln; writeln('The program first generates a regular grammer, of which each'); writeln('complete derivation represents one hamilton path. Then it'); writeln('calculates the number of derivations for each length.'); writeln; REPEAT write('Give the number of points of the first line graph (2..',tsize,'): '); readln(input_string); val(input_string, size, code); UNTIL (code = 0) AND (size > 1) AND (size <= tsize); clrscr; highvideo; writeln(' THE CONSTRUCTION OF THE GRAMMAR'); normvideo; sizem1 := size-1; init_all_states; next_state := all_states; WHILE next_state <> NIL DO BEGIN inc(cur_state_nr); state := next_state^.repr; init_bridge{bridge}; REPEAT { print_bridge; } IF bridge_fits_to_state{bridge, state} THEN BEGIN make_corners{bridge, state -> corners}; init_pre_state{corners,pre_state,not_fixed}; REPEAT IF make_new_state{state, bridge, pre_state -> new_state} THEN BEGIN print_connection; add_connection(next_state, new_state); gotoxy(40,12); write('Memory left : ',memavail,' bytes '); gotoxy(40,6); write('Tot. nonterm. : ',nr_states); gotoxy(40,7); write('Cur. nonterm. : ',cur_state_nr); gotoxy(40,8); write('Tot. rules : ',nr_bridges); gotoxy(40,9); write('rules/nonterm. : ',nr_bridges/nr_states); IF memavail < 100 THEN BEGIN gotoxy(1,24); write('Not sufficient memory aviable. ', 'press '); REPEAT UNTIL readkey = ' '; Halt(1); END END; UNTIL no_next_pre_state{pre_state,not_fixed} END; UNTIL no_next_bridge{bridge}; next_state := next_state^.next; END; gotoxy(1,24); write('press for the grammer.' ); REPEAT UNTIL readkey = ' '; clrscr; print_states(all_states); gotoxy(1,24); write('press for number of paths.'); REPEAT UNTIL readkey = ' '; clrscr; highvideo; writeln(' RESULTS OF HAMILTON PATH COUNTING ALGORITHM'); writeln; writeln(' #points #paths '); normvideo; window(1,4,79,24); carry_error := FALSE; init_counting(all_states); i := 0; WHILE (i < 100) AND (NOT carry_error) DO BEGIN inc(i); next_step_counting(all_states); IF (NOT carry_error) THEN BEGIN write(i:3,' '); print_count(all_states^.new_c); writeln; IF (i MOD 20) = 0 THEN BEGIN write('press for more'); REPEAT UNTIL readkey <> #0; gotoxy(1, wherey); clreol; END; pre_next_step(all_states); END; END; write('Press for end of program.'); window(1,1,79,24); REPEAT UNTIL readkey <> #0; clrscr; gotoxy(20,10); writeln('This program was written by F.J.Faase.'); END.