% :- ensure_loaded( 'System/Swi/std' ). % :- ensure_loaded( 'System/Swi/sicstus_ordsets' ). :- ensure_loaded( rationals ). % :- cond_load( sicstus(_Any), true, % [ compilation_mode(consult) ], % [ library(lists), % % member/2 % 'System/Sicstus/std' % ] ). e_test( Prb, Vars ) :- Vars = [_A,_B,_C], values( [(1/6, [(1/2,a),(2/3,b),(1/2,c)], [ [], [], []] ) ], [], [], % [(1,(1/2,a),(2/3,b),(1/2,c))], [], Prb, Vars ). test( Prb-ValPrbs-Vals ) :- Vals = [_A,_B,_C], Branch = [ ( 1/6, [(1/2,a),(2/3,b),(1/2,c)], [ [(1/2,a),(1/3,b),(1/6,c)], [(2/3,b),(1/6,a),(1/6,c)], [(1/2,c),(1/4,a),(1/4,b)] ] ) ], add_to_visited( [], Branch, Vis ), values( Branch, 1, [], Vis, % [], % [(1,(1/2,a),(2/3,b),(1/2,c))], [], Prb, ValPrbs, Vals ). % X1 e [a,b,c]{1/2,1/3,1/6} % X2 e [b,a,c]{2/3,1/6,1/6} % X3 e [c,a,b]{1/2,1/4,1/4} values( _Branches, _Iter, _VisBr, Valuations, _Seen, Prb, ValPrbs, Vals ) :- % valuation( Valuation, Vars ). member( Prb-Pairs, Valuations ), pair_list( Pairs, ValPrbs, Vals ). values( [Branch|Tree], Iter, Vis, _OldValuations, Seen, Prb, ValPrbs, Vals ) :- % write( in_tree([Branch|Tree]) ), nl, % write( iteration(Iter) ), NxIter is Iter + 1, length( [Branch|Tree], Length ), write( number_of_nodes(Length) ), nl, Branch = (BrPrb,BrConsistent,BrContin), findall( Nth-ElPrb-El-ElContin, % next_step( BrContin, Nth, NthQuotient, ElPrb, ElContin ), next_step( BrContin, Nth, ElPrb, El, ElContin ), Steps ), ramify( Steps, BrPrb, BrConsistent, Vis, Seen, Tree, Valuations, NxSeen, NxTree ), add_to_visited( Vis, Branch, NxVis ), values( NxTree, NxIter, NxVis, Valuations, NxSeen, Prb, ValPrbs, Vals ). next_step( [[(HPrb,HEl)|TPairs]|Dms], 1, HPrb, HEl, [TPairs|Dms] ). next_step( [SkipDm|Dms], N, HPrb, HEl, [SkipDm|NxDms] ) :- next_step( Dms, PrvN, HPrb, HEl, NxDms ), N is PrvN + 1. ramify( [], _BrPrb, _BrConsistent, _Vis, Seen, Tree, [], Seen, Tree ). ramify( [H|T], BrPrb, BrConsistent, Vis, Seen, Tree, Valuations, NewSeen, NewTree ) :- H = Nth-ElPrb-El-ElContin, % write( ramifying(Nth,by(El),on(BrConsistent) ) ), nl, ( new_valuation( Nth, Nth, BrConsistent, [], ElPrb, El, ElContin, NewConsistent, Quotient ) -> % write( new_consistent(NewConsistent) ), nl, true ; % write( no_new_consistent ), nl, NewConsistent = BrConsistent, Quotient = 1 / 1 ), rationals_multiplication( BrPrb, Quotient, NewBrPrb ), NewBranch = (NewBrPrb, NewConsistent, ElContin), % write( new_branch(NewBranch) ), nl, % write( predated_seen(Seen) ), nl, update_seen_valuations( Seen, NewConsistent, NewBrPrb, Valuations, TValuations, NxSeen ), % write( updated_seen(NxSeen) ), nl, insert_ramify( Tree, NewBrPrb, Vis, NewBranch, NxTree ), ramify( T, BrPrb, BrConsistent, Vis, NxSeen, NxTree, TValuations, NewSeen, NewTree ). new_valuation( 1, Pos, [(PrvPrb,_PrvEl)|T], AccConsistent, ElPrb, El, Contin, Consistent, Quotient ) :- !, rationals_invert( PrvPrb, PrvFactor ), ( xchange_nth1( T, (ClashPrb,El), RelClashPos, (NoClashPrb,NoClashEl), NoClashT ) -> ClashPos is RelClashPos + Pos, rappend( AccConsistent, [(ElPrb,El)|T], [(ElPrb,El)|NoClashT], AlmostConsistent, Consistent ), nth1( ClashPos, Contin, LookHere ), find_consistent_value( LookHere, AlmostConsistent, (NoClashPrb,NoClashEl) ), % Quoatient = ElPrb * (1/ClashPrb) * NoClashPrb rationals_invert( ClashPrb, ClashFactor ), rationals_multiplication_list( [PrvFactor,ElPrb,ClashFactor,NoClashPrb], Quotient ) ; reverse( AccConsistent, RevAccConsistent ), % append( RevAccConsistent, [H|T], append( RevAccConsistent, [(ElPrb,El)|T], Consistent ), rationals_multiplication( PrvFactor, ElPrb, Quotient ) % Quotient = ElPrb ). new_valuation( N, Pos, [(HPrb,HEl)|T], AccConsistent, ElPrb, El, Contin, Consistent, Quotient ) :- Nminus is N - 1, ( HEl == El -> % reverse( AccConsistent, RevAccConsistent ), % append( RevAccConsistent, [(HPrb,HEl)|T], PreConsistent ), nth1_xchange( Nminus, T, (OldPivPrb,_OldPivEl), (ElPrb,El), ConsistentT ), rappend( AccConsistent, [(HPrb,HEl)|ConsistentT], [(NoClashPrb,NoClashEl)|ConsistentT], AlmostConsistent, Consistent ), Nth1 is Pos - Nminus, nth1( Nth1, Contin, LookHere ), find_consistent_value( LookHere, AlmostConsistent, (NoClashPrb,NoClashEl) ), % Nth1 is Pos - Nminus, % nth1( Nth1, Contin, LookHere ), % find_consistent_value( LookHere, AlmostConsistent, (NoClashPrb,NoClashEl) ), % Nminus is N - 1, % new_valuation( Nminus, Pos, T, [(NoClashPrb,NoClashEl)|AccConsistent], ElPrb, El, Contin, Consistent, _Irrelevant ), rationals_invert( OldPivPrb, OldPivFactor ), rationals_invert( HPrb, HFactor ), rationals_multiplication_list( [OldPivFactor,ElPrb,HFactor,NoClashPrb], Quotient ) ; new_valuation( Nminus, Pos, T, [(HPrb,HEl)|AccConsistent], ElPrb, El, Contin, Consistent, Quotient ) ). update_seen_valuations( Seen, Consistent, Prb, Valuations, TValuations, NwSeen ) :- consistent_to_seen( Prb, Consistent, SeeStruct ), % ( ordset_int_index_pair_member_add( Seen, SeeStruct, NwSeen ) -> ( ord_add_element_unique( Seen, SeeStruct, NwSeen ) -> Valuations = [Prb-Consistent|TValuations] ; Valuations = TValuations, NwSeen = Seen ). consistent_to_seen( Nom/_Dnm, Consistent, (Hash,Consistent) ) :- Hash is Nom mod 10000. insert_ramify( Tree, NewBrPrb, Vis, NewBranch, NxTree ) :- ( already_visited(NewBranch,Vis) -> % write( rejecting_for_visited(NewBranch) ), nl, NxTree = Tree ; insert_ramify( Tree, NewBrPrb, NewBranch, NxTree ) ). insert_ramify( [], _NewBrPrb, NewBranch, [NewBranch] ). % write( accepting_branch_as_last(NewBranch) ),nl. insert_ramify( [Branch|Tree], NewBrPrb, NewBranch, NxTree ) :- Branch = (BrPrb,_BrConsistent,_BrContin), ( BrPrb > NewBrPrb -> NxTree = [Branch|RestTree], insert_ramify( Tree, NewBrPrb, NewBranch, RestTree ) ; ( Branch == NewBranch -> % write( rejecting_branch(NewBranch) ),nl, NxTree = [Branch|Tree] ; % write( accepting_branch(NewBranch) ),nl, NxTree = [NewBranch,Branch|Tree] ) ). % nth1_xchange( +List, +OldElem, ?Nth1, +NewElem, ?NewList ) :- xchange_nth1( [H|T], H, 1, Xc, [Xc|T] ) :- !. xchange_nth1( [H|T], El, N, ElXc, [H|Rest] ) :- xchange_nth1( T, El, PrevN, ElXc, Rest ), N is PrevN + 1. % nth1_xchange( +N, +List, ?OldElem, +NewElem, ?NewList ) :- % -OldElem will only work for the first instance. nth1_xchange( 1, [H|T], H, Xc, [Xc|T] ) :- !. nth1_xchange( N, [H|T], El, ElXc, [H|Rest] ) :- Nminus is N - 1, nth1_xchange( Nminus, T, El, ElXc, Rest ). % rappend( +AccConsistent, +T, +NoClashT, ?AlmostConsistent, ?Consistent ), % reverse the first argument, and stick the result infront of lists % in arguments 2 and 3 to get the corresponding 4 and 5. rappend( [], Almost, Cons, Almost, Cons ). rappend( [H|T], ClashTail, NoClashTail, Almost, Cons ) :- rappend( T, [H|ClashTail], [H|NoClashTail], Almost, Cons ). % find_consistent_value( +SetOfPairs, +Valuation, -NoClashPair ) :- % Look for the first Prb, El pair in SetOfPairs that doesnt appear in % Valuation, and give the results in NoClashPair. Note Valuation % might not be consistent per se (ie most likely includes the element % NoClash pair will replace twice). find_consistent_value( [(HPrb,HEl)|T], Valuation, NoClashPair ) :- ( \+ member( (_IrrlvPrb,HEl), Valuation ) -> NoClashPair = (HPrb,HEl) ; find_consistent_value( T, Valuation, NoClashPair ) ). % the difference from the sicstus one % is that we fail if element exists. ord_add_element_unique( [], Elem, [Elem] ). ord_add_element_unique( [H|T], Elem, [H1|T1] ) :- ( H @>= Elem -> ( H = Elem -> fail ; H1 = Elem, T1 = [H|T] ) ; H1 = H, ord_add_element_unique( T, Elem, T1 ) ). % visited ... add_to_visited( Vis, Branch, [Branch|Vis] ). already_visited( NewBranch, Vis ) :- member( NewBranch, Vis ). % pair_list pair_list( [], [], [] ). pair_list( [(A,B)|T], [A|T1], [B|T2] ) :- pair_list( T, T1, T2 ).