Beispiel exam54, eine ältere Version von SMASS

/* exam54, eine ältere Version von SMASS */

:- multifile fact/3 .
% „sim“ (basic programm for SMASS)
/* some new lines unite the list of variables */

start:-
consult(para), consult(pred), consult(rules), consult(display),

check_inconsistent_parameters,
( exists_file(results), delete_file(results)
;
true
),
( exists_file(data), delete_file(data)
;
true
),

modes(L), make_list_of_variables(L,LV),
make_reduced_list_of_variables(L,LV,RLV),
use_old_data(X),
( X = no,

create_data(L,RLV)
; X = yes, consult(data)
),
begin.

check_inconsistent_parameters :- actors(AS),
gridwidth(G), G1 is G*G,
( AS =< G1
;
G1 < AS, write(too_many_actors_for_the_grid), fail
).

make_list_of_variables(L,LV) :- asserta(list_of_variables([])),
length(L,E),
( between(1,E,NM), build_list_of_variables(NM,L), fail ; true ),
list_of_variables(LV), retract(list_of_variables(LV)),!.

build_list_of_variables(NM,L) :- nth1(NM,L,M), variables_in_rule(M,LM),
list_of_variables(LVdyn), append(LVdyn,LM,Lnew),
retract(list_of_variables(LVdyn)), asserta(list_of_variables(Lnew)),!.

make_reduced_list_of_variables(L,LV,RLV) :-
length(LV,EV),
asserta(list_of_variables([])),
( between(1,EV,NV), minimize_list_of_variables(NV,LV), fail ; true),!,
list_of_variables(RLV), retract(list_of_variables(RLV)),!.

minimize_list_of_variables(NV,LV) :- list_of_variables(LVdyn),
nth1(NV,LV,V),
( member(V,LVdyn)
;
append(LVdyn,[V],LVnew),
retract(list_of_variables(LVdyn)),
asserta(list_of_variables(LVnew))
),!.

create_data(L,RLV) :-
consult(create),
make_global_data(L),
length(RLV,EV),
( between(1,EV,NV), nth1(NV,RLV,VAR), make(VAR), fail ; true ),
retractall(int_loc(WW1,WW2,WW3)), /* muss verallgemeinert werden */
!.

make_global_data(L) :- actors(AS), make_characters(AS,L).

% —————————————————————————————————-

begin :- runs(RR), periods(TT),
( between(1,RR,R), mainloop(R,TT), fail; true ), !,
make_pictures.

mainloop(R,TT) :-
consult(data),
findall(X,fact(0,0,X),L), length(L,E),
( between(1,E,Z), nth1(Z,L,FACT), append(results),
write(fact(R,1,FACT)), write(‚.‘), nl, told,
asserta(fact(R,1,FACT)), retract(fact(0,0,FACT)), fail
; true
), append(results), nl, told,
( between(1,TT,T), kernel(R,T), fail; true ),
retract_facts,!.
retract_facts :- ( fact(X,Y,Z), retract(fact(X,Y,Z)), fail; true ).

kernel(R,T) :-
prepare_indivi(R,T),
actors(AS), findall(I,between(1,AS,I),L),
asserta(actor_list(L)),
( between(1,AS,N), choose_and_activate_actor(R,T,N), fail
;
true
), retract(actor_list(L1)),
adjust(R,T),!.

prepare_indivi(R,T) :- modes(LM), length(LM,EM),
( between(1,EM,NM), nth1(NM,LM,MOD), prepare(R,T,MOD), fail ; true),!.
choose_and_activate_actor(R,T,N) :- actor_list(L), length(L,E),
Y is random(E)+1, nth1(Y,L,A), activate(R,T,A), delete(L,A,L1),
retract(actor_list(L)), asserta(actor_list(L1)),!.

activate(R,T,A) :- check_environment(R,T,A),
( execute_protocols(R,T,A)
;
choosemode(R,T,A,M),
( act_in_mode(M,A,R,T) ; true)
), !.

check_environment(R,T,A) :- true.

execute_protocols(R,T,A) :- protocol(M,A,R,T).

adjust(R,T) :- modes(L),
length(L,E), actors(AS),
( between(1,E,X), individual_adjust(X,R,T,AS,L), fail; true ),
global_adjust(R,T),
append(results), nl, told,!.

individual_adjust(X,R,T,AS,L) :- nth1(X,L,Z),
( between(1,AS,A), adjust(Z,A,R,T), fail ; true),!,
adjust(Z,R,T).

global_adjust(R,T) :- T1 is T+1, repeat,
( fact(R,T,FACT), retract(fact(R,T,FACT)), asserta(fact(R,T1,FACT)),
append(results), write(fact(R,T1,FACT)), write(‚.‘), nl, told,
fail
; true
),!.

choosemode(R,T,A,M) :-
fact(R,T,character(A,C,SUM)), length(C,K),
modes(L),
Z is random(SUM * 1000)+1, asserta(aux_sum(0)),
between(1,K,X), do1(X,Z,C,Y), Z =< Y , nth1(X,L,M),
retract(aux_sum(SS)),!.

do1(X,Z,C,Y) :- aux_sum(S), nth1(X,C,C_X), Y is S + (C_X * 1000),
retract(aux_sum(S)), asserta(aux_sum(Y)),!.

% ————————————————————————————-

make_pictures :- modes(LM), length(LM,EM),
consult(results), /* this file should be reduced */
( between(1,EM,NM), nth1(NM,LM,MOD), make_picture(MOD), fail ; true),!.

/* ———————————————–
Die Datei create54
(this module generates characters and data in SMASS) */

:- dynamic fact/3 .

make_characters(AS,L) :- build_up_characters(AS,L),
export_results(AS).

build_up_characters(AS,L) :- length(L,E),

notrace,
( between(1,E,X), make_distribution(X,L,E,AS), fail ; true ),
( between(1,AS,A), collect_characters(L,E,A), fail ; true),
retractall(dd_expr(M1,M2,M3)), !.

make_distribution(X,L,E,AS) :- nth1(X,L,M), weights(M,EX,LIST),
make_discrete_distribution(M,AS,EX,LIST), !.

collect_characters(L,E,A) :- asserta(character(A,[])),
( between(1,E,X), nth1(X,L,M), add_character(M,A), fail; true ),!.

add_character(M,A) :- dd_expr(M,A,C), character(A,L1), append(L1,[C],L2),
retract(character(A,L1)), asserta(character(A,L2)),!.

export_results(AS) :- ( between(1,AS,A), export_res(A), fail; true),!.

export_res(A) :- character(A,L2), calculate_sum(L2,SUM),
append(data),
write(fact(0,0,character(A,L2,SUM))), write(‚.‘), nl, told,
retract(character(A,L2)),!.

% ———————————————————————————

make(wealth_dono) :- actors(AS), domain_of_wealth_dono(L,U),
sigma_wealth_dono(SI), normal_distribution(wealth_dono,AS,L,U,SI),
( between(1,AS,A), nd_expr(wealth_dono,A,W), append(data),
write(fact(0,0,wealth_dono(A,W))), write(‚.‘), nl, told,
retract(nd_expr(wealth_dono,A,W)), fail
; true
),!.

make(wealth_take) :- actors(AS), domain_of_wealth_take(L,U),
sigma_wealth_take(SI), normal_distribution(wealth_take,AS,L,U,SI),
( between(1,AS,A), nd_expr(wealth_take,A,W), append(data),
write(fact(0,0,wealth_take(A,W))), write(‚.‘), nl, told,
retract(nd_expr(wealth_take,A,W)), fail
; true
),!.

make(strength) :- actors(AS), weights(strength,LIST),
expressions(strength,EX),
make_discrete_distribution(strength,AS,EX,LIST),
( between(1,AS,A), dd_expr(strength,A,W), append(data),
write(fact(0,0,strength(A,W))), write(‚.‘), nl, told,
retract(dd_expr(strength,A,W)), fail
; true
),!.

make(location) :- actors(AS), gridwidth(G), G1 is G*G,
findall(X,between(1,G1,X), L), asserta(cell_list(L)),
( between(1,AS,A), locate(A), fail ; true),
retractall(cell_list(L2)),!.

locate(A) :- cell_list(L), length(L,E), X is random(E)+1, nth1(X,L,Y),
gridwidth(G), decompose(Y,I,J,G),
append(data), write(fact(0,0,location(A,I,J))), write(‚.‘), nl, told,
asserta(int_loc(A,I,J)),
delete(L,Y,L1),
retract(cell_list(L)), asserta(cell_list(L1)),!.

make(colour) :- actors(AS),
( between(1,AS,A), set_colour(A), fail ; true),!.

set_colour(A) :-
int_loc(A,I,J),
N is I+J,
N1 is N mod 2, append(data),
( N1 =:= 0, write(fact(0,0,colour(A,white))), write(‚.‘), nl
;
write(fact(0,0,colour(A,black))), write(‚.‘), nl
), told, nl, !.

/* —————————————————
Die Datei data54 */

fact(0, 0, character(1, [1, 1, 1], 3)).
fact(0, 0, character(2, [2, 1, 1], 4)).
fact(0, 0, character(3, [2, 1, 1], 4)).
fact(0, 0, character(4, [1, 1, 1], 3)).
fact(0, 0, character(5, [2, 1, 1], 4)).
fact(0, 0, character(6, [2, 1, 1], 4)).
fact(0, 0, character(7, [1, 1, 1], 3)).
fact(0, 0, wealth_dono(1, 286)).
fact(0, 0, wealth_dono(2, 285)).
fact(0, 0, wealth_dono(3, 255)).
fact(0, 0, wealth_dono(4, 263)).
fact(0, 0, wealth_dono(5, 264)).
fact(0, 0, wealth_dono(6, 262)).
fact(0, 0, wealth_dono(7, 274)).
fact(0, 0, location(1, 1, 4)).
fact(0, 0, location(2, 1, 3)).
fact(0, 0, location(3, 4, 2)).
fact(0, 0, location(4, 2, 4)).
fact(0, 0, location(5, 2, 1)).
fact(0, 0, location(6, 4, 4)).
fact(0, 0, location(7, 2, 2)).
fact(0, 0, colour(1, black)).
fact(0, 0, colour(2, white)).
fact(0, 0, colour(3, white)).
fact(0, 0, colour(4, white)).
fact(0, 0, colour(5, black)).
fact(0, 0, colour(6, white)).
fact(0, 0, colour(7, white)).
fact(0, 0, strength(1, 1)).
fact(0, 0, strength(2, 1)).
fact(0, 0, strength(3, 1)).
fact(0, 0, strength(4, 1)).
fact(0, 0, strength(5, 2)).
fact(0, 0, strength(6, 2)).
fact(0, 0, strength(7, 1)).
fact(0, 0, wealth_take(1, 151)).
fact(0, 0, wealth_take(2, 153)).
fact(0, 0, wealth_take(3, 110)).
fact(0, 0, wealth_take(4, 140)).
fact(0, 0, wealth_take(5, 131)).
fact(0, 0, wealth_take(6, 161)).
fact(0, 0, wealth_take(7, 148)).

/* —————————————————–
Die Datei display54
The programs displaying some actions relativ to a given action type.
picture for donothin */

:- dynamic fact/3 .

make_picture(donothin) :-
VV1 = ‚Picture-‚, concat(VV1,donothin,Vd1),
new(@donothin, picture(Vd1)), send(@donothin, open),
asserta(object_list(donothin,[])), height(donothin,H),
send(@donothin, display, new(AXISUP, line(5,5,5,175,first))),
send(@donothin, display, new(AXISRIGHT, line(5,175,350,175,second))),
periods(TT),
make_objects(donothin,TT),
make_other_objects(donothin),
activate_picture(donothin,R,H). /* NM = 1, MOD = donothin, R a run */

make_objects(donothin,TT) :- height(donothin,H),

notrace,
( between(1,TT,A), make_dots(donothin,A,H), fail; true),!.

make_dots(donothin,A,H) :- A1 is 5+5*A,
send(@donothin, display, new(BT, circle(4)), point(A1,50)),
object_list(donothin,OL), append(OL,[BT],OL1), retract(object_list(donothin,OL)),
asserta(object_list(donothin,OL1)),!.

make_other_objects(donothin) :-
send(@donothin, display, new(@W11, text(‚actor‘)), point(20,175)),
send(@W11, flush),
send(@donothin, display, new(@W12, text(’number‘)), point(60,175)),
asserta(obj(donothin,@W12)),
send(@W12, flush),!.

activate_picture(donothin,R,H) :- object_list(donothin,OL),
actors(AS),
( between(1,AS,A), display_run(donothin,A,OL,R,H), sleep(1), fail; true),!.

display_run(donothin,A,OL,R,H) :- update(donothin,A),
periods(TT),
( between(1,TT,T), make_wealth_dono(R,T,A,OL,H), fail
; true
),!.

make_wealth_dono(R,T,A,OL,H) :-
fact(R,T,wealth_dono(A,WA)), magnify_by(MAG), W is MAG*WA, Y1 is H-W,
nth1(T,OL,OT), X1 is 5+5*T,
get(OT, position, point(X,Y)),
send(OT, position, point(X1,Y1)),
send(OT, fill_pattern, colour(red)),
send(OT,flush),!.

% ————————————————————
% schellin

make_picture(schellin) :-
VV2 = ‚Picture-‚, concat(VV2,schellin,Vd2),
new(@schellin, picture(Vd2)), send(@schellin, open),
periods(TT),
make_objects(schellin,TT),!,
make_other_objects(schellin),
choose_run(R),
activate_picture(schellin,R),!.

make_objects(schellin,TT) :- height(schellin,H),

notrace, /* 2 = NM , in para */
gridwidth(G), size_of_boxes(S), GG is G*G,
asserta(object_list(schellin,[])),
( between(1,G,I), make_row(I,G,S), fail; true),!.

make_row(I,G,S) :- ( between(1,G,J), make_column(I,J,S), fail ; true),!.

make_column(I,J,S) :- I1 is (I-1)*S, J1 is (J-1)*S,
send(@schellin, display, new(E, box(S,S)), point(I1,J1)),
object_list(schellin,L), append(L,[E],L1), asserta(object_list(schellin,L1)),
retract(object_list(schellin,L)),!.

make_other_objects(schellin) :-
send(@schellin, display, new(@W21, text(‚period‘)), point(20,162)),
send(@W21, flush),
send(@schellin, display, new(@W22, text(’number‘)), point(60,162)),
asserta(obj(schellin,@W22)),
send(@W22, flush),!.

activate_picture(schellin,R) :-
gridwidth(G),
actors(AS), periods(TT), object_list(schellin,L),
( between(1,TT,T), display_period(schellin,R,T,AS,G,L), sleep(1), fail ; true),
retract(object_list(schellin,L)),!.

display_period(schellin,R,T,AS,G,L) :- G1 is G*G,
update(schellin,T),
( between(1,G1,X), nth1(X,L,OB), send(OB, fill_pattern, colour(white)),
send(OB, flush), fail
; true
),!,
( between(1,AS,A), display(schellin,R,T,G,L,A), fail ; true),!.

display(schellin,R,T,G,L,A) :-
fact(R,T,colour(A,C)),
fact(R,T,location(A,I,J)), N is (I-1)*G+J, nth1(N,L,OB),
( C = black, X = colour(black)
;
C = white, X = colour(blue)
),
send(OB, fill_pattern, X), send(OB, flush),!.

% ——————————————————————————-
% picture for takeweak

make_picture(takeweak) :-
VV3 = ‚Picture-‚, concat(VV3,takeweak,Vd3),
new(@takeweak, picture(Vd3)), send(@takeweak, open),
send(@takeweak, display, new(AXISUP, line(5,5,5,160,first))),
send(@takeweak, display, new(AXISRIGHT, line(5,160,400,160,second))),
asserta(object_list(takeweak,[])), height(takeweak,H),
periods(TT), choose_run(R),
make_objects(takeweak,TT,R),
make_other_objects(takeweak),
activate_picture(takeweak,R).

make_objects(takeweak,TT,R) :-
actors(AS), asserta(oblist(takeweak,[])),
( between(1,AS,B), make_cell(B,R), fail ;true),
send(@takeweak,flush),
oblist(takeweak,L), asserta(oblist(takeweak,L)), !.

make_cell(B,R) :-
J is 140, I is 5 + (B-1)*20, I1 is I + 10,
send(@takeweak, display, new(E, box(10,20)), point(I,J)),

notrace,
send(@takeweak, display, new(F, box(10,20)), point(I1,J)),
send(@takeweak, flush),
oblist(takeweak,L), append(L,[[E,F]],L1),
asserta(oblist(takeweak,L1)),
retract(oblist(takeweak,L)),!.

make_other_objects(takeweak) :-
send(@takeweak, display, new(@W1, text(‚period‘)), point(20,162)),
send(@W1, flush),
send(@takeweak, display, new(@W2, text(’number‘)), point(60,162)),
asserta(obj(takeweak,@W2)),
send(@W2, flush),!.

activate_picture(takeweak,R) :-
choose_run(R), make_maxima(R), /* R the run in para */
periods(TT), actors(AS),
( between(1,TT,T), depict_period(takeweak,T,AS,R), fail ; true),!,
ask_for_end, destroy(Answer),!.

depict_period(takeweak,T,AS,R) :-
update(takeweak,T),
( between(1,AS,A), update(takeweak,T,A,R), fail; true),!,
send(@takeweak,flush), sleep(1),!.

update(MOD,T) :- obj(MOD,O), send(O,string,T), send(O,flush),!.

update(takeweak,T,A,R) :-
oblist(takeweak,OBL1), nth1(A,OBL1,[OA1,OA2]),
fact(R,T,strength(A,SA)), SA1 is 5*SA,
get(OA1, position, point(X,Y)), Y1 is 160 – SA1,
send(OA1, position, point(X,Y1)), send(OA1,height,SA1),
send(OA1, fill_pattern, colour(green)),
send(OA1,flush),
fact(R,T,wealth_take(A,V1)), max_val(MAX),
get(OA2, position, point(X2,Y2)),
( V1 =< 0, V is 0; V is (V1/MAX)*20 ), Y3 is 160-V,
send(OA2, position, point(X2,Y3)),send(OA2,height,V),
send(OA2, fill_pattern, colour(blue)),
send(OA2,flush),!.

make_maxima(R) :-
findall(V,fact(R,T,wealth_take(A,V)),L1), sort(L1,L2),
length(L2,E2), nth1(E2,L2,MAX1), asserta(max_val(MAX1)),!.

ask_for_end :-
new(@d, dialog(‚Display‘)),
send(@d, append, new(TI, text_item(type_End, “))),
send(@d, append, button(ok, message(@d,return,TI?selection))),
get(@d, confirm, Answer),
send(@d, destroy),!.

destroy(Answer) :- send(@takeweak, destroy).

/* ——————————————————–
Die Datei para54
(file of parameters for SMASS)
proper constants ————————— */

runs(2).
periods(5).
actors(7).
gridwidth(4).
exist_min(20).
size_of_boxes(10).

% boolean constants —————————————–
% modes( [takeweak,donothin,schellin ]).

modes([donothin,schellin,takeweak]).
% modes([takeweak]).
use_old_data(no).
variables_in_rule(donothin,[wealth_dono]).
variables_in_rule(schellin,[location,colour]).
variables_in_rule(takeweak,[location,strength,wealth_take]).

weights(donothin,2,[50,101]).
weights(schellin,1,[101]).
weights(takeweak,1,[101]).
type_of_neighbourhood(schellin,moore,1).
type_of_neighbourhood(takeweak,von_Neumann,2).
choose_run(2).

% constants relative to an action type ———————–

domain_of_wealth_dono(50,500). sigma_wealth_dono(20).
height(donothin,175).
magnify_by(0.2).

height(schellin,170).

domain_of_wealth_take(100,200).
sigma_wealth_take(30).
expressions(strength,2).
weights(strength,[70,101]).
domain_of_values(20).
height(takeweak,200).

/* ————————————————
Die Datei pred54
(auxiliary predicates for SMASS) */

:- dynamic fact/3 .

normal_distribution(N,AS,L,U,SI) :- MU is L + (0.5 * (U-L)),
( between(1,AS,A), determine_nd_value(N,MU,SI,L,U,A), fail; true),!.

determine_nd_value(N,MU,SI,L,U,A) :- repeat, X is
random(10001)+1,
X4 is (1/10000) * (((X-1) * U)+(10001-X) * L), W is integer(X4),
PI is pi, X1 is 2*(PI * (SI * SI)), X2 is (1 / sqrt(X1)),
X3 is (-((W-MU)*(W-MU))) / (SI*SI), Y is X2 * exp(X3),
W1 is random(10001)+1, Z is (W1-1)/10000, Z =< Y, between(L,U,W),
asserta(nd_expr(N,A,W)), !.

make_discrete_distribution(N,AS,EX,LIST) :-
( between(1,AS,A), determine_dd_value(N,A,EX,LIST), fail; true ),!.

determine_dd_value(N,A,EX,LIST) :- X is random(100)+1,
between(1,EX,Z), nth1(Z,LIST,W_Z), X < W_Z, assert( dd_expr(N,A,Z)),!.

calculate_sum(L,S) :- asserta(counter(0)), length(L,E),
( between(1,E,X), auxpred(L,X) , fail ; true), counter(S),
retract(counter(S)).

auxpred(L,X) :- nth1(X,L,N), counter(C), C1 is C+N,
retract(counter(C)), asserta(counter(C1)), !.

make_nbh(moore,N,I,J,L) :- gridwidth(G), ( N=1, moore_nbh_1(G,I,J,L)
; 1 < N, moore_nbh_1(G,I,J,L2), asserta(auxlist(I,J,L2)),
length(L2,K), ( between(1,K,X), mnbh(X,L2,N,G,I,J), fail ; true),
auxlist(I,J,L5), delete(L5,[I,J],L6), sort(L6,L),
retractall(auxlist(A,B,L8))
),!.

mnbh(X,L2,N,G,I,J) :- nth1(X,L2,Y), Y=[I1,J1], N1 is N-1,
make_nbh(moore,N1,I1,J1,L3), auxlist(I,J,L4), append(L4,L3,L5),
retract(auxlist(I,J,L4)), asserta(auxlist(I,J,L5)), !.

moore_nbh_1(G,I,J,L) :- recalculate_neg(G,I,1,Im),
recalculate_neg(G,J,1,Jm), recalculate_pos(G,I,1,Ip),
recalculate_pos(G,J,1,Jp),
L = [[I,Jm],[Im,Jm],[Im,J],[Im,Jp],[I,Jp],[Ip,Jp],[Ip,J],[Ip,Jm]].

recalculate_neg(G,I,H,I1) :- X is I-H, ( ( 0 < X, I1 is X
; 0 =:= X, I1 is G ) ; X < 0, I1 is (G+I)- H ),!.

recalculate_pos(G,I,H,I1) :- X is I+H, ( ( I < G, X =< G, I1 is X
; I =:= G, (H > 0, I1 is H; H =:= 0, I1 is G) ) ; I < G, X > G,
I1 is (H+I)-G ),!.

make_nbh(von_Neumann,N,I,J,L) :- gridwidth(G), ( N=1,
von_Neumann_nbh_1(G,I,J,L) ; 1 < N, von_Neumann_nbh_1(G,I,J,L2),
asserta(auxlist(I,J,L2)), length(L2,K),
( between(1,K,X), vNnbh(X,L2,N,G,I,J), fail ; true),
auxlist(I,J,L5),
delete(L5,[I,J],L6),
sort(L6,L),
retractall(auxlist(A,B,L8)) ),!.

vNnbh(X,L2,N,G,I,J) :- nth1(X,L2,Y), Y=[I1,J1], N1 is N-1,
make_nbh(von_Neumann,N1,I1,J1,L3), auxlist(I,J,L4), append(L4,L3,L5),
retract(auxlist(I,J,L4)), asserta(auxlist(I,J,L5)), !.

von_Neumann_nbh_1(G,I,J,L) :- recalculate_neg(G,I,1,Im),
recalculate_neg(G,J,1,Jm), recalculate_pos(G,I,1,Ip),
recalculate_pos(G,J,1,Jp), L = [[I,Jm],[Im,J],[I,Jp],[Ip,J]].

decompose(Y,I,J,G) :- between(1,G,Z), Y =< Z*G, Z1 is Z-1, I is Z,
J is Y-(Z1*G),!.

/* —————————————————-
Die Datei rules54
(the action rules in SMASS)
RULE 1: donothin'. The person intentionally does not do anything.

domain_of_wealths(50,500). sigma_wealths(20). exist_min(20). */

:- dynamic fact/3 .

prepare(R,T,donothin) :- true.

act_in_mode(donothin,A,R,T) :-
feasible(donothin,A,R,T),
chooseaction(donothin,A,R,T),

perform(donothin,A,R,T),!.

feasible(donothin,A,R,T) :-
fact(R,T,wealth_dono(A,W)), exist_min(E),
E1 is 3*E, W1 is W-E1, W1 > 0,!.

chooseaction(donothin,A,R,T) :- true,!.

perform(donothin,A,R,T) :- fact(R,T,wealth_dono(A,W)), W1 is W-5,
retract(fact(R,T,wealth_dono(A,W))),
asserta(fact(R,T,wealth_dono(A,W1))),!.

protocol(donothin,A,R,T) :- fail.

adjust(donothin,A,R,T):- true.
adjust(donothin,R,T) :- true.

% -------------------------------------------------------------------------------

% RULE 2: schellin‘. The person move to a better location, if she likes the
% new ambience. This rule is synchronous because an actor can move only once in a
% period.

prepare(R,T,schellin) :-
asserta(occupied([])), gridwidth(G),
G1 is G*G, findall(X,between(1,G1,X),CL),
actors(AS),
asserta(list222(CL)),
( between(1,AS,A), subtract_cell(A,CL,R,T,G), fail ; true),!,
list222(LFree), retract(list222(LFree)), asserta(free_cells(LFree)),!.

subtract_cell(A,CL,R,T,G) :- fact(R,T,location(A,I,J)),
( member(B,CL), decompose(B,I,J,G), list222(LFree),
subtract(LFree,[B],LFreenew), retract(list222(LFree)), asserta(list222(LFreenew))
;
true
),!.

act_in_mode(schellin,A,R,T) :- feasible(schellin,A,R,T),
chooseaction(schellin,A,R,T), perform(schellin,A,R,T),!.

feasible(schellin,A,R,T) :- true.

chooseaction(schellin,A,R,T) :-

gridwidth(G),
fact(R,T,location(A,I,J)), scan_neighbourhood(A,G,I,J,R,T,ANSWER),
( ANSWER=yes ; calculate_move(A,R,T,G,schellin) ),!.

calculate_move(A,R,T,G,schellin) :-
free_cells(LFree), length(LFree,EFree),
asserta(pot_cells([])),
( between(1,EFree,X), check_cell(X,R,T,A,G,LFree,schellin), fail ;true),!,
pot_cells(LC), length(LC,EE), retract(pot_cells(LC)),
asserta(yes_list([])),
( between(1,EE,NC), nth1(NC,LC,C), enter(C), fail ; true),!,
yes_list(LYES), retract(yes_list(LYES)),
occupied(Locu),
( LYES = [] /* does not */

;
LYES \= [], compare1(LYES,Locu,LL),
( LL = [] /* does not */
;
LL \= [], nth1(1,LL,IntC), nth1(1,IntC,B), nth1(2,IntC,I), nth1(3,IntC,J),
IntCnew = [A,I,J],
append(Locu,[IntCnew],Locunew), retract(occupied(Locu)),
asserta(occupied(Locunew))
)
),!.

compare1(LYES,Locu,LL) :-
length(LYES,EL), asserta(list111([])),
( between(1,EL,Z), compare_cell(Z,LYES,Locu), fail ; true),!,
list111(LL), retract(list111(LL)),!.

compare_cell(Z,LYES,Locu) :- nth1(Z,LYES,C), nth1(1,C,B), nth1(2,C,UU), nth1(1,UU,I), nth1(2,UU,J),
U = [X,I,J],
( member(U,Locu) /* nichts machen */
;
list111(LL), append(LL,[U],LLnew), retract(list111(LL)), asserta(list111(LLnew))
),!.

enter(C) :- yes_list(LYES), nth1(3,C,ANS),
( ANS = yes , append(LYES,[C],LYESnew), retract(yes_list(LYES)),
asserta(yes_list(LYESnew))
;
true
),!.

check_cell(X,R,T,A,G,LFree,schellin) :- nth1(X,LFree,B), decompose(B,I,J,G),
scan_neighbourhood(A,G,I,J,R,T,ANSWER), pot_cells(LL),
append(LL,[[B,[I,J],ANSWER]],LLnew), retract(pot_cells(LL)),
asserta(pot_cells(LLnew)),!.

% —————————————————————–

scan_neighbourhood(A,G,I,J,R,T,ANSWER) :-
type_of_neighbourhood(schellin,TW,TG),
make_nbh(TW,TG,I,J,L),
findall(N,neighb(N,L,R,T),L1), length(L1,E1),
findall(N1, equal_colour(N1,A,L,R,T), L2), length(L2,E2),
(
( ( E1 =< 2, 1 =< E2; 3 =< E1, E1 =< 5, 2 =< E2 )
;
6 =< E1, E1 =< 8, 5 =< E2
), ANSWER=yes
;
ANSWER=no
),!.

neighb(N,L,R,T) :- member([I,J],L), fact(R,T,location(N,I,J)).

equal_colour(N,A,L,R,T) :- member([I,J],L), fact(R,T,location(N,I,J)),
fact(R,T,colour(N,CN)), fact(R,T,colour(A,CA)), CA=CN.

% ———————————————————————

perform(schellin,A,R,T) :- true.
protocol(schellein,A,R,T) :- fail.

adjust(schellin,A,R,T) :-
occupied(LL),
( LL=[]
;
LL \= [] ,
( nth1(X,LL,[A,I,J]),
fact(R,T,location(A,Iold,Jold)),
retract(fact(R,T,location(A,Iold,Jold))),
asserta(fact(R,T,location(A,I,J)))
;
true
)
),!.

adjust(schellin,R,T) :- free_cells(LFree),
retract(free_cells(LFree)),
occupied(LL), retract(occupied(LL)),!.

% ————————————————————–
% RULE 3: `takeweak‘. The person takes wealth from a weaker person. Here we find an asynchronous
% rule of a strange -but realistic- way of cheating.

prepare(R,T,takeweak) :- true.

act_in_mode(takeweak,A,R,T) :-
feasible(takeweak,A,R,T),
chooseaction(takeweak,A,R,T),
perform(takeweak,A,R,T).

feasible(takeweak,A,R,T) :- exist_min(MIN),
domain_of_values(SS),
type_of_neighbourhood(takeweak,TW,GW),
fact(R,T,location(A,IA,JA)),
make_nbh(TW,GW,IA,JA,NHA),!,
length(NHA,E), asserta(neighlist([])),
( between(1,E,Y), locate(Y,R,T,NHA), fail; true),!,
neighlist(NHL), append(results), write(neighlist(A,i,NHL)), write(‚.‘),
nl, told,
length(NHL,E1),
retract(neighlist(NHL)),
fact(R,T,strength(A,SA)),
asserta(n_strength([])),
( between(1,E1,X), investigate(R,T,X,NHL,MIN,SA,SS), fail; true),!,
n_strength(LL), length(LL,E2), retract(n_strength(LL)),
( E2 = 0, fail
;
0 < E2,
sort(LL,LLnew), length(LLnew,E3), nth1(E3,LLnew,WW),
WW = [NB,SB],
asserta(neighb(NB))
),!.

locate(Y,R,T,NHA) :- nth1(Y,NHA,[I,J]), fact(R,T,location(B,I,J)),
neighlist(LL), append(LL,[B],LLnew), retract(neighlist(LL)),
asserta(neighlist(LLnew)),!.

investigate(R,T,X,NHL,MIN,SA,SS) :- n_strength(LL),
( nth1(X,NHL,NB), fact(R,T,strength(NB,SB)),
SB < SA,
fact(R,T,wealth_take(NB,WB)), W1 is WB-(3*SS), !,
MIN =< W1, append(LL,[[NB,SB]],LLnew),
retract(n_strength(LL)), asserta(n_strength(LLnew))
;
true
),!.

chooseaction(takeweak,A,R,T) :- true.

perform(takeweak,A,R,T) :-
neighb(NB), retract(neighb(NB)),
fact(R,T,wealth_take(A,WA)), domain_of_values(SS), S1 is 3*SS,
X is random(S1), WA1 is WA+X, retract(fact(R,T,wealth_take(A,WA))),
asserta(fact(R,T,wealth_take(A,WA1))), T1 is T+1,
asserta(fact(R,T1,give_to_the_strong(NB,X))).

protocol(takeweak,A,R,T) :-
fact(R,T,give_to_the_strong(A,X)),
fact(R,T,wealth_take(A,WA)), exist_min(MIN), W1 is max(WA-X,MIN),
retract(fact(R,T,wealth_take(A,WA))),
asserta(fact(R,T,wealth_take(A,W1))),
retract(fact(R,T,give_to_the_strong(A,X))).

adjust(takeweak,A,R,T) :- true.

adjust(takeweak,R,T) :- true.

/* —————————————————-
Hier ist die Resultatdatei res54 zu sehen: */
fact(1, 1, character(1, [1, 1, 1], 3)).
fact(1, 1, character(2, [2, 1, 1], 4)).
fact(1, 1, character(3, [2, 1, 1], 4)).
fact(1, 1, character(4, [1, 1, 1], 3)).
fact(1, 1, character(5, [2, 1, 1], 4)).
fact(1, 1, character(6, [2, 1, 1], 4)).
fact(1, 1, character(7, [1, 1, 1], 3)).
fact(1, 1, wealth_dono(1, 286)).
fact(1, 1, wealth_dono(2, 285)).
fact(1, 1, wealth_dono(3, 255)).
fact(1, 1, wealth_dono(4, 263)).
fact(1, 1, wealth_dono(5, 264)).
fact(1, 1, wealth_dono(6, 262)).
fact(1, 1, wealth_dono(7, 274)).
fact(1, 1, location(1, 1, 4)).
fact(1, 1, location(2, 1, 3)).
fact(1, 1, location(3, 4, 2)).
fact(1, 1, location(4, 2, 4)).
fact(1, 1, location(5, 2, 1)).
fact(1, 1, location(6, 4, 4)).
fact(1, 1, location(7, 2, 2)).
fact(1, 1, colour(1, black)).
fact(1, 1, colour(2, white)).
fact(1, 1, colour(3, white)).
fact(1, 1, colour(4, white)).
fact(1, 1, colour(5, black)).
fact(1, 1, colour(6, white)).
fact(1, 1, colour(7, white)).
fact(1, 1, strength(1, 1)).
fact(1, 1, strength(2, 1)).
fact(1, 1, strength(3, 1)).
fact(1, 1, strength(4, 1)).
fact(1, 1, strength(5, 2)).
fact(1, 1, strength(6, 2)).
fact(1, 1, strength(7, 1)).
fact(1, 1, wealth_take(1, 151)).
fact(1, 1, wealth_take(2, 153)).
fact(1, 1, wealth_take(3, 110)).
fact(1, 1, wealth_take(4, 140)).
fact(1, 1, wealth_take(5, 131)).
fact(1, 1, wealth_take(6, 161)).
fact(1, 1, wealth_take(7, 148)).

neighlist(2, i, [1, 7, 4, 3, 6]).
neighlist(6, i, [2, 1, 4, 3]).
neighlist(7, i, [2, 5, 4, 3]).
neighlist(4, i, [2, 1, 5, 7, 6]).
neighlist(3, i, [2, 7, 6]).
fact(1, 2, wealth_dono(5, 259)).
fact(1, 2, wealth_dono(1, 281)).
fact(1, 2, wealth_take(6, 208)).
fact(1, 2, wealth_take(7, 148)).
fact(1, 2, wealth_take(5, 131)).
fact(1, 2, wealth_take(4, 140)).
fact(1, 2, wealth_take(3, 110)).
fact(1, 2, wealth_take(2, 153)).
fact(1, 2, wealth_take(1, 151)).
fact(1, 2, strength(7, 1)).
fact(1, 2, strength(6, 2)).
fact(1, 2, strength(5, 2)).
fact(1, 2, strength(4, 1)).
fact(1, 2, strength(3, 1)).
fact(1, 2, strength(2, 1)).
fact(1, 2, strength(1, 1)).
fact(1, 2, colour(7, white)).
fact(1, 2, colour(6, white)).
fact(1, 2, colour(5, black)).
fact(1, 2, colour(4, white)).
fact(1, 2, colour(3, white)).
fact(1, 2, colour(2, white)).
fact(1, 2, colour(1, black)).
fact(1, 2, location(7, 2, 2)).
fact(1, 2, location(6, 4, 4)).
fact(1, 2, location(5, 2, 1)).
fact(1, 2, location(4, 2, 4)).
fact(1, 2, location(3, 4, 2)).
fact(1, 2, location(2, 1, 3)).
fact(1, 2, location(1, 1, 4)).
fact(1, 2, wealth_dono(7, 274)).
fact(1, 2, wealth_dono(6, 262)).
fact(1, 2, wealth_dono(4, 263)).
fact(1, 2, wealth_dono(3, 255)).
fact(1, 2, wealth_dono(2, 285)).
fact(1, 2, character(7, [1, 1, 1], 3)).
fact(1, 2, character(6, [2, 1, 1], 4)).
fact(1, 2, character(5, [2, 1, 1], 4)).
fact(1, 2, character(4, [1, 1, 1], 3)).
fact(1, 2, character(3, [2, 1, 1], 4)).
fact(1, 2, character(2, [2, 1, 1], 4)).
fact(1, 2, character(1, [1, 1, 1], 3)).

neighlist(7, i, [2, 5, 4, 3]).
fact(1, 3, wealth_dono(6, 257)).
fact(1, 3, wealth_dono(2, 280)).
fact(1, 3, wealth_dono(3, 250)).
fact(1, 3, wealth_take(4, 93)).
fact(1, 3, character(1, [1, 1, 1], 3)).
fact(1, 3, character(2, [2, 1, 1], 4)).
fact(1, 3, character(3, [2, 1, 1], 4)).
fact(1, 3, character(4, [1, 1, 1], 3)).
fact(1, 3, character(5, [2, 1, 1], 4)).
fact(1, 3, character(6, [2, 1, 1], 4)).
fact(1, 3, character(7, [1, 1, 1], 3)).
fact(1, 3, wealth_dono(4, 263)).
fact(1, 3, wealth_dono(7, 274)).
fact(1, 3, location(1, 1, 4)).
fact(1, 3, location(2, 1, 3)).
fact(1, 3, location(3, 4, 2)).
fact(1, 3, location(4, 2, 4)).
fact(1, 3, location(5, 2, 1)).
fact(1, 3, location(6, 4, 4)).
fact(1, 3, location(7, 2, 2)).
fact(1, 3, colour(1, black)).
fact(1, 3, colour(2, white)).
fact(1, 3, colour(3, white)).
fact(1, 3, colour(4, white)).
fact(1, 3, colour(5, black)).
fact(1, 3, colour(6, white)).
fact(1, 3, colour(7, white)).
fact(1, 3, strength(1, 1)).
fact(1, 3, strength(2, 1)).
fact(1, 3, strength(3, 1)).
fact(1, 3, strength(4, 1)).
fact(1, 3, strength(5, 2)).
fact(1, 3, strength(6, 2)).
fact(1, 3, strength(7, 1)).
fact(1, 3, wealth_take(1, 151)).
fact(1, 3, wealth_take(2, 153)).
fact(1, 3, wealth_take(3, 110)).
fact(1, 3, wealth_take(5, 131)).
fact(1, 3, wealth_take(7, 148)).
fact(1, 3, wealth_take(6, 208)).
fact(1, 3, wealth_dono(1, 281)).
fact(1, 3, wealth_dono(5, 259)).

neighlist(3, i, [2, 7, 6]).
neighlist(6, i, [2, 1, 4, 3]).
fact(1, 4, wealth_dono(4, 258)).
fact(1, 4, wealth_dono(1, 276)).
fact(1, 4, wealth_take(6, 249)).
fact(1, 4, wealth_dono(5, 254)).
fact(1, 4, wealth_take(7, 148)).
fact(1, 4, wealth_take(5, 131)).
fact(1, 4, wealth_take(3, 110)).
fact(1, 4, wealth_take(2, 153)).
fact(1, 4, wealth_take(1, 151)).
fact(1, 4, strength(7, 1)).
fact(1, 4, strength(6, 2)).
fact(1, 4, strength(5, 2)).
fact(1, 4, strength(4, 1)).
fact(1, 4, strength(3, 1)).
fact(1, 4, strength(2, 1)).
fact(1, 4, strength(1, 1)).
fact(1, 4, colour(7, white)).
fact(1, 4, colour(6, white)).
fact(1, 4, colour(5, black)).
fact(1, 4, colour(4, white)).
fact(1, 4, colour(3, white)).
fact(1, 4, colour(2, white)).
fact(1, 4, colour(1, black)).
fact(1, 4, location(7, 2, 2)).
fact(1, 4, location(6, 4, 4)).
fact(1, 4, location(5, 2, 1)).
fact(1, 4, location(4, 2, 4)).
fact(1, 4, location(3, 4, 2)).
fact(1, 4, location(2, 1, 3)).
fact(1, 4, location(1, 1, 4)).
fact(1, 4, wealth_dono(7, 274)).
fact(1, 4, character(7, [1, 1, 1], 3)).
fact(1, 4, character(6, [2, 1, 1], 4)).
fact(1, 4, character(5, [2, 1, 1], 4)).
fact(1, 4, character(4, [1, 1, 1], 3)).
fact(1, 4, character(3, [2, 1, 1], 4)).
fact(1, 4, character(2, [2, 1, 1], 4)).
fact(1, 4, character(1, [1, 1, 1], 3)).
fact(1, 4, wealth_take(4, 93)).
fact(1, 4, wealth_dono(3, 250)).
fact(1, 4, wealth_dono(2, 280)).
fact(1, 4, wealth_dono(6, 257)).

neighlist(3, i, [2, 7, 6]).
fact(1, 5, wealth_dono(2, 275)).
fact(1, 5, wealth_dono(6, 252)).
fact(1, 5, wealth_take(4, 52)).
fact(1, 5, wealth_dono(3, 250)).
fact(1, 5, character(1, [1, 1, 1], 3)).
fact(1, 5, character(2, [2, 1, 1], 4)).
fact(1, 5, character(3, [2, 1, 1], 4)).
fact(1, 5, character(4, [1, 1, 1], 3)).
fact(1, 5, character(5, [2, 1, 1], 4)).
fact(1, 5, character(6, [2, 1, 1], 4)).
fact(1, 5, character(7, [1, 1, 1], 3)).
fact(1, 5, wealth_dono(7, 274)).
fact(1, 5, location(1, 1, 4)).
fact(1, 5, location(2, 1, 3)).
fact(1, 5, location(3, 4, 2)).
fact(1, 5, location(4, 2, 4)).
fact(1, 5, location(5, 2, 1)).
fact(1, 5, location(6, 4, 4)).
fact(1, 5, location(7, 2, 2)).
fact(1, 5, colour(1, black)).
fact(1, 5, colour(2, white)).
fact(1, 5, colour(3, white)).
fact(1, 5, colour(4, white)).
fact(1, 5, colour(5, black)).
fact(1, 5, colour(6, white)).
fact(1, 5, colour(7, white)).
fact(1, 5, strength(1, 1)).
fact(1, 5, strength(2, 1)).
fact(1, 5, strength(3, 1)).
fact(1, 5, strength(4, 1)).
fact(1, 5, strength(5, 2)).
fact(1, 5, strength(6, 2)).
fact(1, 5, strength(7, 1)).
fact(1, 5, wealth_take(1, 151)).
fact(1, 5, wealth_take(2, 153)).
fact(1, 5, wealth_take(3, 110)).
fact(1, 5, wealth_take(5, 131)).
fact(1, 5, wealth_take(7, 148)).
fact(1, 5, wealth_dono(5, 254)).
fact(1, 5, wealth_take(6, 249)).
fact(1, 5, wealth_dono(1, 276)).
fact(1, 5, wealth_dono(4, 258)).

neighlist(2, i, [1, 7, 4, 3, 6]).
fact(1, 6, wealth_dono(6, 247)).
fact(1, 6, wealth_dono(7, 269)).
fact(1, 6, wealth_dono(3, 245)).
fact(1, 6, wealth_dono(4, 253)).
fact(1, 6, wealth_dono(5, 249)).
fact(1, 6, wealth_dono(1, 276)).
fact(1, 6, wealth_take(6, 249)).
fact(1, 6, wealth_take(7, 148)).
fact(1, 6, wealth_take(5, 131)).
fact(1, 6, wealth_take(3, 110)).
fact(1, 6, wealth_take(2, 153)).
fact(1, 6, wealth_take(1, 151)).
fact(1, 6, strength(7, 1)).
fact(1, 6, strength(6, 2)).
fact(1, 6, strength(5, 2)).
fact(1, 6, strength(4, 1)).
fact(1, 6, strength(3, 1)).
fact(1, 6, strength(2, 1)).
fact(1, 6, strength(1, 1)).
fact(1, 6, colour(7, white)).
fact(1, 6, colour(6, white)).
fact(1, 6, colour(5, black)).
fact(1, 6, colour(4, white)).
fact(1, 6, colour(3, white)).
fact(1, 6, colour(2, white)).
fact(1, 6, colour(1, black)).
fact(1, 6, location(7, 2, 2)).
fact(1, 6, location(6, 4, 4)).
fact(1, 6, location(5, 2, 1)).
fact(1, 6, location(4, 2, 4)).
fact(1, 6, location(3, 4, 2)).
fact(1, 6, location(2, 1, 3)).
fact(1, 6, location(1, 1, 4)).
fact(1, 6, character(7, [1, 1, 1], 3)).
fact(1, 6, character(6, [2, 1, 1], 4)).
fact(1, 6, character(5, [2, 1, 1], 4)).
fact(1, 6, character(4, [1, 1, 1], 3)).
fact(1, 6, character(3, [2, 1, 1], 4)).
fact(1, 6, character(2, [2, 1, 1], 4)).
fact(1, 6, character(1, [1, 1, 1], 3)).
fact(1, 6, wealth_take(4, 52)).
fact(1, 6, wealth_dono(2, 275)).

fact(2, 1, character(1, [1, 1, 1], 3)).
fact(2, 1, character(2, [2, 1, 1], 4)).
fact(2, 1, character(3, [2, 1, 1], 4)).
fact(2, 1, character(4, [1, 1, 1], 3)).
fact(2, 1, character(5, [2, 1, 1], 4)).
fact(2, 1, character(6, [2, 1, 1], 4)).
fact(2, 1, character(7, [1, 1, 1], 3)).
fact(2, 1, wealth_dono(1, 286)).
fact(2, 1, wealth_dono(2, 285)).
fact(2, 1, wealth_dono(3, 255)).
fact(2, 1, wealth_dono(4, 263)).
fact(2, 1, wealth_dono(5, 264)).
fact(2, 1, wealth_dono(6, 262)).
fact(2, 1, wealth_dono(7, 274)).
fact(2, 1, location(1, 1, 4)).
fact(2, 1, location(2, 1, 3)).
fact(2, 1, location(3, 4, 2)).
fact(2, 1, location(4, 2, 4)).
fact(2, 1, location(5, 2, 1)).
fact(2, 1, location(6, 4, 4)).
fact(2, 1, location(7, 2, 2)).
fact(2, 1, colour(1, black)).
fact(2, 1, colour(2, white)).
fact(2, 1, colour(3, white)).
fact(2, 1, colour(4, white)).
fact(2, 1, colour(5, black)).
fact(2, 1, colour(6, white)).
fact(2, 1, colour(7, white)).
fact(2, 1, strength(1, 1)).
fact(2, 1, strength(2, 1)).
fact(2, 1, strength(3, 1)).
fact(2, 1, strength(4, 1)).
fact(2, 1, strength(5, 2)).
fact(2, 1, strength(6, 2)).
fact(2, 1, strength(7, 1)).
fact(2, 1, wealth_take(1, 151)).
fact(2, 1, wealth_take(2, 153)).
fact(2, 1, wealth_take(3, 110)).
fact(2, 1, wealth_take(4, 140)).
fact(2, 1, wealth_take(5, 131)).
fact(2, 1, wealth_take(6, 161)).
fact(2, 1, wealth_take(7, 148)).

neighlist(4, i, [2, 1, 5, 7, 6]).
neighlist(3, i, [2, 7, 6]).
fact(2, 2, wealth_dono(5, 259)).
fact(2, 2, wealth_dono(6, 257)).
fact(2, 2, wealth_dono(1, 281)).
fact(2, 2, wealth_take(7, 148)).
fact(2, 2, wealth_take(6, 161)).
fact(2, 2, wealth_take(5, 131)).
fact(2, 2, wealth_take(4, 140)).
fact(2, 2, wealth_take(3, 110)).
fact(2, 2, wealth_take(2, 153)).
fact(2, 2, wealth_take(1, 151)).
fact(2, 2, strength(7, 1)).
fact(2, 2, strength(6, 2)).
fact(2, 2, strength(5, 2)).
fact(2, 2, strength(4, 1)).
fact(2, 2, strength(3, 1)).
fact(2, 2, strength(2, 1)).
fact(2, 2, strength(1, 1)).
fact(2, 2, colour(7, white)).
fact(2, 2, colour(6, white)).
fact(2, 2, colour(5, black)).
fact(2, 2, colour(4, white)).
fact(2, 2, colour(3, white)).
fact(2, 2, colour(2, white)).
fact(2, 2, colour(1, black)).
fact(2, 2, location(7, 2, 2)).
fact(2, 2, location(6, 4, 4)).
fact(2, 2, location(5, 2, 1)).
fact(2, 2, location(4, 2, 4)).
fact(2, 2, location(3, 4, 2)).
fact(2, 2, location(2, 1, 3)).
fact(2, 2, location(1, 1, 4)).
fact(2, 2, wealth_dono(7, 274)).
fact(2, 2, wealth_dono(4, 263)).
fact(2, 2, wealth_dono(3, 255)).
fact(2, 2, wealth_dono(2, 285)).
fact(2, 2, character(7, [1, 1, 1], 3)).
fact(2, 2, character(6, [2, 1, 1], 4)).
fact(2, 2, character(5, [2, 1, 1], 4)).
fact(2, 2, character(4, [1, 1, 1], 3)).
fact(2, 2, character(3, [2, 1, 1], 4)).
fact(2, 2, character(2, [2, 1, 1], 4)).
fact(2, 2, character(1, [1, 1, 1], 3)).

neighlist(1, i, [2, 5, 4, 6]).
neighlist(5, i, [1, 7, 4]).
neighlist(7, i, [2, 5, 4, 3]).
fact(2, 3, location(4, 1, 2)).
fact(2, 3, wealth_dono(3, 250)).
fact(2, 3, wealth_dono(6, 252)).
fact(2, 3, wealth_dono(2, 280)).
fact(2, 3, wealth_take(5, 153)).
fact(2, 3, character(1, [1, 1, 1], 3)).
fact(2, 3, character(2, [2, 1, 1], 4)).
fact(2, 3, character(3, [2, 1, 1], 4)).
fact(2, 3, character(4, [1, 1, 1], 3)).
fact(2, 3, character(5, [2, 1, 1], 4)).
fact(2, 3, character(6, [2, 1, 1], 4)).
fact(2, 3, character(7, [1, 1, 1], 3)).
fact(2, 3, wealth_dono(4, 263)).
fact(2, 3, wealth_dono(7, 274)).
fact(2, 3, location(1, 1, 4)).
fact(2, 3, location(2, 1, 3)).
fact(2, 3, location(3, 4, 2)).
fact(2, 3, location(5, 2, 1)).
fact(2, 3, location(6, 4, 4)).
fact(2, 3, location(7, 2, 2)).
fact(2, 3, colour(1, black)).
fact(2, 3, colour(2, white)).
fact(2, 3, colour(3, white)).
fact(2, 3, colour(4, white)).
fact(2, 3, colour(5, black)).
fact(2, 3, colour(6, white)).
fact(2, 3, colour(7, white)).
fact(2, 3, strength(1, 1)).
fact(2, 3, strength(2, 1)).
fact(2, 3, strength(3, 1)).
fact(2, 3, strength(4, 1)).
fact(2, 3, strength(5, 2)).
fact(2, 3, strength(6, 2)).
fact(2, 3, strength(7, 1)).
fact(2, 3, wealth_take(1, 151)).
fact(2, 3, wealth_take(2, 153)).
fact(2, 3, wealth_take(3, 110)).
fact(2, 3, wealth_take(4, 140)).
fact(2, 3, wealth_take(6, 161)).
fact(2, 3, wealth_take(7, 148)).
fact(2, 3, wealth_dono(1, 281)).
fact(2, 3, wealth_dono(5, 259)).

neighlist(6, i, [2, 1, 3]).
neighlist(4, i, [2, 1, 5, 7, 3]).
fact(2, 4, location(5, 2, 4)).
fact(2, 4, wealth_take(7, 126)).
fact(2, 4, wealth_dono(3, 245)).
fact(2, 4, wealth_take(6, 208)).
fact(2, 4, wealth_dono(2, 275)).
fact(2, 4, wealth_dono(1, 276)).
fact(2, 4, wealth_dono(5, 259)).
fact(2, 4, wealth_take(4, 140)).
fact(2, 4, wealth_take(3, 110)).
fact(2, 4, wealth_take(2, 153)).
fact(2, 4, wealth_take(1, 151)).
fact(2, 4, strength(7, 1)).
fact(2, 4, strength(6, 2)).
fact(2, 4, strength(5, 2)).
fact(2, 4, strength(4, 1)).
fact(2, 4, strength(3, 1)).
fact(2, 4, strength(2, 1)).
fact(2, 4, strength(1, 1)).
fact(2, 4, colour(7, white)).
fact(2, 4, colour(6, white)).
fact(2, 4, colour(5, black)).
fact(2, 4, colour(4, white)).
fact(2, 4, colour(3, white)).
fact(2, 4, colour(2, white)).
fact(2, 4, colour(1, black)).
fact(2, 4, location(7, 2, 2)).
fact(2, 4, location(6, 4, 4)).
fact(2, 4, location(3, 4, 2)).
fact(2, 4, location(2, 1, 3)).
fact(2, 4, location(1, 1, 4)).
fact(2, 4, wealth_dono(7, 274)).
fact(2, 4, wealth_dono(4, 263)).
fact(2, 4, character(7, [1, 1, 1], 3)).
fact(2, 4, character(6, [2, 1, 1], 4)).
fact(2, 4, character(5, [2, 1, 1], 4)).
fact(2, 4, character(4, [1, 1, 1], 3)).
fact(2, 4, character(3, [2, 1, 1], 4)).
fact(2, 4, character(2, [2, 1, 1], 4)).
fact(2, 4, character(1, [1, 1, 1], 3)).
fact(2, 4, wealth_take(5, 153)).
fact(2, 4, wealth_dono(6, 252)).
fact(2, 4, location(4, 1, 2)).

neighlist(7, i, [4, 2, 5, 3]).
fact(2, 5, wealth_dono(1, 271)).
fact(2, 5, wealth_dono(2, 270)).
fact(2, 5, wealth_take(3, 63)).
fact(2, 5, wealth_dono(4, 258)).
fact(2, 5, location(4, 1, 2)).
fact(2, 5, wealth_dono(6, 252)).
fact(2, 5, wealth_take(5, 153)).
fact(2, 5, character(1, [1, 1, 1], 3)).
fact(2, 5, character(2, [2, 1, 1], 4)).
fact(2, 5, character(3, [2, 1, 1], 4)).
fact(2, 5, character(4, [1, 1, 1], 3)).
fact(2, 5, character(5, [2, 1, 1], 4)).
fact(2, 5, character(6, [2, 1, 1], 4)).
fact(2, 5, character(7, [1, 1, 1], 3)).
fact(2, 5, wealth_dono(7, 274)).
fact(2, 5, location(1, 1, 4)).
fact(2, 5, location(2, 1, 3)).
fact(2, 5, location(3, 4, 2)).
fact(2, 5, location(6, 4, 4)).
fact(2, 5, location(7, 2, 2)).
fact(2, 5, colour(1, black)).
fact(2, 5, colour(2, white)).
fact(2, 5, colour(3, white)).
fact(2, 5, colour(4, white)).
fact(2, 5, colour(5, black)).
fact(2, 5, colour(6, white)).
fact(2, 5, colour(7, white)).
fact(2, 5, strength(1, 1)).
fact(2, 5, strength(2, 1)).
fact(2, 5, strength(3, 1)).
fact(2, 5, strength(4, 1)).
fact(2, 5, strength(5, 2)).
fact(2, 5, strength(6, 2)).
fact(2, 5, strength(7, 1)).
fact(2, 5, wealth_take(1, 151)).
fact(2, 5, wealth_take(2, 153)).
fact(2, 5, wealth_take(4, 140)).
fact(2, 5, wealth_dono(5, 259)).
fact(2, 5, wealth_take(6, 208)).
fact(2, 5, wealth_dono(3, 245)).
fact(2, 5, wealth_take(7, 126)).
fact(2, 5, location(5, 2, 4)).

neighlist(4, i, [2, 1, 7, 3]).
neighlist(5, i, [2, 1, 7, 6]).
fact(2, 6, location(2, 2, 1)).
fact(2, 6, location(1, 2, 3)).
fact(2, 6, wealth_dono(7, 269)).
fact(2, 6, wealth_dono(6, 247)).
fact(2, 6, wealth_take(5, 199)).
fact(2, 6, location(5, 2, 4)).
fact(2, 6, wealth_take(7, 126)).
fact(2, 6, wealth_dono(3, 245)).
fact(2, 6, wealth_take(6, 208)).
fact(2, 6, wealth_dono(5, 259)).
fact(2, 6, wealth_take(4, 140)).
fact(2, 6, wealth_take(2, 153)).
fact(2, 6, wealth_take(1, 151)).
fact(2, 6, strength(7, 1)).
fact(2, 6, strength(6, 2)).
fact(2, 6, strength(5, 2)).
fact(2, 6, strength(4, 1)).
fact(2, 6, strength(3, 1)).
fact(2, 6, strength(2, 1)).
fact(2, 6, strength(1, 1)).
fact(2, 6, colour(7, white)).
fact(2, 6, colour(6, white)).
fact(2, 6, colour(5, black)).
fact(2, 6, colour(4, white)).
fact(2, 6, colour(3, white)).
fact(2, 6, colour(2, white)).
fact(2, 6, colour(1, black)).
fact(2, 6, location(7, 2, 2)).
fact(2, 6, location(6, 4, 4)).
fact(2, 6, location(3, 4, 2)).
fact(2, 6, character(7, [1, 1, 1], 3)).
fact(2, 6, character(6, [2, 1, 1], 4)).
fact(2, 6, character(5, [2, 1, 1], 4)).
fact(2, 6, character(4, [1, 1, 1], 3)).
fact(2, 6, character(3, [2, 1, 1], 4)).
fact(2, 6, character(2, [2, 1, 1], 4)).
fact(2, 6, character(1, [1, 1, 1], 3)).
fact(2, 6, location(4, 1, 2)).
fact(2, 6, wealth_dono(4, 258)).
fact(2, 6, wealth_take(3, 63)).
fact(2, 6, wealth_dono(2, 270)).
fact(2, 6, wealth_dono(1, 271)).