# restart; read `\G:/My Drive/Aek/Tak/Tak.txt`;

# First version February 27, 2024

# The program to find a penult position 
# of Tak on an n-by-n board.

# Procedures:
# 1. Create winning lines 
# 2. Generate Boards
# 3. For Penult
# 3.1 Each line - Board >=2
# 3.2 If Each line - Board =2 then mark the space
# 3.3 Board+ union marks = whole then it is Penult

with(combinat):


######################################
# Section 1: Penults on n-by-n board,
#
# Lines(n), HorLines(P,n), 
# Next1(t,shortP), VerLines(P,n), 
# 
# Penult(Bo,last,t,n), TestPenult(Bo,n),
#
# Choose2(Sq,r,n), Board2(N,v,r),
# Pass(Bo,n), MakeBo(B,n),
#
######################################

# 1. Create winning lines
# Input: integer n
# Output: set of all the winning lines
# on n-by-n board
# Try:
# Lines(6);
Lines := proc(n) option remember;
local i,a,A;

A:={};
for i from 1 to n do
	A := A union HorLines([[i,1]],n);
	A := A union VerLines([[i,1]],n);
od:	
{seq( {op(a)}, a in A)};
end:

# Horizontal Lines
# Input: board P and integer n
# Output: All the horizontal winning 
# lines of an n-by-n board starting 
# from board P 
# Try: HorLines([[1,1]],4);
HorLines := proc(P,n) option remember;
local i,s,cur,t,T,S;

s := nops(P);
cur := P[s];

if cur[2] = n then
	return({P});
fi:	

S := {};
T := {cur+[1,0],cur+[-1,0],cur+[0,1],cur+[0,-1]};

for t in T do
	if t[1]>=1 and t[1]<=n and
	t[2] > 1 and  Next1(t,[op(1..s-1,P)]) <> true then
		S := S union HorLines([op(P),t],n);	
	fi:	
od:

S;
end:

# The next move
Next1 := proc(t,shortP) option remember;
local s;

for s in shortP do
	if member(t-s,{[1,0],[-1,0],[0,1],[0,-1]}) then
		return(true);
	fi:
od:

return(false);	
end:

# Vertical Line
# Input: board P and integer n
# Output: All the vertical winning 
# lines of an n-by-n board starting 
# from board P
# Try: VerLines([[1,1]],4);
VerLines := proc(P,n) option remember;
local t,T;

{seq([seq( [t[2],t[1]] ,t in T)], T in HorLines(P,n))};
end:


######################################################
# Main procedure
# Input: current board, integer t and n
# Output: board of size n where board with 
# t tokens starts with Bo that is a penult.
# Try: 
# Penult([1,3,5],5,8,4);
# Penult([],0,8,4);
# Penult([1,2],2,10,5);

# Run Done= 500-1600,2000-2400,3000-3400,4000-5002
# A:=Choose2(18,8,6): nops(A);
# seq(print(n,A[n],Penult(A[n],18,15,6)),n=1512..1600);
Penult := proc(Bo,last,t,n) option remember;
local B2,MyB,count;

count :=0;
for B2 in Board2(n^2,last,t-nops(Bo),n) do
	MyB := MakeBo(Bo,n) union MakeBo(B2,n);
	if TestPenult(MyB,n) then
		print(MyB);
		count := count+1
	fi:
od:

return("done", count);
end:

# Test whether the given board is
# already a penult position.
# Input: Board Bo and integer n
# Output: true if board Bo of size
# n-by-n is a penult position
# and return false otherwise.
# Try: TestPenult({[1,1],[1,4],[2,2]
# ,[2,3],[3,2],[3,3],[4,1],[4,4]},4);
TestPenult := proc(Bo,n) 
local L,A,M;

M := {};
for L in Lines(n) do
	A := L minus Bo;
	if nops(A) < 2 then
		return(false);
	elif nops(A) = 2 then
		M := M union A;	
	fi:	
od:

if nops(M)+nops(Bo) = n^2 then
	return(true);
else
	return(false);
fi:	
end:


#############################################
# Pre-check possible penult board
# from giving part of the board 
# Input: Sq=giving squares, r=number of tokens,
# n=size of the board
# Try: Choose2(18,8,6);
Choose2 := proc(Sq,r,n) option remember;
local Bo;
[seq( Pass(Bo,n), Bo in choose(Sq,r))]; 
end:

# Second half of the board
# Input: N=squares=n^2, v starting value, 
# r more tokens
# Try: Board2(16,5,5,5);
Board2 := proc(N,v,r,n) option remember;
local a,Bo;
{seq( Pass([seq(a+v,a in Bo)],n) , Bo in choose(N-v,r))};
end:

Pass := proc(Bo,n) 
local L,MyB;

MyB := MakeBo(Bo,n);
for L in Lines(n) do
	if nops(L minus MyB) < 2 then
		return();
	fi:
od:	
return(Bo);
end:

# Try: MakeBo([1,3,5,7,9,11,14],4);
MakeBo := proc(B,n) option remember;
local b,r,c,S;

S := {};
for b in B do
	r := ceil(b/n); 
	c := b-(r-1)*n;
	S := S union {[r,c]}; 
od:

S;	
end: