WordList 12b

function board = solver(words, weights, n, penalty)

% Crossword Solver

%{
12b removes adjacency; some could be kept.
results: 6590264.00
time: 0.77

%}



[~,WordLen] = cellfun(@size,words);         % Length of each word
WordPriority = weights ./ (WordLen+1);      % Guess at priority
[WordPriority,Index] = sort(WordPriority,'descend');  % Find words in priority order
WordLen = WordLen(Index);
words = words(Index);                       % ... and sort words to match
weights = weights(Index);
Used = false(size(WordLen));

%{
SpacesToHere = cumsum( WordLen+1 );         % Roughly spaces used
HalfFull = find( SpacesToHere> n*n/2, 1, 'first' );
Full = find( SpacesToHere> n*n, 1, 'first' );
ScoreGain = sum( weights(HalfFull:Full) );
ScoreLoss = penalty * n * 3 ;               % Crude guess at penalty?
if ScoreGain>ScoreLoss
    Step = 1;
else
    Step = 2;
end
%}

board = zeros(n);
Used = false(size(WordLen));
Next = 1;
for Row = 1:1:n     % Tight solution fills every row
    Col = 1;
    while Col < n 
        while Used(Next) Next = Next + 1; end
        if n-Col+1 >= WordLen(Next)             % Check!
            board(Row,Col:Col+WordLen(Next)-1) = words{Next};
            Used(Next) = true;                  % Should not be needed
            Col = Col+WordLen(Next)+1;
            Next = Next+1;
        else
            Try = find( (WordLen<=n-Col+1) & ~Used, 1, 'first' );
            if isempty(Try) 
                Col = n+1;
            else
                board(Row,Col:Col+WordLen(Try)-1) = words{Try};
                Used(Try) = true;
                Col = Col+WordLen(Try)+1;  
            end
        end
    end
end 
Board1 = board;
WordScore1 = sum(weights(Used));


 
SpacesToHere = cumsum( WordLen+1 );         % Spaces used inc terminating space
LastUsed = find( SpacesToHere> n*(n+1) / 2, 1, 'first' )-1;  
    % Loose solution should fit these if no overlapping and perfect rows?    
[WordLen(1:LastUsed),Index] = sort(WordLen(1:LastUsed),'descend'); 
words(1:LastUsed) = words(Index);   
weights(1:LastUsed) = weights(Index);       % Sort them longest first
    % Will not exactly fill rows, or optimise points at which I can add 2s
Twos    = find(WordLen == 2);               % Locations of 2s I can use as fills
NTwos   = size(Twos(:),1);
TwoList = zeros( NTwos, 2 );
for i = 1:NTwos; TwoList(i,:) = words{Twos(i)}; end  % Must be a better way
    % Creates a list of short words to use as fills in loose solution

    
board = zeros(n);   
Used = false(size(WordLen));
Next = 1;
for Row = 1:2:n     % Loose solution fills alternate rows
    Col = 1;
    while Col < n 
        while Used(Next) Next = Next + 1; end
        if n-Col+1 >= WordLen(Next)             
            board(Row,Col:Col+WordLen(Next)-1) = words{Next};
            Used(Next) = true;                  
            if WordLen(Next) == 2
                TwoList(find(Next==Twos,1,'first'),:) = -1;
            end
            Col = Col+WordLen(Next)+1;
            Next = Next+1;
        else
            Try = find( (WordLen<=n-Col+1) & ~Used, 1, 'first' );
            if isempty(Try) 
                Col = n+1;
            else
                board(Row,Col:Col+WordLen(Try)-1) = words{Try};
                Used(Try) = true;
                if WordLen(Try) == 2
                    TwoList(find(Try==Twos,1,'first'),:) = -1;
                end
                Col = Col+WordLen(Try)+1;  
            end
        end
    end
    if Row > 1
        
            % Firstly see if simple adjustments to row create more opportunities
            % Should also try shifting by 1 word
        ScoreRaw = sum(xor( board(Row,:), board(Row-2) ));
        if board(Row,end) == 0 
            ScoreNudge = sum(xor( circshift(board(Row,:),[0,1]), board(Row-2,:) ));
        else
            ScoreNudge = -1;
        end              
        if ScoreNudge > ScoreRaw
            board(Row,:) = circshift(board(Row,:),[0,1]);
        end
        
        Cols = find( (board(Row-2,:) == 0) & (board(Row,:) ~= 0) );
        for Col = Cols
            if (Col == 1) || (board(Row-1,Col-1) == 0)
                Char = board(Row,Col);
                FillRow = find( Char == TwoList(:,2), 1, 'first' );
                if ~isempty(FillRow)
                    board(Row-1,Col) = TwoList(FillRow,1);
                    TwoList(FillRow,:) = -1;            % Don't use again
                    Used( Twos( FillRow ) ) = true;     % ... either way
                end
            end
        end  
        
            % Repeat looking down as well as up
        Cols = find( (board(Row-2,:) ~= 0) & (board(Row,:) == 0) );
        if Row-2 > 1
            Cols( board(Row-3,Cols) ~= 0 ) = [];
        end         % Avoid creating unintended 3 words           
        for Col = Cols
            if ((Col == 1) || (board(Row-1,Col-1) == 0)) && ...
               ((Col == n) || (board(Row-1,Col+1) == 0))  
                Char = board(Row-2,Col);
                FillRow = find( Char == TwoList(:,1), 1, 'first' );
                if ~isempty(FillRow)
                    board(Row-1,Col) = TwoList(FillRow,2);
                    TwoList(FillRow,:) = -1;            % Don't use again
                    Used( Twos( FillRow ) ) = true;     % ... either way
                end
            end
        end        
        
        
        
    end
end 
Board2 = board;
WordScore2 = sum(weights(Used));



BogusCount = 0;
for Col = 1:n
    Letters = 0;
    for Row = 1:n;                      
        if Board1(Row,Col) ~= 0
            Letters = Letters+1;
        else
            if Letters>1
                BogusCount = BogusCount+1;  % Count words at their ending space
            end
            Letters = 0;            
        end
    end
    if Letters>1                            % ... or at end of column
        BogusCount = BogusCount+1;
    end  
end
Penalty1   = penalty * BogusCount;

if WordScore1 - Penalty1 > WordScore2
    board = Board1;
else
    board = Board2;
end
    
      
 
end