function Moves = solver(A,nMoves)
% Office PC: 6: 104939 / 80.8, 10: 102227 / 129.2
% Home PC: 6: 104027 / 79.8 (new const)
NCandidates = 8; % Number of candidates to consider
SizeWgtC = .12; % Weights used to generate candidates.
ValWgtC = 3.25; % Currently just a guess.
WidthWgtC = 3.5;
DepthWgtC = 0.5;
Top1VWgt = 1.36; % Weights applied to the resulting regions
Nex3VWgt = 1.75; % when candidates are played. Top 3
Nex5VWgt = 0.6; % apply to mean values 1, 2-4, 5-10.
HeightWgt = .18; % Bot 3 apply to sum down all regions
SizeWgt = .05; % so much smaller...
AllVWgt = .135; % These values guess.
FutureW = 1.4; % Overall weight on the future.
VWgt = 3.1; % Weights for properties of the play itself
SWgt = .5; %
WWgt = 5; % Prob prefer to get wide plays made?
PlayW = 1; % Overall weight on the play itself
I = [-1 0 1 0 ];
J = [ 0 1 0 -1 ]; % Dir => row,col
Group = [0,2,3,4];
% Group created (index 1-4) or destroyed (index 0-3) in swap logic
Moves = []; % Not sure if clear strictly needed
Trial = zeros( [size(A), NCandidates] );
MeritWgt = mean ( A(:) ); % Average colour
N = false(size(A)); % Initialise as logical (?)
MaxVal = max(A(:));
[Height, Width] = size(A);
RPropSize = numel(A); % Must be able to trim!
FreeReg = RPropSize:-1:1; % Row vector of unused regions
RProp = zeros ( RPropSize, 10 );
R = zeros ( size(A) );
TrialR = zeros ( Height, Width, NCandidates );
TrialRProp = zeros ( RPropSize, 10, NCandidates );
TrialFreeReg = cell ( NCandidates, 1 );
for i=1:NCandidates TrialFreeReg{i}=zeros(1,RPropSize); end
RValid = false; % Recalculate R, RProp on first entry
for MoveNo = 1:nMoves
if ~RValid
[ R, RProp, FreeReg ] = FindRegions ( A, R, RProp, FreeReg );
end % RValid means R and RProp were calculated during lookahead
RValid = false; % Default is to recalculate R next time
RList = sortrows( RProp( RProp(:,2)>1, : ), -4 );
% Drop singletons and sort on value.
if MoveNo == nMoves
if ~isempty(RList) && RList(1,1)>0
Moves = [Moves; [RList(1,5), RList(1,6), 0] ];
break; % Last turn just pop most valuable.
end
end
Candidates = FindCandidates;
ToTry = size(Candidates,1);
BestMerit = -inf;
BestPick = -1;
for Pick = 1:ToTry
[ Trial(:,:,Pick), TrialR(:,:,Pick), TrialRProp(:,:,Pick), TrialFreeReg{Pick} ] = DoPop ( A, R, RProp, RProp(Candidates(Pick),5), RProp(Candidates(Pick),6), FreeReg );
[ TrialR(:,:,Pick), TrialRProp(:,:,Pick), TrialFreeReg{Pick} ] = FindRegions ( Trial(:,:,Pick), TrialR(:,:,Pick), TrialRProp(:,:,Pick), TrialFreeReg{Pick} );
Merit = GetMerit ( TrialRProp(:,:,Pick), Candidates(Pick) );
if Merit > BestMerit
BestMerit = Merit;
BestPick = Pick;
end
end
if ~isempty( Candidates )
Moves = [Moves; [RProp(Candidates(BestPick),5), RProp(Candidates(BestPick),6), 0] ];
A = Trial(:,:,BestPick);
R = TrialR(:,:,BestPick);
RProp = TrialRProp(:,:,BestPick);
FreeReg = TrialFreeReg{BestPick};
RValid = true;
else
break % Should do a swap but for now just give up!
end
end % for moves
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [A, R, RProp, FreeReg] = DoPop ( A, R, RProp, Row, Col, FreeReg )
% Pops the indicated cell and returns new array
% Marks dirty regions...
N(:) = false;
findNeighbors(Row,Col,A(Row,Col));
if sum(N(:))>1
anyN = any(N,1); % Without ,1 fails for single-row boards.
% D = N;
% for i = Height-1:-1:1
% D(i,:)=D(i,:) | D(i+1,:);
% end
D = false( Height, Width );
for j = 1:Width
if anyN(j)
D( 1:find(N(:,j), 1, 'last'), j) = true;
end
end
% These are cells that move. However, direction of
% crystalisation means I also have to dirty down and right
% to ensure new regions adopt all possible members.
D(2:end,:) = D(2:end,:) | D(1:end-1,:);
D(:,2:end) = D(:,2:end) | D(:,1:end-1);
DirtyRList = unique(sort(R(D))); % List of dirtied regions
if DirtyRList(1) == 0 DirtyRList(1) = []; end
% Picks up empty cells as a region, so drop
FreeReg = [ FreeReg, DirtyRList' ]; % Note they are free
RProp(DirtyRList,:) = 0; % Drop their properties
D(:) = ismembc( R, DirtyRList ); % Find them in R
R = R .* ~D; % and drop
% Should now have cleared all dirty R and RProp
% Not efficient -- if I'm going to use a rectangular hull I
% should work with it directly rather than do all this
% logic on the precise shape and then drop detail.
for j = 1:Width
if anyN(j)
tmp = A(~N(:,j),j);
A(:,j) = 0;
A(end-sum(~N(:,j))+1:end,j) = tmp;
end
end
else
% warning('Tried to pop single block in DoPop.')
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Merit = GetMerit( RP, Play )
MeritF = 0;
if isempty ( RP )
% warning('Passed empty RP into Merit.')
else
RL = sortrows( RP( RP(:,2)>1, : ), -4 );
if isempty ( RL )
% warning('RP was singletons only in Merit.')
else
RL = RL ( 1:min(size(RL,1),nMoves-MoveNo), : );
if size(RL,1) > 0
MeritF = MeritF + RL(1,4)*Top1VWgt;
end
if size(RL,1) > 3
MeritF = MeritF + mean(RL(2:4,4))*Nex3VWgt;
end
if size(RL,1) > 9
MeritF = MeritF + mean(RL(5:10,4))*Nex5VWgt;
end
if size(RL,1) > 0
MeritF = MeritF + sum( RL(:,9) - RL(:,7) ) * HeightWgt;
MeritF = MeritF + sum( RL(:,2) ) * SizeWgt;
MeritF = MeritF + sum( RL(:,4) ) * AllVWgt;
end
end
end
PlayRP = RProp( Play, : );
MeritC = PlayRP(4)*VWgt + PlayRP(2)*SWgt + (PlayRP(10)-PlayRP(8))*WWgt;
Merit = MeritC * PlayW + MeritF * FutureW;
end % GetMerit
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [ R, RProp, FreeReg ] = FindRegions ( A, R, RProp, FreeReg )
% Crystalise regions from top left.
% Originally used globals A, R, RProp.
% However, for lookahead need to keep separate...
% Revised test order for another 10% gain
% RProp = zeros( RPropSize, 10 ); % Not with clear/dirty logic!
% R = zeros( size(A) );
ToDo = A & ~R; % Contains blocks that need new regions
DoTopRow = any( ToDo(1,:) );
DoLeftCol = any( ToDo(:,1) );
if DoTopRow
i = 1;
for j = 1:Width
if ToDo(i,j)
if j > 1 && A(i,j) == A(i,j-1)
R(i,j) = R(i,j-1);
RProp( R(i,j), 2 ) = RProp( R(i,j), 2 ) + 1;
RProp( R(i,j), 10 ) = max( RProp( R(i,j),10 ), j );
else
NextReg = FreeReg(end);
FreeReg(end) = [];
R(i,j) = NextReg;
RProp(NextReg,1) = R(i,j);
RProp(NextReg,2) = 1;
RProp(NextReg,3) = A(i,j);
RProp(NextReg,4) = 0;
RProp(NextReg,5) = i;
RProp(NextReg,6) = j;
RProp(NextReg,7) = i;
RProp(NextReg,8) = j;
RProp(NextReg,9) = i;
RProp(NextReg,10) = j;
NextReg = NextReg + 1;
end
end
end
end
if DoLeftCol
j = 1;
for i = 2:Height
if ToDo(i,j)
if A(i,j) == A(i-1,j)
R(i,j) = R(i-1,j);
RProp( R(i,j), 2 ) = RProp( R(i,j), 2 ) + 1;
RProp( R(i,j), 9 ) = max( RProp( R(i,j), 9 ), i );
else
NextReg = FreeReg(end);
FreeReg(end) = [];
R(i,j) = NextReg;
RProp(NextReg,1) = NextReg;
RProp(NextReg,2) = 1;
RProp(NextReg,3) = A(i,j);
RProp(NextReg,4) = 0;
RProp(NextReg,5) = i;
RProp(NextReg,6) = j;
RProp(NextReg,7) = i;
RProp(NextReg,8) = j;
RProp(NextReg,9) = i;
RProp(NextReg,10) = j;
NextReg = NextReg + 1;
end
end
end
end
ToDo( 1, : ) = 0;
ToDo( :, 1 ) = 0; % Don't do them again
for k = find(ToDo)' % Find remaining blocks.
% [i, j] = ind2sub( [Height, Width], k );
% function appears grossly inefficient???
i = mod( k-1, Height ) + 1;
j = round(1 + (k-i)/Height);
if A(k) == A(k-1) % Could join col
if A(k) == A(k-Height) % Could also join row
if R(k-1) == R(k-Height) % ... which is in same region
R(k) = R(k-Height);
RProp( R(k), 2 ) = RProp( R(k), 2 ) + 1;
else % Want to join 2 regions so recolour one
OldReg = R(k-1);
NewReg = R(k-Height);
RProp( NewReg, 2 ) = RProp( NewReg, 2 ) + RProp( OldReg, 2 ) + 1;
RProp( NewReg, 7:8 ) = min( RProp( NewReg, 7:8 ), RProp( OldReg, 7:8 ));
RProp( NewReg, 9:10 ) = max( RProp( NewReg, 9:10 ), RProp( OldReg, 9:10 ));
RProp( OldReg, : ) = 0;
R( R==R(k-1) ) = R(k-Height);
R(k) = R(k-Height);
FreeReg = [ FreeReg, OldReg ];
end
else % Just join col
R(k) = R(k-1);
RProp( R(k), 2 ) = RProp( R(k), 2 ) + 1;
RProp( R(k), 9 ) = max( RProp( R(k), 9 ), i );
end
continue
end
if A(k) == A(k-Height) % Join row
R(k) = R(k-Height);
RProp( R(k), 2 ) = RProp( R(k), 2 ) + 1;
RProp( R(k), 10 ) = max( RProp( R(k),10 ), j );
continue
end
NextReg = FreeReg(end);
FreeReg(end) = [];
R(k) = NextReg;
% RProp(NextReg,:) = [ NextReg, 1, A(k), 0, i, j, i, j, i, j ];
% Unwrapping is a 10% overall speedup!
RProp(NextReg,1) = NextReg;
RProp(NextReg,2) = 1;
RProp(NextReg,3) = A(k);
RProp(NextReg,4) = 0;
RProp(NextReg,5) = i;
RProp(NextReg,6) = j;
RProp(NextReg,7) = i;
RProp(NextReg,8) = j;
RProp(NextReg,9) = i;
RProp(NextReg,10) = j;
NextReg = NextReg + 1;
% Or start a new one.
% Col 1 used when sorted into RList
% Items are [ID, size, colour, value, a memberij,
% topleftij, botrightij]
end
RProp ( :, 4 ) = RProp ( :, 2 ) .* RProp ( :, 3 );
end % findRegions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function findNeighbors(i,j,c)
if ~N(i,j);
N(i,j) = true;
if i>1 && A(i-1,j)==c; findNeighbors(i-1,j,c); end
if j<Width && A(i,j+1)==c; findNeighbors(i,j+1,c); end
if i<Height && A(i+1,j)==c; findNeighbors(i+1,j,c); end
if j>1 && A(i,j-1)==c; findNeighbors(i,j-1,c); end
end
end % end of findNeighbors (nested function)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Adj = GetAdj(i,j)
% N=1, E=2, S=3, W=4
if i==1 Adj(1) = -1; else Adj(1) = A(i-1,j); end
if j==Width Adj(2) = -1; else Adj(2) = A(i,j+1); end
if i==Height Adj(3) = -1; else Adj(3) = A(i+1,j); end
if j==1 Adj(4) = -1; else Adj(4) = A(i,j-1); end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Candidates = FindCandidates;
% Return as list of candidate regions
Candidates = RList;
if ~isempty ( Candidates )
Candidates( :, 9) = Candidates * [ 0; SizeWgtC; 0; ValWgtC; 0; 0; DepthWgtC; -WidthWgtC; 0; WidthWgtC ];
% Redefine col 9 to be merit.
Candidates = sortrows( Candidates, -9 );
end
Candidates = Candidates( 1:min(NCandidates,size(Candidates,1)), 1 );
end
end % solver
|
