You selected dpfirm0.pl

headline:-
   write('% ------------------------------------------- %'),nl,
   write('%   simulating optimal managerial hierarchy   %'),nl,
   write('% ------------------------------------------- %'),nl,
   h0.
h0:-
   write('%  hierarchy0(A,H):- sample of hierarchies by list notation. '),nl,
   write('%  compute_hierarchy(H,V):- compute with hierarchy as list H. '),nl,
   write('%  compute_hierarchy_with_cost(H,V,W):- additionally, wages.'),nl,
   write('%  tree_formation(list,L,items:S,T):- generate tree for the items.'),nl,
   write('%  evaluate_hierarchy(tree:H, INFO,EVAL):- economic analysis. '),nl,
   write('%  test_tree(items(N):ITEMs,L,H,O):- generate and evaluate H.'),nl,
   write('%  test_tree0(items(N):ITEMs,L,H,O):- generated data by above.'),nl,
   write('%  tell_and_solve(Y,(H,A,L,O)):- solver for optimal tree. '),nl,
   write('%  analyze_list(A, Levels, Items):- analyze tree structure. '),nl,
   write('%  subtree(T,(Level,No, Sup, Items),H):- subtree T of H. '),nl,
   write('%  make_processors(A,B):- model translator from list. '),nl,
   write('%  h0:-   this. also, h1, h2, and me.'),nl.
h1:-
   write('%  --- simulating hierarchy in Prat [2] -----'),nl,
   write('%  processor(Level,No,Capacity, Superior):- a building block. '),nl,
   write('%  hierarchy_p(R,W,N):- with revenue, wage, levels. '),nl,
   write('%  profit_function(R,W,P):- of hierarchy(R,W,N). '),nl,
   write('%  state((K,U)):- dynamics of #(unprocessed items). '),nl.
h2:-
   write('%  --- generating binary trees, etc. -----'),nl,
   write('%  tree_formation(M,L,items:S,T):- generate tree for items. '),nl,
   write('%  minimal_tree(M,L,items:S,tree:T):- tree of minimum levels. '),nl,
   write('%  temp_tree(B,L,S,T):- generated tree. '),nl,
   write('%  temp_tree(1,L,S,T):- generated minimal levels tree. '),nl,
   write('%  tell_goal(File,forall,temp_tree(B,L,S,T)):- save all trees. '),nl.
me:-
   write('% file: dpfirm0.pl'),nl,
   write('% created: 21-25 Mar 2003.'),nl,
   write('% modified: 20 Mar 2003.'),nl,
   write('% privious: 28 Dec 2002.(dpfirm1.pl) '),nl,
   write('% previous: 6 Jan 2003.(dpfirm2.pl) '),nl,
   write('% author: Kenryo INDO (Kanto Gakuen University) '),nl,
   write('% url: http://www.us.kanto-gakuen.ac.jp/indo/front.html'),
   nl.
references:-
   write('%  [1] Prat, A. (1997). '),nl,
   write('%  Hierarchies of processors with endogeneous capacity.'),nl,
   write('%  Journal of Economic Theory 77: 214-222.'),nl,
   write('%  [2] Radner, R. (1993). '),nl,
   write('%  The organization of decentralized information processing.'),nl,
   write('%  Eonometrica 61(5): 1109-1146.'),nl,
   nl.

line0('-------------------------------------------------------------').
wl:- line0(L),write(L).

:- headline.

:- dynamic information_item0 /3.
:- dynamic processor0 /4.
:- dynamic hierarchy0 /4.
:- dynamic temp_tree /4.
:- dynamic test_tree0 /4.




%-----------------------------------------
% modeling and optimization of hierarchy
%-----------------------------------------

% example. (Prat(1997),Fig.1, p.217)
%-----------------------------------------

% the input data
information_item(1,-1, to(1,1)).
information_item(2, 2, to(1,1)).
information_item(3,-5, to(1,1)).
information_item(4, 1, to(1,1)).
information_item(5,-6, to(1,2)).
information_item(6, 2, to(1,2)).
information_item(7, 3, to(1,2)).
information_item(8, 1, to(1,3)).

% a non-optimal hierarchy
level(1).
level(2).
processor(level(1), no(1), capacity(4), superior((2,1))).
processor(level(1), no(2), capacity(3), superior((2,1))).
processor(level(1), no(3), capacity(1), superior((2,1))). % skip-level report.
processor(level(2), no(1), capacity(3), superior((3,1))). % top.


% economics of (managerial) hierarchy 
%-----------------------------------------

hierarchy_p(R,W,N):-
   all_information_items(Xs),
   length(Xs,N),
   levels(_Ls,L),
   number_of_levels(L),
   revenue_p(R,L),
   capacities(_Cs,TC),
   wage_function_p(TC,W).

% wage function:
%-----------------------------------
% strictly increasing in the capacity.

wage_function_p(C,C).

% revenue :
%-----------------------------------
% strictly decreasing in the number of levels.

revenue_p(R,L):-
   R is 100* 10^(-L).

% the objective for maximization.
%-----------------------------------
% The optimal hierarchy solves it.

profit_function_p(R,W,P):-
   hierarchy_p(R,W,_N),
   P is R - W.

% state
%-----------------------------------
state((level(K),unprocessed(N=U))):-
   unprocessed_information_items(K,_A,N),
   U is N.


%--------------------------------
%  dynamic equation
%--------------------------------
% the constraints for the maximization problem. 

unprocessed_information_items0(K,_,1):-
   last_level(M),
   K is M + 1.

unprocessed_information_items(M,[],N):-
   first_level(M),
   number_of_information_items(N).

unprocessed_information_items(K,[A|B],N):-
   (
    level(K);(last_level(M), K is M + 1)
   ),
   \+ first_level(K),
   K1 is K - 1,
   unprocessed_information_items(K1,B,N1),
   capacities_of_level(K1,_Cs,TCK),
   processors_at(level(K1),TNK,_),
   Reduced is TCK - TNK,
    nl,
    write(
      (
       'Reduced is TCK - TNK',
        Reduced is TCK - TNK
      )
   ),
   N = N1 - Reduced,
   A is Reduced.


%-----------------------------------------
% basic properties of the herarchy
%-----------------------------------------

levels(Ls,L):-
   findall(X, level(X), Ls),
   length(Ls,L).

number_of_levels(L):-
   levels(_Ls,L).
   
first_level(K):-
   level(K),
   \+ (level(L), L K).

subordinates(K,N,L):-
   processor(level(K),no(N),capacity(_),_),
   findall((K1,X),
     (
      K1 is K - 1, 
      processor(level(K1),no(X),capacity(_),superior((K,N)))
     ), 
  L).

number_of_processors_at(levels(Ls),LN,SN):-
   levels(Ls,_L),
   findall(X,
     (
      member(K,Ls),
      processors_at(level(K),X,_)
     ),
   LN),
   sum(LN,SN).

processors_at(level(K),N,Ps):-
   level(K),
   findall(K, processor(level(K),_J,_C,_), Ps),
   length(Ps,N).

all_information_items(Xs):-
   findall(X,information_item(_,X,_),Xs).

capacities_of_level(K,Cs,TCK):-
   findall(C,
     (
      processor(level(K),_,capacity(C),_S)
     ),
   Cs),
   sum(Cs,TCK).

capacities(Cs,TCK):-
   findall(C,
     (
      processor(_,_,capacity(C),_)
     ),
   Cs),
   sum(Cs,TCK).

% addition. (utility)
%-----------------------------------------
sum([],0).
sum([X|Y],Z):-sum(Y,Z1),Z is Z1 + X.


% pretty print of arities. (utility)
%-----------------------------------------
ppg(G,X):-
   Goal=..[G|X],
   Goal,
   forall(member(Z,X),(nl,tab(2),write(Z))).


%------------------------------------------------
% computation by managerial hierarchy
%------------------------------------------------

compute_by_processor([
      level = 1, 
      no = A,
      capacity = C,
      superior = S,
      subordinates = D,
      inputs = X,
      output =Y
   ]):-
   processor(level(1), no(A), capacity(C), superior(S)),
   findall((input,P,Q),
     (
      information_item(P, Q, to(1,A))
     ),
   INPUT),
   findall(P,member((_,P,_),INPUT),D),
   findall(Q,member((_,_,Q),INPUT),X),
   sum(X,Y).

compute_by_processor([
      level = K, 
      no = A,
      capacity = C,
      superior = S,
      subordinates = D,
      inputs = X,
      output =Y
   ]):-
   processor(level(K), no(A), capacity(C), superior(S)),
   K > 1,
   subordinates(K,A,D),
   findall((K1,P,Q),
     (
      member((K1,P),D),
      compute_by_processor([
        level = K1, 
        no = P, _,
        superior = (K,A), _, _,
        output = Q
      ])
     ),
   INPUT),
   findall(Q,member((_,_,Q),INPUT),X),
   sum(X,Y).

% simpler version
network_sum(0,N,[],Y):- information_item(_,Y,to(1,N)).
network_sum(L,N,X,Y):-
   processor(level(L),no(N),capacity(K),_),
   L > 0,
   length(X,K),
   findall(Y1,
     (
      processor(level(L1),no(N1),capacity(_K1),superior((L,N))),
      sum_by_network(level(L1),no(N1),_,output(Y1))
      %,tab(3),tab(L1),write(sum_by_network(level(L1),no(N1),Y1)),nl
     ),
   X),
   sum(X,Y).



%-----------------------------------------
% generation of possible herarchies
%-----------------------------------------
% tree formations for the input data (i.e., information items)
% by partitioning the set of input items recursively.
% ?- tree_formation(levels:L,items:S,tree:T).

%  generating partitons
%-----------------------------------------
partition([S],1,S):-
   \+ var(S),
   length(S,_).

partition([H|H1],N,S):-
   \+ var(S),
   length(S,_),
   symmetric_complement(H,S1,S),
   \+ member([], [H,S1]),
   partition(H1,N1,S1),
   N is N1 + 1,
   all_elements(S1,_,H1).

all_elements([],0,[]).
all_elements(A,N,[H|S]):-
   \+ var(S),
   length(S,_),
   \+ var(H),
   length(H,K),
   all_elements(B,N1,S),
   append(H,B,A),
   N is N1 + K.


% tree_formation(Mode,levels:L, items:A, tree:T).
%-----------------------------------------
tree_formation(list,levels:1, items:A, tree:A):-
   \+ var(A),
   length(A,_).

tree_formation(list,levels:K,
     items: S,
     tree: [T1|T2]
 ):-
   \+ var(S),
   %symmetric_complement(H1,H2,S),
   partition([H1|H2],_,S),
   \+ member([],[H1,H2]),
   tree_formation(list,levels:K1,
      items: H1,
      tree: T1
   ),
   tree_formation(list,levels:K1,
      items: H2,
      tree: T2
   ),
   K is K1+1.

% skip-reporting
tree_formation(list,levels:K, items:A, tree:[T]):-
   number(K),
   tree_formation(list,levels:K1,
      items: A,
      tree: T
   ),
   K is K1 + 1.


% list - binary
%------------

tree_formation(blist,levels:L, items:A, tree:A):-
   length(A,_),
   (var(L)->L =1; true).

tree_formation(blist,levels:K,
     items: S,
     tree: T
 ):-
   \+ var(S),
   T = [T1,T2],
   symmetric_complement(H1,H2,S),
   \+ member([],[H1,H2]),
   tree_formation(blist,levels:K1,
      items: H1,
      tree: T1
   ),
   tree_formation(blist,levels:K2,
      items: H2,
      tree: T2
   ),
   (K1 >= K2 -> K is K1+1; K is K2+1).



% binary
%------------
% caution:
% the following binary tree formation for items no more than 6 is 
% relatively easy. However, it is much harder to compute for the 
% number of items above it.

tree_formation(binary,levels:0, items:[_], tree:[]).

tree_formation(binary,levels:K,
     items: S,
     tree: [
        [(S->H1)|T1],
        [(S->H2)|T2]
     ]
  ):-
   \+ var(S),
   symmetric_complement(H1,H2,S),
   \+ member([],[H1,H2]),
   tree_formation(binary,levels:K1,
      items: H1,
      tree: T1
   ),
   tree_formation(binary,levels:K2,
      items: H2,
      tree: T2
   ),
   (K1 >= K2 -> K is K1+1; K is K2+1).

% -----------------------------------------------------------
% generate hierarchy with minimum delay (minimum number of levels). 
% -----------------------------------------------------------

tree_formation(minimum_delay,levels:0, items:[_], tree:[]).

tree_formation(minimum_delay,levels:L,items:S,tree:T):-
   T= [
        [(S->H1)|T1],
        [(S->H2)|T2]
   ],
   \+ var(S),
   symmetric_complement(H1,H2,S),
   \+ member([],[H1,H2]),
   minimal_tree(minimum_delay,levels:L1,items:H1,tree:T1),
   minimal_tree(minimum_delay,levels:L2,items:H2,tree:T2),
   (L1 >= L2 -> L is L1+1; L is L2+1).

minimal_tree(M,levels:L,items:S,tree:T):-
   % default mode.
   (var(M)->M=minimum_delay;true),
   gen_trees(M,S),
   % iteratively survived trees.
   forall(
     (
      temp_tree(1,levels:L,items:S,tree:T),
      temp_tree(1,levels:L1,items:S,tree:T1),
      L1 > L
     ),
     update_temp_tree(0,L1,S,T1)
   ),
   temp_tree(1,levels:L,items:S,tree:T).

gen_trees(M,S):-
  %abolish(temp_tree/4),
   member(M,[list,blist,binary,minimum_delay]),
   forall(
     tree_formation(M,levels:L,items:S,tree:T),
     update_temp_tree(1,L,S,T,if_not_exsist)
   ).

update_temp_tree(P,L,S,T):-
   retractall(temp_tree(_,levels:L,items:S,tree:T)),
   assert(temp_tree(P,levels:L,items:S,tree:T)).

update_temp_tree(1,L,S,T,if_not_exsist):-
   clause(temp_tree(_,levels:L,items:S,tree:T),true).

update_temp_tree(1,L,S,T,if_not_exsist):-
   \+ clause(temp_tree(_,levels:L,items:S,tree:T),true),
   update_temp_tree(1,L,S,T).




% reduction for minimal levels tree 
% (cf., Radner's reduction for balanced hierarchy[2]). 
% -----------------------------------------------------------  %
% not yet.




%-----------------------------------------------------
% list representation of hierarchy and its computation
%-----------------------------------------------------

hierarchy(A):-
   hierarchy0(a,A).

hierarchy0(a,
   [
     [-1,2,-5,1],
     [-6,2,3],
     [ +1]
   ]
).

hierarchy0(b,
  [
   [
     [-1,2,-5,1],
     [-6,2,3]
   ],
   [
     [ +1]
   ]
  ]
).

hierarchy0(c,
   [
     [a,b,c,d],
     [e,f,g]
   ],
   [
     [h]
   ]
).



% computation via hierarchy as list
%-----------------------------------------
% i.e., tree allowing any symbolic lists 
% (so, including the skelton of the tree).

compute_hierarchy1(A,[A],[],A=A):-
   number(A).

compute_hierarchy1(A,[A],[],symbol=A):-
   \+ length(A,_),
   \+ number(A).

compute_hierarchy1(A,[],B,0=0):-
   reverse(A,B).

compute_hierarchy1(A,[B|C],Y,V=D):-
   compute_hierarchy1(A,C,[B|Y],V1=E),
   compute_hierarchy1(B,_,[],V2=F),
   (E=0-> D = F; D = E + F),
   (member(symbol,[V1,V2])->V =symbol;
    V is D),
   !.

compute_hierarchy(A,C=D):-
   (var(A)-> hierarchy(A);true),
   compute_hierarchy1(A,A,[],C=D),
   A \= [].

% computation via hierarchy with cost
%-----------------------------------------

compute_hierarchy_with_cost(A,C=D,W):-
   (var(A)-> hierarchy(A);true),
   compute_hierarchy2(A,A,[],C=D,W).

compute_hierarchy2(A,[A],[],A=A,0):-
   number(A).

compute_hierarchy2(A,[A],[],symbol=A,0):-
   \+ length(A,_),
   \+ number(A).

compute_hierarchy2(A,[],B,0=0,W):-
   reverse(A,B),
   (length(B,N)->true;N=1),
   wage_function(N,W).

compute_hierarchy2(A,[B|C],Y,V=D,W):-
   compute_hierarchy2(A,C,[B|Y],V1=E,W0),
   compute_hierarchy2(B,_,[],V2=F,W1),
   (E=0-> D = F; D = E + F),
   (member(symbol,[V1,V2])->V =symbol;
    V is D),
   W is W0 + W1,
   %nl,write(([B|C]:W is C:W0 + B:W1)),
   !.


% utility: depth of tree
%-----------------------------------------

analyze_list([], levels:0, items:[]).
analyze_list(A, levels:0, items:[A]):-
   A\=[],
   (atom(A);number(A)).

analyze_list([B|T], levels:L,  items:H):-
   analyze_list(B, levels:L1, items:H2),
   analyze_list(T, levels:L2, items:H1),
   append(H2,H1,H),
   (L1 + 1 >= L2 -> L is L1 + 1; L is L2),
   !.


% utility: subtrees
%-----------------------------------------

subtree(T,(level:L/L,no:1/1, superior:root, items:H),T):-
   % 1st element of the top layer .
   analyze_list(T, levels:L,items:H).

subtree(S,(level:L/M, no:K/N, superior:(L1,K1),items:H),T):-
   (var(T)->hierarchy(T);true),
   subtree(S1,(level:L1/M,no:K1/_, _,_),T),
   (L1=0->(!,fail);true),
   length(S1,N),
   nth1(K,S1,S),
   analyze_list(S, levels:L,items:H).


%-----------------------------------------
% economics of (managerial) hierarchy 
%-----------------------------------------

evaluate_hierarchy(tree:H,
   (
    '#items':N,
    '#levels':L
   ),
   (
    revenue:R,
    wages:W,
    profit:P
   )
 ):-
   (var(H)->hierarchy(H);true),
   analyze_list(H,levels:L,items:A),
   length(A,N),
   revenue(R,L),
   total_wage_function(H,_,W),
   profit_function(R,W,P).

% profit : the objective for maximization.
%-----------------------------------
profit_function(R,W,P):-
   P is R - W.

% revenue :
%-----------------------------------
% strictly decreasing in the number of levels.

revenue(R,L):-
   R is 100-20*L.

% wage function:
%-----------------------------------
% strictly increasing in the capacity.

wage_function(C,W):-
   W is C.
%   W is 10 * C ^ 1.  % exp:case 1.
%   W is 3 * C ^ 2.   % exp:case 2.
%   W is 3 * C ^ 3.   % exp:case 3.

total_wage_function(H,PCs,W):-
   findall(Cost,
     (
      subtree(B,_M,H),
      length(B,Capacity),
      wage_function(Capacity,Cost)
     ),
   PCs),
   sum(PCs,W).


%-----------------------------------------------
% a solver for the optimal hierarchy
%-----------------------------------------------
tell_and_solve(Y,(T,items:N,L,O)):-
   abolish(test_tree0/4),
   G = test_tree(items(N1):Y,L1,T1,O1),
   W = test_tree0(items(N1):Y,L1,T1,O1),
   forall(G,assert(W)),
   tell_goal('extree.txt',forall,W),
   O=(_,_,profit:P),
   test_tree0(items(N):Y,L,T,O),
   \+ ( 
     test_tree0(items(_):Y,_,_,(_,_,profit:P1)),
     P1 > P
   ).

test_tree(items(N):Y,levels:L,T,O):-
   tree_formation(list,_B,items:Y,T),
   evaluate_hierarchy(T,I,O),
   I =(
    '#items':N,
    '#levels':L
   ).

%-----------------------------------------------
% optimal hierarchy
%-----------------------------------------------

% a naive solver.
optimal_hierarchy_0(tree:H, ATTR, OBJ):-
   ATTR= (
     '#items':_N,
     '#levels':L   % to be analyzed and to equal.
   ), 
   OBJ=  (_R,_W,profit:P),
   all_information_items(A),
   tree_formation(list,levels:L, items:A, tree:H),
   evaluate_hierarchy(tree:H, ATTR, OBJ),
   \+ (
     tree_formation(list,L1, items:A, tree:H1),
     evaluate_hierarchy(tree:H1,L1,(_,_,profit:P1)),
     P1 > P
   ).

/*
% sample execution of the naive solver.

?- optimal_hierarchy(T,A,O).

T = tree:[-1, 2, -5, 1, -6, 2, 3, 1]
A = '#items':8, '#levels':1
O = revenue:18.9, wages:8, profit:10.9 ;
*/


% another solver.

optimal_hierarchy(tree:H, ATTR, OBJ):-
   ATTR= (
     '#items':_N,
     '#levels':L   % to be analyzed and to equal.
   ), 
   OBJ=  (_R,_W,profit:P),
   all_information_items(A),
   update_temp_tree(0,_,_,dummy),
   tree_formation(list,levels:L, items:A, tree:H),
   \+ temp_tree(0,L,items:A,tree:H),
   evaluate_hierarchy(tree:H, ATTR, OBJ),
   update_temp_tree(1,L,items:A,tree:H),
   nl,write(update_tree(1,tree:H,ATTR,OBJ)),
   \+ (
     tree_formation(list,L1, items:A, tree:H1),
     \+ temp_tree(0,L1,items:A,tree:H1),
     evaluate_hierarchy(tree:H1,L1,(_,_,profit:P1)),
     nl,write(competitive_tree(tree:H1,L1,profit:P1)),
     (
      P1 > P
       ->
        (
         update_temp_tree(0,L,items:A,tree:H),
         update_temp_tree(1,L1,items:A,tree:H1)
        )
       ;
        (
         update_temp_tree(0,L1,items:A,tree:H1)
        )
     )
   ).


% another one.
optimal_hierarchy_1(tree:H, ATTR, OBJ):-
   ATTR= (
     '#items':_N,
     '#levels':_L   % to be analyzed and to equal.
   ), 
   OBJ=  (_R,_W,profit:_P),
   all_information_items(A),
   solver_for_tree_1(max_profit,ATTR,OBJ,items:A, tree:H).


% a little solver for hierarchy
%-----------------------------------------------
solver_for_tree_1(max_profit,ATTR,OBJ,items:A, tree:H):-
   nl,write(' ----- generating trees.------- '),nl,
   nl,write(' go ahead ? (y)'), read(y),nl,
   ATTR= ('#items':_N, '#levels':L), 
   OBJ=  (_R,_W,profit:P),
   gen_trees(list,A),
   nl,write(' ----- end of generation.------- '),nl,
   nl,write(' find a solution ? (y)'), read(y),nl,
   select_max(levels:L, items:A, tree:H, profit:P).


select_max(levels:L, items:A, tree:H, profit:P):-
   ATTR= ('#items':_N, '#levels':L), 
   OBJ=  (_R,_W,profit:P),
   temp_tree(1,levels:L, items:A, tree:H),
   evaluate_hierarchy(tree:H, ATTR, OBJ),
   \+ (
     temp_tree(1,levels:L1, items:A, tree:H1),
     evaluate_hierarchy(tree:H1,_,(_,_,profit:P1)),
     (
      P1 > P
       ->
        update_temp_tree(0,L,items:A,tree:H)
       ;
        update_temp_tree(0,L1,items:A,tree:H1)
     )
   ).


/*
% sample excecution.

% case 1: 
%    revenue(R,L):- R is 100-20*L.
%    wage_function(C,W):-  W is 10 * C.
%----------------------------------------------------------
?- tell_and_solve([a,b,c,d,e],P).

P = tree:[a, b, c, d, e], items:5, levels:1, revenue:80, wages:50, profit:30 ;
Yes

% case 2: 
%    revenue(R,L):- R is 100-20*L.
%    wage_function(C,W):-  W is 3 * C ^ 2.
%----------------------------------------------------------
?- tell_and_solve([a,b,c,d,e],P).

P = tree:[[a, b, c], [d, e]], items:5, levels:2, revenue:60, wages:51, profit:9 ;

P = tree:[[a, b, d], [c, e]], items:5, levels:2, revenue:60, wages:51, profit:9 ;

P = tree:[[a, b, e], [c, d]], items:5, levels:2, revenue:60, wages:51, profit:9 ;

P = tree:[[a, b], [c, d, e]], items:5, levels:2, revenue:60, wages:51, profit:9 ;

P = tree:[[a, c, d], [b, e]], items:5, levels:2, revenue:60, wages:51, profit:9 ;

P = tree:[[a, c, e], [b, d]], items:5, levels:2, revenue:60, wages:51, profit:9 ;

------------

% case 3:
%    revenue(R,L):- R is 100-20*L.
%    wage_function(C,W):-  W is 3 * C ^ 3.
%----------------------------------------------------------
?- tell_and_solve([a,b,c,d,e],P).

P = tree:[[[a, b], [c, d]], [[e]]], items:5, levels:3, revenue:40, wages:102, profit: -62 ;

P = tree:[[[a, c], [b, d]], [[e]]], items:5, levels:3, revenue:40, wages:102, profit: -62 ;

P = tree:[[[a, d], [b, c]], [[e]]], items:5, levels:3, revenue:40, wages:102, profit: -62 ;

P = tree:[[[a, b], [c, e]], [[d]]], items:5, levels:3, revenue:40, wages:102, profit: -62 ;

P = tree:[[[a, c], [b, e]], [[d]]], items:5, levels:3, revenue:40, wages:102, profit: -62 ;

------------

*/

%-----------------------------------------------
% model translator : from list into processors
%-----------------------------------------------
% hierarchy0 --> information_item/3, processor /4.

base_no_of_subtree(information_item0,K):-
   information_item0(K,_, to(1,_)),
   \+ (
     information_item0(K1,_, to(1,_)),
     K1 > K
   ).

base_no_of_subtree(processor0(K),P):-
   processor0(level(K),no(P),_, superior(_)),
   \+ (
     processor0(
       level(K),no(P1),_, superior(_)
     ),
     P1 > P
   ).

make_hierarchy(level:0/L,items:P):-
   abolish(information_item0/3),
   Dummy=information_item0(0,0, to(1,0)),
   assert(Dummy),
   (var(H)->hierarchy(H);true),
   analyze_list(H,levels:L,items:_),
   M= (levels:0/L, no:_, superior:(1,S1),items:[A]),
   findall(A,
     (
      subtree(A,M,H),
      base_no_of_subtree(information_item0,K0),
      K1 is K0 + 1,
      Target=information_item0(K1,A, to(1,S1)),
      nl,write(Target),
      assert(Target)
     ),
   P),
   retractall(Dummy).

make_hierarchy(level:K/L,items:P):-
   Clear=processor0(level(K),_,_, superior(_)),
   Dummy=processor0(level(K),no(0),0, superior(0)),
   retractall(Clear),
   assert(Dummy),
   (var(H)->hierarchy(H);true),
   analyze_list(H,levels:L,items:_),
   M= (levels:K/L, no:_, superior:(K1,S1),items:_),
   findall(A,
     (
      subtree(A,M,H),
      length(A,C),
      base_no_of_subtree(processor0(K),P0),
      P1 is P0 + 1,
      Target = processor0(
        level(K),no(P1),capacity(C), superior((K1,S1))
      ),
      nl,write(Target),
      assert(Target)
     ),
   P),
   retractall(Dummy).

make_hierarchy(A,B):-
   hierarchy0(A,H),
   analyze_list(H,levels:L,items:B),
   length(O,L),
   % it does not include information items.
   forall(
     nth1(K,O,_),
     make_hierarchy(level:K/L,items:_P)
   ).


%-----------------------------------------
% utilities : operations for list 
%-----------------------------------------

% a sequence of binary choice for a list:
%--------------------------------------------------
list_projection([],[],[]).
list_projection([X|Y],[_|B],C):-
   list_projection(Y,B,C),
   X = 0.
list_projection([X|Y],[A|B],[A|C]):-
   list_projection(Y,B,C),
   X = 1.

% complementary list projection
%--------------------------------------------------
c_list_projection([],[],[]).
c_list_projection([X|Y],[_|B],C):-
   c_list_projection(Y,B,C),
   X = 1.
c_list_projection([X|Y],[A|B],[A|C]):-
   c_list_projection(Y,B,C),
   X = 0.

% subset_of/3 : subset-enumeration 
% -----------------------------------------------------------  %
subset_of(A,N,As):-
   length(As,L),
   length(D,L),
   list_projection(D,As,B),
   length(B,N),
   sort(B,A).

% complement and symmetric complement
% -----------------------------------------------------------  %
complement(AC,A,As):-
   subset_of(A,_N,As),
   subtract(As,A,AC).

complement_1(AC,A,As):-
   list_projection(P,As,A),
   c_list_projection(P,As,AC).

symmetric_complement(AC,A,As):-
   list_projection(P,As,A),
   c_list_projection(P,As,AC),
   list_projection(P1,As,AC),
   P @< P1.


%--------------------------------
% utility for saving goals to file
%--------------------------------
tell_goal(File,G):-
   (current_stream(File,write,S0)->close(S0);true),
   open(File,write,S),
   tell(File),
   nl,
   tstamp('% file output start time ',_),
   nl,
   write('%----------  start from here ------------%'),
   nl,
   G,
   nl,
   write('%----------  end of data ------------%'),
   nl,
   tstamp('% file output end time ',_),
   tell(user),
   close(S),
   % The following is to cope with the duplicated stream problem.
   (current_stream(File,write,S1)->close(S1);true).

tell_goal(File,forall,G):-
   G0 = (nl,write(G),write('.')),
   G1 = forall(G,G0),
   tell_goal(File,G1).


% time stamp
%--------------------------------
tstamp(no,T):-
   get_time(U),
   convert_time(U,A,B,C,D,E,F,_G),
   T = [date(A/B/C), time(D:E:F)],
   nl.

tstamp(Word,T):-
   \+ var(Word),
   Word \= no,
   get_time(U),
   convert_time(U,A,B,C,D,E,F,_G),
   T = [date(A/B/C), time(D:E:F)],
%   format('~`.t~t~a~30|~`.t~t~70|~n',[Word]),
   write((Word,T)),
   nl.



% end.


return to front page.