"""
	characteristicMatrix( FV::Cells )::ChainOp

Binary matrix representing by rows the `p`-cells of a cellular complex.
The input parameter must be of `Cells` type. Return a sparse binary matrix,
providing the basis of a ``Chain`` space of given dimension. Notice that the
number of columns is equal to the number of vertices (0-cells).

# Example

```julia
V,(VV,EV,FV,CV) = cuboid([1.,1.,1.], true);

julia> Matrix(characteristicMatrix(FV))
6×8 Array{Int8,2}:
1  1  1  1  0  0  0  0
0  0  0  0  1  1  1  1
1  1  0  0  1  1  0  0
0  0  1  1  0  0  1  1
1  0  1  0  1  0  1  0
0  1  0  1  0  1  0  1

julia> Matrix(characteristicMatrix(CV))
1×8 Array{Int8,2}:
1  1  1  1  1  1  1  1

julia> Matrix(characteristicMatrix(EV))
12×8 Array{Int8,2}:
1  1  0  0  0  0  0  0
0  0  1  1  0  0  0  0
0  0  0  0  1  1  0  0
0  0  0  0  0  0  1  1
1  0  1  0  0  0  0  0
0  1  0  1  0  0  0  0
0  0  0  0  1  0  1  0
0  0  0  0  0  1  0  1
1  0  0  0  1  0  0  0
0  1  0  0  0  1  0  0
0  0  1  0  0  0  1  0
0  0  0  1  0  0  0  1
```
"""
function characteristicMatrix( FV::Cells )::ChainOp
	I,J,V = Int64[],Int64[],Int8[]
	for f=1:length(FV)
		for k in FV[f]
		push!(I,f)
		push!(J,k)
		push!(V,1)
		end
	end
	M_2 = sparse(I,J,V)
	return M_2
end

"""
	boundary_1( EV::Cells )::ChainOp

Computation of sparse signed boundary operator ``C_1 -> C_0``.

# Example
```julia
julia> V,(VV,EV,FV,CV) = cuboid([1.,1.,1.], true);

julia> EV
12-element Array{Array{Int64,1},1}:
[1, 2]
[3, 4]
...
[2, 6]
[3, 7]
[4, 8]

julia> boundary_1( EV::Cells )
8×12 SparseMatrixCSC{Int8,Int64} with 24 stored entries:
[1 ,  1]  =  -1
[2 ,  1]  =  1
[3 ,  2]  =  -1
...       ...
[7 , 11]  =  1
[4 , 12]  =  -1
[8 , 12]  =  1

julia> Matrix(boundary_1(EV::Cells))
8×12 Array{Int8,2}:
-1   0   0   0  -1   0   0   0  -1   0   0   0
1   0   0   0   0  -1   0   0   0  -1   0   0
0  -1   0   0   1   0   0   0   0   0  -1   0
0   1   0   0   0   1   0   0   0   0   0  -1
0   0  -1   0   0   0  -1   0   1   0   0   0
0   0   1   0   0   0   0  -1   0   1   0   0
0   0   0  -1   0   0   1   0   0   0   1   0
0   0   0   1   0   0   0   1   0   0   0   1
```
"""
function boundary_1( EV::Cells )::ChainOp
	out = characteristicMatrix(EV)'
	for e = 1:length(EV)
		out[EV[e][1],e] = -1
	end
	return out
end

"""
	coboundary_0(EV::Cells)

Return the `coboundary_0` signed operator `C_0` -> `C_1`.
"""
coboundary_0(EV::Cells) = convert(ChainOp,transpose(boundary_1(EV::Cells)))

"""
	fix_redundancy(target_mat, cscFV,cscEV)

*Fix the coboundary_1 matrix*, generated by sparse matrix product ``FV * EV^t``, for complexes with some *non-convex cells*. This approach can be used when both `EV` and `FV` of the cellular complex are known. It is exact when cells are convex. Maybe non-exact, introducing spurious incidence coefficients (``redundancies``), when adjacent faces share an edge combinatorially, but not geometrically. This happen when an edge is on the boundary of face A, but only its vertices are on the boundary of face B.  TODO: Similar situations may appear when computing algebraically CF as product of known CV and FV, with non-convex cells.

In order to remove such ``redundancies``, the Euler characteristic of 2-sphere is used, where V-E+F=2. Since we have F=2 (inner and outer face), ``V=E`` must hold, and `d=E-V` is the (non-negative) ``defect`` number, called `nfixs` in the code. It equates the number of columns `edges`
whose sum is greater than 2 for the considered row (face). Remember the in a ``d``-complex, *including* the ``outer cell``, all ``(d-1)``-faces must be shared by exactly 2 ``d``-faces. Note that `FV` *must include* the row of outer shell (exterior face).

# Example

```julia
FV = [[1,2,3,4,5,17,16,12],
[1,2,3,4,6,7,8,9,10,11,12,13,14,15],
[4,5,9,11,12,13,14,15,16,17],
[2,3,6,7], [8,9,10,11]]

FE = [[1,2,3,4,9,20,17,5],
[1,6,10,7,3,8,11,12,14,15,19,18,16,5],
[4,9,20,17,16,18,19,15,13,8],
[2,10,6,7], [11,12,13,14]]

EV = [[1,2],[2,3],[3,4],[4,5],[1,12],[2,6],[3,7],[4,9],[5,17],[6,7],[8,9],
[8,10],[9,11],[10,11],[11,15],[12,13],[12,16],[13,14],[14,15],[16,17]]

V = [0   2   5   7  10   2   5   3   7  3  7  0  3  3  7  0  10;
    16  16  16  16  16  13  13  11  11  8  8  5  5  2  2  0   0]

cscFE = u_coboundary_1( FV::Cells, EV::Cells, false);
Matrix(cscFE)
```

Notice that there are two columns (2 and 13) with 3 ones, hence (3-2)+(3-2)=2 defects to fix. The fixed complex can be shown graphically as:

```julia

VV = [[k] for k in 1:size(V,2)];
using Plasm
Plasm.view( Plasm.numbering(3)((V,[VV, EV, FV])) )
```
"""
function fix_redundancy(target_mat, cscFV,cscEV) # incidence numbers > 2#E
	nfixs = 0
	faces2fix = []
	edges2fix = []
	# target_mat and cscFV (ref_mat) should have same length per row !
	for face = 1:size(target_mat,1)
		nedges = sum(findnz(target_mat[face,:])[2])
		nverts = sum(findnz(cscFV[face,:])[2])
		if nedges != nverts
			nfixs += nedges - nverts
			#println("face $face, nedges=$nedges, nverts=$nverts")
			push!(faces2fix,face)
		end
	end
	for edge = 1:size(target_mat,2)
		nfaces = sum(findnz(target_mat[:,edge])[2])
		if nfaces > 2
			#println("edge $edge, nfaces=$nfaces")
			push!(edges2fix,edge)
		end
	end
	#println("nfixs=$nfixs")
	pairs2fix = []
	for fh in faces2fix		# for each face to fix
		for ek in edges2fix		# for each edge to fix
			if target_mat[fh, ek]==1	# edge to fix \in face to fix
				v1,v2 = findnz(cscEV[ek,:])[1]
				weight(v) = length( intersect(
							findnz(cscEV[:,v])[1], findnz(target_mat[fh,:])[1] ))
				if weight(v1)>2 && weight(v2)>2
					#println("(fh,ek) = $((fh,ek))")
					push!( pairs2fix, (fh,ek) )
				end
			end
		end
	end
	for (fh,ek) in pairs2fix
		target_mat[fh, ek] = 0
	end
	cscFE = dropzeros(target_mat)
	@assert nnz(cscFE) == 2*size(cscFE,2)
	return cscFE
end
function fix_lack(target_mat, cscFV,cscEV) # incidence numbers < 2#E
end

"""
	u_coboundary_1( FV::Cells, EV::Cells, convex=true)::ChainOp

Compute the sparse *unsigned* coboundary_1 operator ``C_1 -> C_2``.
Notice that the output matrix is `m x n`, where `m` is the number of faces, and `n`
is the number of edges.

# Examples

##  Cellular complex with convex-cells, and without outer cell

```julia
julia> V,(VV,EV,FV,CV) = cuboid([1.,1.,1.], true);

julia> u_coboundary_1(FV,EV)
6×12 SparseMatrixCSC{Int8,Int64} with 24 stored entries:
[1 ,  1]  =  1
[3 ,  1]  =  1
[1 ,  2]  =  1
[4 ,  2]  =  1
...		...
[4 , 11]  =  1
[5 , 11]  =  1
[4 , 12]  =  1
[6 , 12]  =  1

julia> Matrix(u_coboundary_1(FV,EV))
6×12 Array{Int8,2}:
1  1  0  0  1  1  0  0  0  0  0  0
0  0  1  1  0  0  1  1  0  0  0  0
1  0  1  0  0  0  0  0  1  1  0  0
0  1  0  1  0  0  0  0  0  0  1  1
0  0  0  0  1  0  1  0  1  0  1  0
0  0  0  0  0  1  0  1  0  1  0  1

julia> unsigned_boundary_2 = u_coboundary_1(FV,EV)';
```

Compute the *Unsigned* `coboundary_1` operator matrix as product of two
sparse characteristic matrices.

##  Cellular complex with non-convex cells, and with outer cell

```julia
FV = [[1,2,3,4,5,17,16,12], # outer cell
[1,2,3,4,6,7,8,9,10,11,12,13,14,15],
[4,5,9,11,12,13,14,15,16,17],
[2,3,6,7], [8,9,10,11]]

EV = [[1,2],[2,3],[3,4],[4,5],[1,12],[2,6],[3,7],[4,9],[5,17],[6,7],[8,9],
[8,10],[9,11],[10,11],[11,15],[12,13],[12,16],[13,14],[14,15],[16,17]]

out = u_coboundary_1( FV::Cells, EV::Cells, false)
```
In case of expected 2-chains with non-convex cells, instance the method with
`convex = false`, in order to fix a possible redundancy of incidence values, induced by computation through multiplication of characteristic matrices. (Look at columns
2 and 13 before, generated by default).
"""
function u_coboundary_1( FV::Cells, EV::Cells, convex=true::Bool)::ChainOp
	cscFV = characteristicMatrix(FV)
	cscEV = characteristicMatrix(EV)
	out = u_coboundary_1( cscFV::ChainOp, cscEV::ChainOp, convex::Bool)
	return out
end
function u_coboundary_1( cscFV::ChainOp, cscEV::ChainOp, convex=true::Bool)::ChainOp
	temp = cscFV * cscEV'
	I,J,Val = Int64[],Int64[],Int8[]
	for j=1:size(temp,2)
		for i=1:size(temp,1)
			if temp[i,j] == 2
				push!(I,i)
				push!(J,j)
				push!(Val,1)
			end
		end
	end
	cscFE = SparseArrays.sparse(I,J,Val)
	if !convex
		cscFE = fix_redundancy(cscFE,cscFV,cscEV)
	end
	return cscFE
end

"""
	coboundary_1( FV::Cells, EV::Cells)::ChainOp

Generate the *unsigned* sparse matrix of the coboundary_1 operator.
For each row, start with the first incidence number positive (i.e. assign the orientation of the first edge to the 1-cycle of the face), then bounce back and forth between vertex columns/rows of EV and FE.

# Example

copFE = coboundary_1(FV::Cells, EV::Cells)

julia> Matrix(cscFE)
5×20 Array{Int8,2}:
 1  1  1  1  1  0  0  0  1  0  0  0  0  0  0  0  1  0  0  1
 1  0  1  0  1  1  1  1  0  1  1  1  0  1  1  1  0  1  1  0
 0  0  0  1  0  0  0  1  1  0  0  0  1  0  1  1  1  1  1  1
 0  1  0  0  0  1  1  0  0  1  0  0  0  0  0  0  0  0  0  0
 0  0  0  0  0  0  0  0  0  0  1  1  1  1  0  0  0  0  0  0
"""
function coboundary_1(FV::Array{Array{Int64,1},1}, EV::Array{Array{Int64,1},1}) # (::Cells, ::Cells)
	copFV = lar2cop(FV)
	I,J,Val = findnz(Lar.lar2cop(EV))
	copVE = sparse(J,I,Val)
	triples = hcat([[i,j,1]  for (i,j,v)  in zip(findnz(copFV * copVE)...) if v==2]...)
	I,J,Val = triples[1,:], triples[2,:], triples[3,:]
	Val = convert(Array{Int8,1},Val)
	copFE = sparse(I,J,Val)
	return copFE
end

function coboundary_1( V::Points, FV::Cells, EV::Cells, convex=true::Bool, exterior=false::Bool)::ChainOp
	# generate unsigned operator's sparse matrix
	cscFV = characteristicMatrix(FV)
	cscEV = characteristicMatrix(EV)
	##if size(V,1) == 3
		##copFE = u_coboundary_1( FV::Cells, EV::Cells )
	##elseif size(V,1) == 2
		# greedy generation of incidence number signs
		copFE = coboundary_1( V, cscFV::ChainOp, cscEV::ChainOp, convex, exterior)
	##end
	return copFE
end

function coboundary_1( V::Points, cscFV::ChainOp, cscEV::ChainOp, convex=true::Bool, exterior=false::Bool )::ChainOp

	cscFE = u_coboundary_1( cscFV::ChainOp, cscEV::ChainOp, convex)
	EV = [findnz(cscEV[k,:])[1] for k=1:size(cscEV,1)]
	cscEV = sparse(coboundary_0( EV::Cells ))
	for f=1:size(cscFE,1)
		chain = findnz(cscFE[f,:])[1]	#	dense
		cycle = spzeros(Int8,cscFE.n)	#	sparse

		edge = findnz(cscFE[f,:])[1][1]; sign = 1
		cycle[edge] = sign
		chain = setdiff( chain, edge )
		while chain != []
			boundary = sparse(cycle') * cscEV
			_,vs,vals = findnz(dropzeros(boundary))

			rindex = vals[1]==1 ? vf = vs[1] : vf = vs[2]
			r_boundary = spzeros(Int8,cscEV.n)	#	sparse
			r_boundary[rindex] = 1
			r_coboundary = cscEV * r_boundary
			r_edge = intersect(findnz(r_coboundary)[1],chain)[1]
			r_coboundary = spzeros(Int8,cscEV.m)	#	sparse
			r_coboundary[r_edge] = EV[r_edge][1]<EV[r_edge][2] ? 1 : -1

			lindex = vals[1]==-1 ? vi = vs[1] : vi = vs[2]
			l_boundary = spzeros(Int8,cscEV.n)	#	sparse
			l_boundary[lindex] = -1
			l_coboundary = cscEV * l_boundary
			l_edge = intersect(findnz(l_coboundary)[1],chain)[1]
			l_coboundary = spzeros(Int8,cscEV.m)	#	sparse
			l_coboundary[l_edge] = EV[l_edge][1]<EV[l_edge][2] ? -1 : 1

			if r_coboundary != -l_coboundary  # false iff last edge
				# add edge to cycle from both sides
				rsign = rindex == EV[r_edge][1] ? 1 : -1
				lsign = lindex == EV[l_edge][2] ? -1 : 1
				cycle = cycle + rsign * r_coboundary + lsign * l_coboundary
			else
				# add last (odd) edge to cycle
				rsign = rindex==EV[r_edge][1] ? 1 : -1
				cycle = cycle + rsign * r_coboundary
			end
			chain = setdiff(chain, findnz(cycle)[1])
		end
		for e in findnz(cscFE[f,:])[1]
			cscFE[f,e] = cycle[e]
		end
	end
	if exterior && size(V,1)==2
		# put matrix in form: first row outer cell; with opposite sign )
		V = convert(Array{Float64,2},transpose(V))
		EV = convert(ChainOp, SparseArrays.transpose(boundary_1(EV)))

		outer = Arrangement.get_external_cycle(V::Points, cscEV::ChainOp,
			cscFE::ChainOp)
		copFE = [ -cscFE[outer:outer,:];  cscFE[1:outer-1,:];  cscFE[outer+1:end,:] ]
		# induce coherent orientation of matrix rows (see examples/orient2d.jl)
		for k=1:size(copFE,2)
			spcolumn = findnz(copFE[:,k])
			if sum(spcolumn[2]) != 0
				row = spcolumn[1][2]
				sign = spcolumn[2][2]
				copFE[row,:] = -sign * copFE[row,:]
			end
		end
		return copFE
	else
		return cscFE
	end
end

"""
	u_boundary_2(FV::Cells, EV::Cells)::ChainOp

Return the unsigned `boundary_2` operator `C_2` -> `C_1`.
"""
u_boundary_2(EV, FV) = (u_coboundary_1(FV, EV))'

"""
	u_boundary_3(CV::Cells, FV::Cells)::ChainOp

Return the unsigned `boundary_3` operator `C_3` -> `C_2`.
"""
u_boundary_3(CV, FV) = (u_coboundary_2(CV, FV))'

"""
	u_coboundary_2( CV::Cells, FV::Cells[, convex=true::Bool] )::ChainOp

Unsigned 2-coboundary matrix `∂_2 : C_2 -> C_3` from 2-chain to 3-chain space.
Compute algebraically the *unsigned* coboundary matrix `∂_2` from
characteristic matrices of `CV` and `FV`. Currently usable *only* with complexes of *convex* cells.

#	Examples

## First example

(1) Compute the *boundary matrix* for a block of 3-cells of size ``[32,32,16]``;

(2) compute and show the *boundary* 2-cell array `boundary_2D_cells` by decodifying the (`mod 2`) result of multiplication of  the *boundary_3 matrix* `∂_2'`, transpose of *unsigned  coboundary_2* matrix  times the coordinate vector of the ``total`` 3-chain.

```julia
julia> using SparseArrays, Plasm
julia> V,(_,_,FV,CV) = cuboidGrid([32,32,16], true)
julia> ∂_2 = u_coboundary_2( CV, FV)
julia> coord_vect_of_all_3D_cells  = ones(size(∂_2,1),1)
julia> coord_vect_of_boundary_2D_cells = ∂_2' * coord_vect_of_all_3D_cells .% 2
julia> out = coord_vect_of_boundary_2D_cells
julia> boundary_2D_cells = [ FV[f] for f in findnz(sparse(out))[1] ]
julia> hpc = Plasm.lar2exploded_hpc(V, boundary_2D_cells)(1.,1.,1.)
julia> Plasm.view(hpc)
```
## Second example example

Using the boundary matrix of the `32 x 32 x 16` "image block" (better if stored on disk)
compute the boundary 2-complex of a random sub-image inside the block.

```julia
julia> coord_vect_of_segment = [x>0.25 ? 1 : 0  for x in rand(size(∂_2,1)) ]
julia> out = ∂_2' * coord_vect_of_segment .% 2
julia> boundary_2D_cells = [ FV[f] for f in findnz(sparse(out))[1] ]
julia> hpc = Plasm.lar2exploded_hpc(V, boundary_2D_cells)(1.1,1.1,1.1)
julia> Plasm.view(hpc)
```

"""
function u_coboundary_2( CV::Cells, FV::Cells, convex=true::Bool)::ChainOp
	cscCV = characteristicMatrix(CV)
	cscFV = characteristicMatrix(FV)
	temp = cscCV * cscFV'
	I,J,value = Int64[],Int64[],Int8[]
	for j=1:size(temp,2)
		nverts = length(FV[j])
		for i=1:size(temp,1)
			if temp[i,j] == nverts
				push!(I,i)
				push!(J,j)
				push!(value,1)
			end
		end
	end
	cscCF = SparseArrays.sparse(I,J,value)
	if !convex
		@assert "not yet implemented: TODO!"
	end
	return cscCF
end

"""
	chaincomplex( W::Points, EW::Cells )::Tuple{Array{Cells,1},Array{ChainOp,1}}

Chain 2-complex construction from basis of 1-cells.

From the minimal input, construct the whole
two-dimensional chain complex, i.e. the bases for linear spaces C_1 and
C_2 of 1-chains and  2-chains, and the signed coboundary operators from
C_0 to C_1 and from C_1 to C_2.

# Example

```julia
julia> W =
[0.0  0.0  0.0  0.0  1.0  1.0  1.0  1.0  2.0  2.0  2.0  2.0  3.0  3.0  3.0  3.0
0.0  1.0  2.0  3.0  0.0  1.0  2.0  3.0  0.0  1.0  2.0  3.0  0.0  1.0  2.0  3.0]
# output
2×16 Array{Float64,2}: ...

julia> EW =
[[1, 2],[2, 3],[3, 4],[5, 6],[6, 7],[7, 8],[9, 10],[10, 11],[11, 12],[13, 14],
[14, 15],[15, 16],[1, 5],[2, 6],[3, 7],[4, 8],[5, 9],[6, 10],[7, 11],[8, 12],
[9, 13],[10, 14],[11, 15],[12, 16]]
# output
24-element Array{Array{Int64,1},1}: ...

julia> V,bases,coboundaries = chaincomplex(W,EW)

julia> bases[1]	# edges
24-element Array{Array{Int64,1},1}: ...

julia> bases[2] # faces -- previously unknown !!
9-element Array{Array{Int64,1},1}: ...

julia> coboundaries[1] # coboundary_1
24×16 SparseMatrixCSC{Int8,Int64} with 48 stored entries: ...

julia> Matrix(coboundaries[2]) # coboundary_1: faces as oriented 1-cycles of edges
9×24 Array{Int8,2}:
-1  0  0  1  0  0  0  0  0  0  0  0  1 -1  0  0  0  0  0  0  0  0  0  0
0 -1  0  0  1  0  0  0  0  0  0  0  0  1 -1  0  0  0  0  0  0  0  0  0
0  0 -1  0  0  1  0  0  0  0  0  0  0  0  1 -1  0  0  0  0  0  0  0  0
0  0  0 -1  0  0  1  0  0  0  0  0  0  0  0  0  1 -1  0  0  0  0  0  0
0  0  0  0 -1  0  0  1  0  0  0  0  0  0  0  0  0  1 -1  0  0  0  0  0
0  0  0  0  0 -1  0  0  1  0  0  0  0  0  0  0  0  0  1 -1  0  0  0  0
0  0  0  0  0  0  0 -1  0  0  1  0  0  0  0  0  0  0  0  0  0  1 -1  0
0  0  0  0  0  0 -1  0  0  1  0  0  0  0  0  0  0  0  0  0  1 -1  0  0
0  0  0  0  0  0  0  0 -1  0  0  1  0  0  0  0  0  0  0  0  0  0  1 -1
```
"""
function chaincomplex( W, EW )
	V = convert(Array{Float64,2},LinearAlgebra.transpose(W))
	EV = convert(ChainOp, SparseArrays.transpose(boundary_1(EW)))

	V,cscEV,cscFE = planar_arrangement(V,EV)

	ne,nv = size(cscEV)
	nf = size(cscFE,1)
	EV = [findall(!iszero, cscEV[e,:]) for e=1:ne]
	FV = [collect(Set(vcat([EV[e] for e in findall(!iszero, cscFE[f,:])]...)))  for f=1:nf]

	function ord(cells)
		return [sort(cell) for cell in cells]
	end
	temp = copy(convert(ChainOp, LinearAlgebra.transpose(cscEV)))
	for k=1:size(temp,2)
		h = findall(!iszero, temp[:,k])[1]
		temp[h,k] = -1
	end
	cscEV = convert(ChainOp, LinearAlgebra.transpose(temp))
	bases, coboundaries = (ord(EV),ord(FV)), (cscEV,cscFE)
	return V',bases,coboundaries
end

"""
	chaincomplex( W::Points, FW::Cells, EW::Cells )
		::Tuple{ Array{Cells,1}, Array{ChainOp,1} }

Chain 3-complex construction from bases of 2- and 1-cells.

From the minimal input, construct the whole
two-dimensional chain complex, i.e. the bases for linear spaces C_1 and
C_2 of 1-chains and  2-chains, and the signed coboundary operators from
C_0 to C_1  and from C_1 to C_2.

# Example
```julia
julia> cube_1 = ([0 0 0 0 1 1 1 1; 0 0 1 1 0 0 1 1; 0 1 0 1 0 1 0 1],
[[1,2,3,4],[5,6,7,8],[1,2,5,6],[3,4,7,8],[1,3,5,7],[2,4,6,8]],
[[1,2],[3,4],[5,6],[7,8],[1,3],[2,4],[5,7],[6,8],[1,5],[2,6],[3,7],[4,8]] )

julia> cube_2 = Struct([t(0,0,0.5), r(0,0,pi/3), cube_1])

julia> V,FV,EV = struct2lar(Struct([ cube_1, cube_2 ]))

julia> V,bases,coboundaries = chaincomplex(V,FV,EV)

julia> (EV, FV, CV), (cscEV, cscFE, cscCF) = bases,coboundaries

julia> FV # bases[2]
18-element Array{Array{Int64,1},1}:
[1, 3, 4, 6]
[2, 3, 5, 6]
[7, 8, 9, 10]
[1, 2, 3, 7, 8]
[4, 6, 9, 10, 11, 12]
[5, 6, 11, 12]
[1, 4, 7, 9]
[2, 5, 11, 13]
[2, 8, 10, 11, 13]
[2, 3, 14, 15, 16]
[11, 12, 13, 17]
[11, 12, 13, 18, 19, 20]
[2, 3, 13, 17]
[2, 13, 14, 18]
[15, 16, 19, 20]
[3, 6, 12, 15, 19]
[3, 6, 12, 17]
[14, 16, 18, 20]

julia> CV # bases[3]
3-element Array{Array{Int64,1},1}:
[2, 3, 5, 6, 11, 12, 13, 14, 15, 16, 18, 19, 20]
[2, 3, 5, 6, 11, 12, 13, 17]
[1, 2, 3, 4, 6, 7, 8, 9, 10, 11, 12, 13, 17]

julia> cscEV # coboundaries[1]
34×20 SparseMatrixCSC{Int8,Int64} with 68 stored entries: ...

julia> cscFE # coboundaries[2]
18×34 SparseMatrixCSC{Int8,Int64} with 80 stored entries: ...

julia> cscCF # coboundaries[3]
4×18 SparseMatrixCSC{Int8,Int64} with 36 stored entries: ...
```
"""
function chaincomplex(V,FV,EV)
	W = convert(Points, copy(V)');
    cop_EV = coboundary_0(EV::Cells);
    cop_FE = coboundary_1(V, FV::Cells, EV::Cells);

    W, copEV, copFE, copCF = Arrangement.spatial_arrangement( W::Points, cop_EV::ChainOp, cop_FE::ChainOp)
	ne,nv = size(copEV)
	nf = size(copFE,1)
	nc = size(copCF,1)
	EV = [findall(!iszero, copEV[e,:]) for e=1:ne]
	FV = [collect(Set(vcat([EV[e] for e in findall(!iszero, copFE[f,:])]...)))  for f=1:nf]
	CV = [collect(Set(vcat([FV[f] for f in findall(!iszero, copCF[c,:])]...)))  for c=2:nc]
	function ord(cells)
		return [sort(cell) for cell in cells]
	end
	temp = copy(convert(ChainOp, LinearAlgebra.transpose(copEV)))
	for k=1:size(temp,2)
		h = findall(!iszero, temp[:,k])[1]
		temp[h,k] = -1
	end
	copEV = convert(ChainOp, LinearAlgebra.transpose(temp))
	bases, coboundaries = (ord(EV),ord(FV),ord(CV)), (copEV,copFE,copCF)
	W = convert(Points, (LinearAlgebra.transpose(V')))
	return W,bases,coboundaries
end

# Collect LAR models in a single LAR model
function collection2model(collection)
	W,FW,EW = collection[1]
	shiftV = size(W,2)
	for k=2:length(collection)
		V,FV,EV = collection[k]
		W = [W V]
		FW = [FW; FV + shiftV]
		EW = [EW; EV + shiftV]
		shiftV = size(W,2)
	end
	return W,FW,EW
end

function arrange2D(V,EV)
	cop_EV = coboundary_0(EV::Cells)
	cop_EW = convert(ChainOp, cop_EV)
	W = convert(Points,V')
	V, copEV, copFE = Arrangement.planar_arrangement(W::Points, cop_EW::ChainOp)
	EVs = FV2EVs(copEV, copFE) # polygonal face fragments

	triangulated_faces = triangulate2D(V, [copEV, copFE])
	FVs = convert(Array{Cells}, triangulated_faces)
	V = convert(Points,V')
	return V,FVs,EVs, copEV, copFE
end

"""
	pols2tria(W::Points, copEV::ChainOp,
			copFE::ChainOp, copCF::ChainOp)

Take a chain 3-complex and return arrays of boundary simplicial complexes.
Input and ouput Points (embedding geometry) are by columns.
Arrays of simplicial complexes are by body, by face, and by boundary of face.
```

```
"""
function pols2tria(W, copEV, copFE, copCF) # W by columns
	V = convert(Points,W')
	triangulated_faces = triangulate(V, [copEV, copFE])
	EVs = FV2EVs(copEV, copFE) # polygonal face fragments
	# triangulated_faces = [ item for (k,item) in enumerate(triangulated_faces)
	# 	if isdefined(triangulated_faces,k) && item ≠ Any[]  ]
	FVs = convert(Array{Cells}, triangulated_faces)
	CVs = []
	for cell in 1:copCF.m
		obj = []
        for f in copCF[cell, :].nzind
            triangles = triangulated_faces[f]
			append!(obj, triangles)
        end
		push!(CVs,obj)
    end
	V = convert(Points,V')
	return V,CVs,FVs,EVs
end
## Fs is the signed coord vector of a subassembly
## the logic is to compute the corresponding reduced coboundary matrices
## and finally call the standard method of the function.
function pols2tria(W, copEV, copFE, copCF, Fs) # W by columns
	# make copies of coboundary operators

	# compute the reduced copCF
	CFtriples = findnz(copCF)
	triples = [triple for triple in zip(CFtriples...)]
	newtriples = [(row,col,val) for (row,col,val) in triples if Fs[col] ≠ 0]
	newF = [k for (k,f) in enumerate(Fs) if Fs[k] ≠ 0]
	fdict = Dict( zip(newF, 1:length(newF)))
	triples = hcat([[row,fdict[col],val] for (row,col,val) in newtriples]...)
	newCF = sparse( triples[1,:], triples[2,:], triples[3,:] )
	copCF = convert( SparseMatrixCSC{Int8,Int64}, newCF )

	# compute the reduced copFE
	FEtriples = findnz(copFE)
	triples = [triple for triple in zip(FEtriples...)]
	newtriples = [(row,col,val) for (row,col,val) in triples if Fs[row] ≠ 0]
	newF = [k for (k,f) in enumerate(Fs) if Fs[k] ≠ 0]
	newcol = collect(Set([col for (row,col,val) in newtriples]))
	facedict = Dict( zip(newF, 1:length(newF)))
	edgedict = Dict( zip(newcol, 1:length(newcol)))
	triples = hcat([ [facedict[row],edgedict[col],val] for (row,col,val) in newtriples]...)
	newFE = sparse( triples[1,:], triples[2,:], triples[3,:] )
	copFE = convert( SparseMatrixCSC{Int8,Int64}, newFE )

	# compute the reduced copEV
	EVtriples = findnz(copEV)
	triples = [triple for triple in zip(EVtriples...)]
	newtriples = [(row,col,val) for (row,col,val) in triples if row in keys(edgedict)]
	# newcol = collect(Set([col for (row,col,val) in newtriples]))
	# vertdict = Dict( zip(newcol, 1:length(newcol)))
	# triples = hcat([[edgedict[row],vertdict[col],val] for (row,col,val) in newtriples]...)
	triples = hcat([[edgedict[row],col,val] for (row,col,val) in newtriples]...)
	newEV = sparse( triples[1,:], triples[2,:], triples[3,:] )
	copEV = convert( SparseMatrixCSC{Int8,Int64}, newEV )

	#W = convert(Points,W') # BOH...!!
	# finally compute the cells, faces, and edges of subassembly
	V,CVs,FVs,EVs = pols2tria(W, copEV, copFE, copCF)
	return V,CVs,FVs,EVs
end

"""
	permutationOrbits(perm::OrderedDict)::Array{Array{Int64,1},1}

Compute the ``cycles`` of a `perm` ``permutation`` of the first integers (starting from 1).

The `perm` parameter is an ``ordered dictionary``. The output is an
array of arrays of integers (``orbits``).

# Examples

```
julia> dict(List) = OrderedDict((i,x) for (i,x) in enumerate(List))
dict (generic function with 1 method)

julia> perm = dict([2, 3, 4, 5, 6, 7, 8, 1]);

julia> permutationOrbits(perm)
1-element Array{Array{Int64,1},1}:
 [2, 3, 4, 5, 6, 7, 8, 1, 2]

julia> perm = dict([3,9,8,12,10,7,2,11,6,4,1,5]);

julia> permutationOrbits(perm)
3-element Array{Array{Int64,1},1}:
 [3, 8, 11, 1, 3]
 [9, 6, 7, 2, 9]
 [12, 5, 10, 4, 12]

julia> permutationOrbits(Dict())
0-element Array{Array{Int64,1},1}

julia> permutationOrbits(Dict(1=>1))
1-element Array{Array{Int64,1},1}:
 [1, 1]
```
"""
function permutationOrbits(perm::OrderedDict)
	out = Array{Int64,1}[]
    while perm ≠ Dict()
        x = collect(keys(perm))[1]
        orbit = Int64[]
        while x in keys(perm)
            append!(orbit, perm[x])
			y,x = x,perm[x]
            delete!(perm,y)
		end
        append!(out, [ push!(orbit,orbit[1]) ]  )
	end
    return out
end

## Generation of oriented boundary faces
"""
	faces2polygons(copEV::ChainOp, copFE::ChainOp)::Array{Array{Array{Int64,1},1},1}

Generate an array of faces (array of polygons, given as oriented cycles of vertex indices).

The input is a chain of two ``chain operators`` (coboundaries).
The output is a list of list of polygons, given as oriented ``cycles of vertex`` indices.
``Outer`` polygons are counterclockwise-oriented; ``inner`` polygons are clockwise-oriented.
The first polygon of each face is the outer one.

#	Example
Both a polygon with ``holes`` and polygons ``fitting the holes`` are defined in the following.
The reader should note the ``mutual orientation`` of holes and polygons fitting them.
They are correctly derived from a sparse `copFE` matrix created by ``TGW algorithm`` in 2D.

```
julia> V = [540.313 540.313 2038.65 2038.65 1990.25 1990.25 583.951 583.951 2038.65 2038.65 1551.97 1990.25 1551.97 1990.25 409.035 2265.24 409.035 2265.24 540.313 540.313 583.951 583.951 934.346 1246.02 934.346 1246.02; -2129.59 -1653.96 -2129.59 -1493.96 -2064.15 -1493.96 -2064.15 -1653.96 -1104.9 -1221.14 -1104.9 -1137.88 -1137.88 -1221.14 -1007.31 -1007.31 -2210.65 -2210.65 -1109.81 -1360.09 -1104.1 -1360.09 -1104.9 -1104.9 -1137.88 -1137.88]

julia> copEV = sparse([1, 2, 1, 8, 2, 3, 3, 7, 4, 5, 4, 7, 5, 6, 6, 8, 9, 10, 9, 13, 10, 14, 11, 12, 11, 14, 12, 13, 15, 16, 15, 17, 16, 18, 17, 18, 19, 21, 19, 22, 20, 21, 20, 22, 23, 24, 23, 26, 24, 25, 25, 26], [1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, 23, 23, 24, 24, 25, 25, 26, 26], Int8[-1, -1, 1, -1, 1, -1, 1, -1, -1, -1, 1, 1, 1, -1, 1, 1, -1, -1, 1, -1, 1, -1, -1, -1, 1, 1, 1, 1, -1, -1, 1, -1, 1, -1, 1, 1, -1, -1, 1, -1, -1, 1, 1, 1, -1, -1, 1, -1, 1, -1, 1, 1])

julia> copFE = sparse([1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 2, 3, 2, 3, 2, 3, 2, 3, 2, 3, 2, 3, 3, 3, 3, 3, 3, 4, 3, 4, 3, 4, 3, 4, 3, 5, 3, 5, 3, 5, 3, 5], [1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 16, 17, 18, 19, 19, 20, 20, 21, 21, 22, 22, 23, 23, 24, 24, 25, 25, 26, 26], Int8[-1, 1, 1, -1, 1, -1, -1, 1, 1, -1, 1, -1, 1, -1, -1, 1, -1, 1, 1, -1, -1, 1, 1, -1, -1, 1, 1, -1, -1, 1, -1, 1, -1, 1, 1, -1, 1, -1, -1, 1, 1, -1, -1, 1, -1, 1, 1, -1])

julia> faces2polygons(copEV,copFE)
5-element Array{Array{Array{Int64,1},1},1}:
 [[1, 3, 4, 6, 5, 7, 8, 2]]
 [[9, 11, 13, 12, 14, 10]]
 [[2, 8, 7, 5, 6, 4, 3, 1], [10, 14, 12, 13, 11, 9], [15, 17, 18, 16], [19, 21, 22, 20], [24, 26, 25, 23]]
 [[20, 22, 21, 19]]
 [[23, 25, 26, 24]]

julia> model = (V, [ [[v] for v=1:size(V,2)], cop2lar(copEV) ])
([540.313 540.313 … 934.346 1246.02; -2129.59 -1653.96 … -1137.88 -1137.88], Array{Array{Int64,1},1}[[[1], [2], [3], [4], [5], [6], [7], [8], [9], [10]  …  [17], [18], [19], [20], [21], [22], [23], [24], [25], [26]], [[1, 2], [1, 3], [3, 4], [5, 6], [5, 7], [7, 8], [4, 6], [2, 8], [9, 10], [9, 11]  …  [16, 18], [17, 18], [19, 20], [21, 22], [19, 21], [20, 22], [23, 24], [23, 25], [25, 26], [24, 26]]])

julia> GL.VIEW( GL.numbering(200)( model, GL.COLORS[1], 0.1 ) );
```
"""
function faces2polygons(copEV,copFE)
	polygons = Array{Array{Int64,1},1}[]
	cycles = Array{Array{Array{Int64,1},1},1}[]
	for f=1:size(copFE,1)
		edges,signs = findnz(copFE[f,:])
		permutationMap = OrderedDict([ s>0 ? findnz(copEV[e,:])[1] : reverse(findnz(copEV[e,:])[1])
				for (e,s) in zip(edges,signs)])
		orbits = permutationOrbits(permutationMap)
		edgecycles = [[[ orbit[k], orbit[k+1] ] for k=1:length(orbit)-1]  for orbit in orbits]
		push!(polygons, [orbit[1:end-1] for orbit in orbits])
		push!(cycles, edgecycles)
	end
	return polygons,cycles
end


using FastTransforms
using Test

@testset "FastTransforms spin spherical harmonics" begin
    lmax = 4
    s = 1

    C1 = zeros(Complex{Float64}, lmax + 1, 2lmax + 1)
    C1[1, 2] = 1                 # l=1, m=-1

    C2 = zeros(Complex{Float64}, lmax + 1, 2lmax + 1)
    C2[2, 2] = 1                 # l=2, m=-1

    # Evalute
    P = plan_spinsph2fourier(C1, s)
    PS = plan_spinsph_synthesis(C1, s)
    F1 = PS * (P * C1)
    F2 = PS * (P * C2)

    # Calculate scalar product kernel
    F = conj(F1) .* F2

    # Integrate (by calculating l=0 mode)
    P = plan_sph2fourier(C1)
    PA = plan_sph_analysis(F)
    C = P \ (PA * F)

    # Should be zero
    @test abs(C[1, 1]) < 10eps()
end


using SubglacialPlumes
using Test

#params = Params( )
@testset "ExampleTests" begin
    #2x + 3y
    @test SubglacialPlumes.f(2,1) == 7
    @test SubglacialPlumes.f(2,3) == 13
end


########################################################################
# Uncertain values constructed from distributions with known parameters
########################################################################
o1 = UncertainValue(Normal, 0, 0.5)
o2 = UncertainValue(Normal, 2.0, 0.1)
o3 = UncertainValue(Uniform, 0, 4)
o4 = UncertainValue(Uniform, rand(100))
o5 = UncertainValue(Beta, 4, 5)
o6 = UncertainValue(Gamma, 4, 5)
o7 = UncertainValue(Frechet, 1, 2)
o8 = UncertainValue(BetaPrime, 1, 2)
o9 = UncertainValue(BetaBinomial, 10, 3, 2)
o10 = UncertainValue(Binomial, 10, 0.3)

@test resample(o1) isa Float64
@test resample(o2) isa Float64
@test resample(o3) isa Float64
@test resample(o4) isa Float64
@test resample(o5) isa Float64
@test resample(o6) isa Float64
@test resample(o7) isa Float64
@test resample(o8) isa Float64
@test resample(o9) isa Int
@test resample(o10) isa Int

########################################################################
# Resampling uncertain values with constraints
########################################################################

u = UncertainValue(Normal, 0, 1)

# Resampling many times
@test maximum(resample(u, TruncateLowerQuantile(0.2), 1000)) >= quantile(u.distribution, 0.2)
@test maximum(resample(u, TruncateUpperQuantile(0.7), 1000)) <= quantile(u.distribution, 0.7)
@test maximum(resample(u, TruncateMinimum(-0.1), 10)) >= -0.1
@test maximum(resample(u, TruncateMaximum(0.1), 10)) <= 0.1

# quantile truncation
c = resample(u, TruncateQuantiles(0.3, 0.9), 1000)
@test minimum(c) >= quantile(u.distribution, 0.3)
@test maximum(c) <= quantile(u.distribution, 0.9)

# standard deviation truncation
c = resample(u, TruncateStd(1))
@test maximum(c) <= 0 + std(u)
@test minimum(c) >= 0 - std(u)

# range truncation
c = resample(u, TruncateRange(-0.2, 0.2))
@test maximum(c) <= 0.2
@test minimum(c) >= -0.2

# range truncation
c = resample(u, TruncateRange(-0.2, 0.2), 100)
@test maximum(c) <= 0.2
@test minimum(c) >= -0.2

# Resampling once
using StatsBase
@test maximum(resample(u, TruncateLowerQuantile(0.2))) >= quantile(u.distribution, 0.2)
@test maximum(resample(u, TruncateUpperQuantile(0.7))) <= quantile(u.distribution, 0.7)
@test maximum(resample(u, TruncateMinimum(-0.1))) >= -0.1
@test maximum(resample(u, TruncateMaximum(0.1))) <= 0.1
c = resample(u, TruncateQuantiles(0.3, 0.9))
@test minimum(c) >= quantile(u.distribution, 0.3)
@test maximum(c) <= quantile(u.distribution, 0.9)


include("../common/utils.jl")
using ForwardDiff: derivative
using LinearAlgebra: eigen

abstract type AbstractProblem end
struct Isothermal{T} <: AbstractProblem
    T₀::T
    R::T
    p₀::T
    g::T
    ρ₀::T
    H::T
    Cᵥ::T
    γ::T
    function Isothermal{T}(;
        T₀ = 300,
        R = 287,
        p₀ = 10^5,
        g = T(98 // 100),
    ) where {T}
        H = R * T₀ / g
        ρ₀ = p₀ / (R * T₀)
        Cᵥ = 5R / 2
        γ = R / Cᵥ + 1
        new{T}(T₀, R, p₀, g, ρ₀, H, Cᵥ, γ)
    end
end

p̄_(s::AbstractProblem, z) = s.p₀ * exp(-z / s.H)
ρ̄_(s::AbstractProblem, z) = s.ρ₀ * exp(-z / s.H)
Ē_(s::AbstractProblem, z) = ρ̄_(s, z) * (s.Cᵥ * s.T₀ + s.g * z)
δp_(s::AbstractProblem, z, δE, δρ) = (s.R / s.Cᵥ) * (δE - s.g * z * δρ)
c̄_(s::AbstractProblem, _) = sqrt(s.γ * s.p₀ / s.ρ₀)

function create_mesh(K, z0, z1)
    Δz = (z1 - z0) / K
    zi = range(z0, stop = z1, length = K + 1)
    zc = zi[1:K] .+ Δz / 2
    return (zc = zc, zi = zi, Δz = Δz)
end

function tendency!(∂q, q, t, s, mesh, f = nothing)
    N = length(q.ρc)

    g = s.g

    Δz = mesh.Δz

    ρ̄i = ρ̄_.(Ref(s), mesh.zi)
    Ēi = Ē_.(Ref(s), mesh.zi)
    p̄i = p̄_.(Ref(s), mesh.zi)

    ρ̄_wi = ρ̄i .* q.wi

    Ē_p̄_wi = (Ēi + p̄i) .* q.wi

    g_ρi = g * (q.ρc[1:(end - 1)] + q.ρc[2:end]) / 2

    pc = δp_.(Ref(s), mesh.zc, q.Ec, q.ρc)

    # ∂zρ̄w
    ∂q.ρc .= -(ρ̄_wi[2:end] - ρ̄_wi[1:(end - 1)]) / Δz

    # (g * ρ′ + ∂zδp) / ρ̄
    ∂q.wi[2:(end - 1)] .= -g_ρi ./ ρ̄i[2:(end - 1)]
    ∂q.wi[2:(end - 1)] .+=
        -(pc[2:end] - pc[1:(end - 1)]) ./ (Δz * ρ̄i[2:(end - 1)])

    # ∂z((Ē + p̄) w′)
    ∂q.Ec .= -(Ē_p̄_wi[2:end] - Ē_p̄_wi[1:(end - 1)]) / Δz

    if !isnothing(f)
      ∂q.ρc .+= f.ρ.(mesh.zc, t)
      ∂q.wi[2:(end - 1)] .+= f.w.(mesh.zi[2:(end - 1)], t)
      ∂q.Ec .+= f.E.(mesh.zc, t)
    end
end

function mms(Ks = 10 * 2 .^ (0:6), z0 = 0.0, z1 = 1.0)
    ϵ = zeros(3, length(Ks))
    for (lvl, K) in enumerate(Ks)
        @show lvl, K

        T = Float64

        mesh = create_mesh(K, z0, z1)

        s = Isothermal{T}()
        # Calculate the wave speed
        c̄ = c̄_(s, 0)

        # mms solution
        κ = c̄ / (z1 - z0)
        f(z, t) = cos(t * κ * π) * sin(2π * (z - z0) / (z1 - z0))
        ρ′(z, t) = f(2z, 4t)
        w′(z, t) = f(1z, 2t)
        E′(z, t) = f(1z, 1t)

        ∂tρ′(z, t) = derivative(t -> ρ′(z, t), t)
        ∂tw′(z, t) = derivative(t -> w′(z, t), t)
        ∂tE′(z, t) = derivative(t -> E′(z, t), t)

        ∂zρ̄w(z, t) = derivative(z -> ρ̄_(s, z) * w′(z, t), z)
        ∂zδp(z, t) = derivative(z -> δp_(s, z, E′(z, t), ρ′(z, t)), z)
        ∂zĒ_p̄w′(z, t) = derivative(z -> (Ē_(s, z) + p̄_(s, z)) * w′(z, t), z)

        # Forcing for each term
        fρ(z, t) = ∂tρ′(z, t) + ∂zρ̄w(z, t)

        grav_source(z, t) = s.g * ρ′(z, t)
        fw(z, t) = ∂tw′(z, t) + (grav_source(z, t) + ∂zδp(z, t)) / ρ̄_(s, z)

        fE(z, t) = ∂tE′(z, t) + ∂zĒ_p̄w′(z, t)

        forcing = (ρ = fρ, w = fw, E = fE)

        cfl = 1

        # estimate time step
        dt = cfl * mesh.Δz / c̄
        tspan = (0, 1 / κ)
        steps = ceil(Int, (tspan[2] - tspan[1]) / dt)
        dt = (tspan[2] - tspan[1]) / steps

        rhs!(∂q, q, t) = tendency!(∂q, q, t, s, mesh, forcing)

        q = (
            ρc = ρ′.(mesh.zc, tspan[1]),
            wi = w′.(mesh.zi, tspan[1]),
            Ec = E′.(mesh.zc, tspan[1]),
        )
        timestep!(q, rhs!, dt, tspan)
        qe = (
            ρc = ρ′.(mesh.zc, tspan[2]),
            wi = w′.(mesh.zi, tspan[2]),
            Ec = E′.(mesh.zc, tspan[2]),
        )

        # Calculate the L2 error
        for i in 1:3
            ϵ[i, lvl] = sqrt(sum(mesh.Δz .* (q[i] - qe[i]) .^ 2))
        end
        @show ϵ[:, lvl]
        if lvl > 1
          rate = (log.(ϵ[:, lvl]) - log.(ϵ[:, lvl-1])) / (log(Ks[lvl-1]) - log(Ks[lvl]))
          @show rate
        end
        println()
    end
end

function form_matrix(K, z0, z1)
    mesh = create_mesh(K, z0, z1)

    s = Isothermal{Float64}()

    # Initial conditions
    q = (
        ρc = fill!(similar(mesh.zc), 0),
        wi = fill!(similar(mesh.zi), 0),
        Ec = fill!(similar(mesh.zc), 0),
    )

    # advance in time
    ∂q = (
        ρc = fill!(similar(mesh.zc), 0),
        wi = fill!(similar(mesh.zi), 0),
        Ec = fill!(similar(mesh.zc), 0),
    )

    rhs!(∂q, q, t) = tendency!(∂q, q, t, s, mesh)

    A = zeros(3K - 1, 3K - 1)
    pts = (ρc = 1:K, wi = K .+ (1:K-1), Ec = 2K-1 .+ (1:K))
    col = 0
    for f = 1:3
      # @show pts[f]
      q[f] .= 0
      ∂q[f] .= 0
    end
    # @show size(A)
    for i = 1:K
      col = col + 1
      q.ρc[i] = 1
      rhs!(∂q, q, 0)
      A[pts.ρc, col] .= ∂q.ρc
      A[pts.wi, col] .= ∂q.wi[2:end-1]
      A[pts.Ec, col] .= ∂q.Ec
      ∂q.ρc .= 0
      ∂q.wi .= 0
      ∂q.Ec .= 0
      q.ρc[i] = 0
    end
    for i = 2:K
      col = col + 1
      q.wi[i] = 1
      rhs!(∂q, q, 0)
      A[pts.ρc, col] .= ∂q.ρc
      A[pts.wi, col] .= ∂q.wi[2:end-1]
      A[pts.Ec, col] .= ∂q.Ec
      ∂q.ρc .= 0
      ∂q.wi .= 0
      ∂q.Ec .= 0
      q.wi[i] = 0
    end
    for i = 1:K
      col = col + 1
      q.Ec[i] = 1
      rhs!(∂q, q, 0)
      A[pts.ρc, col] .= ∂q.ρc
      A[pts.wi, col] .= ∂q.wi[2:end-1]
      A[pts.Ec, col] .= ∂q.Ec
      ∂q.ρc .= 0
      ∂q.wi .= 0
      ∂q.Ec .= 0
      q.Ec[i] = 0
    end

    q = (
        ρc = rand(K),
        wi = rand(K+1),
        Ec = rand(K),
    )
    q.wi[1] = 0
    q.wi[end] = 0

    rhs!(∂q, q, 0)

    q̄ = [q.ρc; q.wi[2:end-1]; q.Ec]
    ∂q̄ = A * q̄

    @assert all(∂q.ρc .≈ ∂q̄[pts.ρc])
    @assert all(∂q.wi[2:end-1] .≈ ∂q̄[pts.wi])
    @assert all(∂q.Ec .≈ ∂q̄[pts.Ec])

    return A
end

let
  K = 1000
  A = form_matrix(K, 0.0, 1.0)
  ev = eigen(A);
  vs = findall(abs.(ev.values) .< 1e-14)
  @show length(vs), K
  pts = (ρc = 1:K, wi = K .+ (1:K-1), Ec = 2K-1 .+ (1:K))
  for v in vs
     @assert maximum(abs.(ev.vectors[pts.wi, v])) < 1e-16
  end
end


using Revise
using JuMP, EAGO

m = Model(optimizer_with_attributes(EAGO.Optimizer, "verbosity" => 1,
                                                    "output_iterations" => 10000,
                                                    "cp_repetitions" => -1,
                                                    "iteration_limit" => 1000000,
                                                    "cut_min_iterations" => 1,
                                                    "cut_max_iterations" => 1,
                                                    "objective_cut_on" => true,
                                                    "subgrad_tighten" => true,
                                                    "obbt_depth" => -1,
                                                    "fbbt_lp_depth" => -1))

x_Idx = Any[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24]

@variable(m, 0 <= x[x_Idx] <= 100)

# ----- Constraints ----- #
@constraint(m, e2, x[1]+x[2]+x[3]+x[4] == 8.0)
@constraint(m, e3, x[5]+x[6]+x[7]+x[8] == 24.0)
@constraint(m, e4, x[9]+x[10]+x[11]+x[12] == 20.0)
@constraint(m, e5, x[13]+x[14]+x[15]+x[16] == 24.0)
@constraint(m, e6, x[17]+x[18]+x[19]+x[20] == 16.0)
@constraint(m, e7, x[21]+x[22]+x[23]+x[24] == 12.0)
@constraint(m, e8, x[1]+x[5]+x[9]+x[13]+x[17]+x[21] == 29.0)
@constraint(m, e9, x[2]+x[6]+x[10]+x[14]+x[18]+x[22] == 41.0)
@constraint(m, e10, x[3]+x[7]+x[11]+x[15]+x[19]+x[23] == 13.0)
@constraint(m, e11, x[4]+x[8]+x[12]+x[16]+x[20]+x[24] == 21.0)

@NLobjective(m, Min, (300*x[1]-7*x[1]*x[1]-4*x[2]*x[2]+270*x[2]-6*x[3]*x[3]+460*x[3]-8*x[4]*x[4]+800*x[4]-12*x[5]*x[5]+740*x[5]-9*x[6]*x[6]+600*x[6]-14*x[7]*x[7]+540*x[7]-7*x[8]*x[8]+380*x[8]-13*x[9]*x[9]+300*x[9]-12*x[10]*x[10]+490*x[10]-8*x[11]*x[11]+380*x[11]-4*x[12]*x[12]+760*x[12]-7*x[13]*x[13]+430*x[13]-9*x[14]*x[14]+250*x[14]-16*x[15]*x[15]+390*x[15]-8*x[16]*x[16]+600*x[16]-4*x[17]*x[17]+210*x[17]-10*x[18]*x[18]+830*x[18]-21*x[19]*x[19]+470*x[19]-13*x[20]*x[20]+680*x[20]-17*x[21]*x[21]+360*x[21]-9*x[22]*x[22]+290*x[22]-8*x[23]*x[23]+400*x[23]-4*x[24]*x[24]+310*x[24]))

JuMP.optimize!(m)
run_time = backend(m).optimizer.model.optimizer._run_time
#objective_value =
#objective_bound =
#println("objective between: ")
println("run time: $run_time")


module FEFMM_Tests
    using Test
    using FEFMM
    using UnicodePlots
    using LinearAlgebra: norm

    include("testmediums.jl")

    function convergence_test(hlist, test_fun, test_name)
        @testset "$test_name" begin
            linorm = zeros(length(hlist))
            l2norm = zeros(length(hlist))
            for i = 1:length(hlist)
                (x0, k2, t_exact) = test_fun(hlist[i])
                t_pred = FEFMM.fefmm(k2, repeat([hlist[i]], ndims(k2)), x0)
                err = t_exact.-t_pred
                linorm[i] = norm(err, Inf)
                l2norm[i] = norm(err, 2)/sqrt(length(err))
            end

            plt = lineplot(log10.(hlist),
                        log10.(linorm),
                        title = test_name,
                        name = "L_inf norm",
                        xlabel = "log_10(h)",
                        ylabel = "log_10(Error)",
                        xlim = [floor(minimum(log10.(hlist))), ceil(maximum(log10.(hlist)))],
                        ylim = [floor(minimum(log10.([linorm; l2norm]))), ceil(maximum(log10.([linorm; l2norm])))],
                        color = :blue)

            lineplot!(plt, log10.(hlist), log10.(l2norm), name = "mean L2 norm", color = :red)
            println(plt)
            @test reverse(linorm) == sort(linorm) #test for decreasing error with decreasing h
            @test reverse(l2norm) == sort(l2norm)
        end
    end

    @testset "FEFMM Tests" begin
        @testset "Solve Piecewise Quadratic" begin
            @test isapprox(FEFMM.solve_piecewise_quadratic(1.0,1.0,1.0), 2.0)
            @test isapprox(FEFMM.solve_piecewise_quadratic(1.0,1.0,1.0,1.0,1.0), 1.0+1/sqrt(2))
            @test isapprox(FEFMM.solve_piecewise_quadratic(1.0,1.0,100.0,1.0,1.0), 2.0)
            @test isapprox(FEFMM.solve_piecewise_quadratic(2.0,1.0,1.0,100.0,1.0), 1.0)
            @test isapprox(FEFMM.solve_piecewise_quadratic(1.0,1.0,1.0,1.0,1.0,1.0,1.0), 1.0+1/sqrt(3))
            @test isapprox(FEFMM.solve_piecewise_quadratic(1.0,2.0,3.0,100.0,10.0,1.0,1.0), 2.0/3.0)
            @test isapprox(FEFMM.solve_piecewise_quadratic(1.0,2.0,3.0,10.0,100.0,1.0,1.0), 2.0/3.0)
            @test isapprox(FEFMM.solve_piecewise_quadratic(1.0,2.0,3.0,10.0,1.0,100.0,1.0), 1.0)
            @test isapprox(FEFMM.solve_piecewise_quadratic(1.0,2.0,3.0,1.0,10.0,100.0,1.0), 2.0)
        end

        @testset "Basic FEFMM Checks" begin
            κ21d = ones(101)
            dx1d = [0.1]
            xs1d = CartesianIndex(1)
            τa1d = 0:0.1:10
            @test all(isapprox.(τa1d, FEFMM.fefmm(κ21d, dx1d, xs1d)))
            κ22d = ones(101,101)
            dx2d = [0.1,0.1]
            xs2d = CartesianIndex(1,1)
            τaxis = 0:0.1:10
            τa2d = sqrt.(τaxis'.^2 .+ τaxis.^2)
            @test all(isapprox.(τa2d, FEFMM.fefmm(κ22d, dx2d, xs2d)))
            @test all(isapprox.(Float32.(τa2d), Float32.(FEFMM.fefmm(κ22d, Float32.(dx2d), xs2d))))
            κ23d = ones(101,101,101)
            dx3d = [0.1,0.1,0.1]
            xs3d = CartesianIndex(1,1,1)
            τa3d = zeros(101,101,101)
            for k in 1:101
                for j in 1:101
                    for i in 1:101
                        τa3d[i,j,k] = sqrt(τaxis[i]^2+τaxis[j]^2+τaxis[k]^2)
                    end
                end
            end
            @test all(isapprox.(τa3d, FEFMM.fefmm(κ23d, dx3d, xs3d)))
            @test all(isapprox.(Float32.(τa3d), Float32.(FEFMM.fefmm(κ23d, Float32.(dx3d), xs3d))))
        end

        @testset "Convergence Tests" begin
            convergence_test([1/20, 1/40, 1/80, 1/160, 1/320], const_k2_2D, "Constant Gradient of Squared Slowness 2D")
            convergence_test([1/20, 1/40, 1/80, 1/160, 1/320], const_v2_2D, "Constant Gradient of Squared Velocity 2D")
            convergence_test([1/20, 1/40, 1/80, 1/160, 1/320], gaussian_factor_2D, "Gaussian Factor 2D")
            convergence_test([1/20, 1/40, 1/80], const_k2_3D, "Constant Gradient of Squared Slowness 3D")
            convergence_test([1/20, 1/40, 1/80], const_v2_3D, "Constant Gradient of Squared Velocity 3D")
            convergence_test([1/20, 1/40, 1/80], gaussian_factor_3D, "Gaussian Factor 3D")
        end
    end
end


export CarteCoord
export FractCoord
export dimension
export fract2carte, carte2fract

"""
    CarteCoord

Cartesian coordinates. `Vector{Float64}`.
"""
const CarteCoord = Vector{Float64}

"""
    FractCoord

Fractional coordinates.

# Fields
* `whole::Vector{Int}`: Integer part of fractional coordinates
* `fraction::Vector{Float64}`: [0,1) part of fractional coordinates
"""
struct FractCoord  # TODO: Type parameter for integer and float
    whole::Vector{Int}
    fraction::Vector{Float64}

    @doc """
        FractCoord(w, f)

    # Arguments
    * `w::AbstractVector{<:Integer}`: whole part of the coordinate
    * `f::AbstractVector{<:Real}`: fractional part. In [0, 1).
    """
    function FractCoord(
        w::AbstractVector{<:Integer}, f::AbstractVector{<:Real};
        tol::Real=Base.rtoldefault(Float64)
    )
        if length(w) != length(f)
            throw(ArgumentError("w and f need to be of same the length"))
        elseif tol < 0
            throw(ArgumentError("tol must be non-negative"))
        elseif !all(x -> 0 <= x < 1+tol, f)
            throw(ArgumentError("f must be a list of floating points in [0, 1) (got $f)"))
        end

        neww = copy(w)
        newf = copy(f)
        for (idx, (wval, fval)) in enumerate(zip(neww, newf))
            if fval <= tol
                newf[idx] = 0.0
            elseif fval + tol >= 1.0
                newf[idx] = 0.0
                neww[idx] += 1
            end
        end
        return new(neww, newf)
    end

    @doc """
        FractCoord(coord)

    Create a `FractCoord` from `coord`, where `whole` is determined by `fld(x, 1)` and
    `fraction` by `mod(x, 1)`.

    # Arguments
    * `coord::AbstractVector{<:Real}`
    """
    function FractCoord(coord::AbstractVector{<:Real}; tol::Real=Base.rtoldefault(Float64))
        w = Int[fld(x,1) for x in coord]
        f = Float64[mod(x,1) for x in coord]
        return FractCoord(w, f; tol=tol)
    end

    @doc """
        FractCoord(ndim)

    Construct a zero `FractCoord` of `ndim` dimensions.

    # Arguments
    * `ndim::Integer`: spatial dimensions
    """
    function FractCoord(ndim::Integer)
        ndim <= 0 && throw(ArgumentError("ndim should be positive"))
        w = zeros(Int, ndim)
        f = zeros(Float64, ndim)
        return new(w, f)
    end
end

"""
    dimension(fc::FractCoord)

Dimension of the fractional coordinates

# Arguments
* `fc::FractCoord`: Fractional coordinates.
"""
dimension(fc::FractCoord) = length(fc.whole)

function Base.:(+)(fc::FractCoord)::FractCoord
    return fc
end

function Base.:(-)(fc::FractCoord)::FractCoord
    return FractCoord(-(fc.whole + fc.fraction))
end

function Base.:(+)(fractcoord::FractCoord, R::AbstractVector{<:Integer})::FractCoord
    return FractCoord(fractcoord.whole + R, fractcoord.fraction)
end

function Base.:(-)(fractcoord::FractCoord, R::AbstractVector{<:Integer})::FractCoord
    return FractCoord(fractcoord.whole - R, fractcoord.fraction)
end

function Base.:(+)(fc1::FractCoord, fc2::FractCoord)::FractCoord
    R = Int[fld(x+y,1) for (x,y) in zip(fc1.fraction, fc2.fraction)]
    r = Float64[mod(x+y,1) for (x,y) in zip(fc1.fraction, fc2.fraction)]
    return FractCoord(fc1.whole + fc2.whole + R, r)
end

function Base.:(-)(fc1::FractCoord, fc2::FractCoord) ::FractCoord
    R = Int[fld(x-y,1) for (x,y) in zip(fc1.fraction, fc2.fraction)]
    r = Float64[mod(x-y,1) for (x,y) in zip(fc1.fraction, fc2.fraction)]
    return FractCoord(fc1.whole - fc2.whole + R, r)
end

function Base.isapprox(
    fc1::FractCoord, fc2::FractCoord;
    atol::Real=Base.rtoldefault(Float64), rtol::Real=Base.rtoldefault(Float64)
)::Bool
    return (
        (fc1.whole == fc2.whole) &&
        isapprox(fc1.fraction, fc2.fraction; atol=atol, rtol=rtol)
    )
end

function Base.:(*)(mat::AbstractMatrix{<:Number}, fc::FractCoord)::FractCoord
    return FractCoord(mat * (fc.whole + fc.fraction))
end

function Base.:(==)(fc1::FractCoord, fc2::FractCoord)::Bool
    return (fc1.whole == fc2.whole) && (fc1.fraction == fc2.fraction)
end

function Base.show(io::IO, fc::FractCoord)
    print(io, "FractCoord(", fc.whole, " + ", fc.fraction,")")
end

"""
    fract2carte(latticevectors, fc)

# Arguments
* `latticevectors::AbstractArray{<:Real, 2}`: square matrix whose columns are lattice vectors.
* `fc::FractCoord`: fractional coordinates
"""
function fract2carte(latticevectors::AbstractMatrix{<:Real}, fc::FractCoord)::CarteCoord
    d1, d2 = size(latticevectors)
    d3 = dimension(fc)
    if d1 != d2
        throw(ArgumentError("latticevectors should be a square matrix "))
    elseif d1 != d3
        throw(ArgumentError("Dimensions of latticevectors and fc "))
    end
    mc = fc.whole + fc.fraction
    cc = latticevectors * mc
    return CarteCoord(cc)
end

"""
    carte2fract(latticevectors, cc; tol=√ϵ)

# Arguments
* `latticevectors::AbstractArray{<:Real, 2}`: square matrix whose columns are lattice vectors.
* `cc::CarteCoord`: cartesian coordinates
* `tol::Real=Base.rtoldefault(Float64)`: tolerance
"""
function carte2fract(
    latticevectors::AbstractMatrix{<:Real},
    cc::CarteCoord;
    tol::Real=Base.rtoldefault(Float64)
)::FractCoord
    fc = inv(latticevectors) * cc
    w = Int[fld(x, 1) for x in fc]
    f = Float64[mod(x, 1) for x in fc]
    return FractCoord(w, f; tol=tol)
end


using Integrals
using IntegralsCuba, IntegralsCubature
using Test

max_dim_test = 2
max_nout_test = 2
reltol=1e-3
abstol=1e-3

algs = [QuadGKJL(), HCubatureJL(), CubatureJLh(), CubatureJLp(), #VEGAS(), CubaVegas(),
        CubaSUAVE(),CubaDivonne(), CubaCuhre()]

alg_req=Dict(QuadGKJL()=>     (nout=1,   allows_batch=false, min_dim=1, max_dim=1,   allows_iip = false),
             HCubatureJL()=>  (nout=Inf, allows_batch=false, min_dim=1, max_dim=Inf, allows_iip = true ),
             VEGAS()=>        (nout=1,   allows_batch=true,  min_dim=1, max_dim=Inf, allows_iip = true ),
             CubatureJLh()=>  (nout=Inf, allows_batch=true,  min_dim=1, max_dim=Inf, allows_iip = true ),
             CubatureJLp()=>  (nout=Inf, allows_batch=true,  min_dim=1, max_dim=Inf, allows_iip = true ),
             CubaVegas()=>    (nout=Inf, allows_batch=true,  min_dim=1, max_dim=Inf, allows_iip = true ),
             CubaSUAVE()=>    (nout=Inf, allows_batch=true,  min_dim=1, max_dim=Inf, allows_iip = true ),
             CubaDivonne()=>  (nout=Inf, allows_batch=true,  min_dim=2, max_dim=Inf, allows_iip = true ),
             CubaCuhre()=>    (nout=Inf, allows_batch=true,  min_dim=2, max_dim=Inf, allows_iip = true ))

integrands = [
              (x,p) -> 1.0,
              (x,p) -> x isa Number ? cos(x) : prod(cos.(x))
             ]
iip_integrands = [ (dx,x,p)-> (dx .= f(x,p)) for f ∈ integrands]

integrands_v = [
                (x,p,nout) -> collect(1.0:nout)
                (x,p,nout) -> integrands[2](x,p)*collect(1.0:nout)
                ]
iip_integrands_v = [ (dx,x,p,nout)-> (dx .= f(x,p,nout)) for f ∈ integrands_v]

exact_sol = [
                (ndim, nout, lb, ub) -> prod(ub-lb),
                (ndim, nout, lb, ub) -> prod(sin.(ub)-sin.(lb))
            ]

exact_sol_v = [
                (ndim, nout, lb, ub) -> prod(ub-lb) * collect(1.0:nout),
                (ndim, nout, lb, ub) -> exact_sol[2](ndim,nout,lb,ub) * collect(1:nout)
            ]

batch_f(f) = (pts,p) -> begin
  fevals = zeros(size(pts,2))
  for i = 1:size(pts, 2)
     x = pts[:,i]
     fevals[i] = f(x,p)
  end
  fevals
end

batch_iip_f(f) = (fevals,pts,p) -> begin
  for i = 1:size(pts, 2)
     x = pts[:,i]
     fevals[i] = f(x,p)
  end
  nothing
end

batch_f_v(f, nout) = (pts,p) -> begin
  fevals = zeros(nout, size(pts,2))
  for i = 1:size(pts, 2)
     x = pts[:,i]
     fevals[:,i] = f(x,p,nout)
  end
  fevals
end

batch_iip_f_v(f,nout) = (fevals,pts,p) -> begin
  for i = 1:size(pts, 2)
     x = pts[:,i]
     fevals[:,i] = f(x,p, nout)
  end
  nothing
end

@testset "Standard Single Dimension Integrands" begin
    lb,ub = (1.0,3.0)
    nout = 1
    dim = 1
    for alg in algs
        if alg_req[alg].min_dim > 1
            continue
        end
        for i in 1:length(integrands)
            prob = IntegralProblem(integrands[i],lb,ub)
            @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
            sol = solve(prob,alg,reltol=reltol,abstol=abstol)
            @test sol.u ≈ exact_sol[i](dim,nout,lb,ub) rtol = 1e-2
        end
    end
end

@testset "Standard Integrands" begin
    nout = 1
    for alg in algs
        req = alg_req[alg]
        for i in 1:length(integrands)
            for dim = 1:max_dim_test
                lb, ub = (ones(dim), 3ones(dim))
                prob = IntegralProblem(integrands[i],lb,ub)
                if dim > req.max_dim || dim < req.min_dim || alg isa QuadGKJL  #QuadGKJL requires numbers, not single element arrays
                    continue
                end
                @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
                sol = solve(prob,alg,reltol=reltol,abstol=abstol)
                @test sol.u ≈ exact_sol[i](dim,nout,lb,ub) rtol = 1e-2
            end
        end
    end
end

@testset "In-place Standard Integrands" begin
    nout = 1
    for alg in algs
        req = alg_req[alg]
        for i in 1:length(iip_integrands)
            for dim = 1:max_dim_test
                lb, ub = (ones(dim), 3ones(dim))
                prob = IntegralProblem(iip_integrands[i],lb,ub)
                if dim > req.max_dim || dim < req.min_dim || alg isa QuadGKJL  #QuadGKJL requires numbers, not single element arrays
                    continue
                end
                @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
                if alg isa HCubatureJL  && dim == 1 # HCubature library requires finer tol to pass test. When requiring array outputs for iip integrands
                    sol = solve(prob,alg,reltol=1e-5,abstol=1e-5)
                else
                    sol = solve(prob,alg,reltol=reltol,abstol=abstol)
                end
                @test sol.u ≈ [exact_sol[i](dim,nout,lb,ub)] rtol = 1e-2
            end
        end
    end
end

@testset "Batched Single Dimension Integrands" begin
    (lb,ub) = (1.0,3.0)
    (dim, nout) = (1,1)
    for alg in algs
        req = alg_req[alg]
        for i in 1:length(integrands)
            prob = IntegralProblem(batch_f(integrands[i]),lb,ub,batch=10)
            if req.min_dim > 1 || !req.allows_batch
                continue
            end
            @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
            sol = solve(prob,alg,reltol=reltol,abstol=abstol)
            @test sol.u ≈ [exact_sol[i](dim,nout,lb,ub)] rtol = 1e-2
        end
    end
end

@testset "Batched Standard Integrands" begin
    nout = 1
    for alg in algs
        req = alg_req[alg]
        for i in 1:length(integrands)
            for dim = 1:max_dim_test
                (lb,ub) = (ones(dim),3ones(dim))
                prob = IntegralProblem(batch_f(integrands[i]),lb,ub,batch=10)
                if dim > req.max_dim || dim < req.min_dim || !req.allows_batch
                    continue
                end
                @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
                sol = solve(prob,alg,reltol=reltol,abstol=abstol)
                @test sol.u ≈ [exact_sol[i](dim,nout,lb,ub)] rtol = 1e-2
            end
        end
    end
end

@testset "In-Place Batched Standard Integrands" begin
    nout = 1
    for alg in algs
        req = req = alg_req[alg]
        for i in 1:length(iip_integrands)
            for dim = 1:max_dim_test
                (lb,ub) = (ones(dim),3ones(dim))
                prob = IntegralProblem(batch_iip_f(integrands[i]),lb,ub,batch=10)
                if dim > req.max_dim || dim < req.min_dim || !req.allows_batch || !req.allows_iip
                    continue
                end
                @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
                sol = solve(prob,alg,reltol=reltol,abstol=abstol)
                @test sol.u ≈ [exact_sol[i](dim,nout,lb,ub)] rtol = 1e-2
            end
        end
    end
end

######## Vector Valued Integrands
@testset "Standard Single Dimension Vector Integrands" begin
    lb,ub = (1.0,3.0)
    dim = 1
    for alg in algs
        req = alg_req[alg]
        for i in 1:length(integrands_v)
            for nout = 1:max_nout_test
                prob = IntegralProblem((x,p) -> integrands_v[i](x,p,nout),lb,ub, nout = nout)
                if req.min_dim > 1 || req.nout < nout
                    continue
                end
                @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
                sol = solve(prob,alg,reltol=reltol,abstol=abstol)
                @test sol.u ≈ exact_sol_v[i](dim,nout,lb,ub) rtol = 1e-2
            end
        end
    end
end

@testset "Standard Vector Integrands" begin
    for alg in algs
        req = alg_req[alg]
        for i in 1:length(integrands_v)
            for dim = 1:max_dim_test
                lb, ub = (ones(dim), 3ones(dim))
                for nout = 1:max_nout_test
                    if dim > req.max_dim || dim < req.min_dim || req.nout < nout || alg isa QuadGKJL  #QuadGKJL requires numbers, not single element arrays
                        continue
                    end
                    prob = IntegralProblem((x,p) -> integrands_v[i](x,p,nout),lb,ub, nout = nout)
                    @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
                    sol = solve(prob,alg,reltol=reltol,abstol=abstol)
                    @test sol.u ≈ exact_sol_v[i](dim,nout,lb,ub) rtol = 1e-2
                end
            end
        end
    end
end

@testset "In-place Standard Vector Integrands" begin
    for alg in algs
        req = alg_req[alg]
        for i in 1:length(iip_integrands_v)
            for dim = 1:max_dim_test
                lb, ub = (ones(dim), 3ones(dim))
                for nout = 1:max_nout_test
                    prob = IntegralProblem((dx,x,p) ->iip_integrands_v[i](dx,x,p,nout),lb,ub,nout = nout)
                    if dim > req.max_dim || dim < req.min_dim || req.nout < nout || alg isa QuadGKJL  #QuadGKJL requires numbers, not single element arrays
                        continue
                    end
                    @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
                    if alg isa HCubatureJL  && dim == 1 # HCubature library requires finer tol to pass test. When requiring array outputs for iip integrands
                        sol = solve(prob,alg,reltol=1e-5,abstol=1e-5)
                    else
                        sol = solve(prob,alg,reltol=reltol,abstol=abstol)
                    end
                    @test sol.u ≈ exact_sol_v[i](dim,nout,lb,ub) rtol = 1e-2
                end
            end
        end
    end
end

@testset "Batched Single Dimension Vector Integrands" begin
    (lb,ub) = (1.0,3.0)
    (dim, nout) = (1,2)
    for alg in algs
        req = alg_req[alg]
        for i in 1:length(integrands_v)
            prob = IntegralProblem(batch_f_v(integrands_v[i],nout),lb,ub,batch=10,nout = nout)
            if req.min_dim > 1 || !req.allows_batch || req.nout < nout
                continue
            end
            @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
            sol = solve(prob,alg,reltol=reltol,abstol=abstol)
            @test sol.u ≈ exact_sol_v[i](dim,nout,lb,ub) rtol = 1e-2
        end
    end
end

@testset "Batched Standard Vector Integrands" begin
    nout = 2
    for alg in algs
        req = alg_req[alg]
        for i in 1:length(integrands_v)
            for dim = 1:max_dim_test
                (lb,ub) = (ones(dim),3ones(dim))
                prob = IntegralProblem(batch_f_v(integrands_v[i],nout),lb,ub,batch=10,nout = nout)
                if dim > req.max_dim || dim < req.min_dim || !req.allows_batch || req.nout < nout
                    continue
                end
                @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
                sol = solve(prob,alg,reltol=reltol,abstol=abstol)
                @test sol.u ≈ exact_sol_v[i](dim,nout,lb,ub) rtol = 1e-2
            end
        end
    end
end

@testset "In-Place Batched Standard Vector Integrands" begin
    nout = 2
    for alg in algs
        req = req = alg_req[alg]
        for i in 1:length(iip_integrands_v)
            for dim = 1:max_dim_test
                (lb,ub) = (ones(dim),3ones(dim))
                prob = IntegralProblem(batch_iip_f_v(integrands_v[i],nout),lb,ub,batch=10,nout = nout)
                if dim > req.max_dim || dim < req.min_dim || !req.allows_batch || !req.allows_iip || req.nout < nout
                    continue
                end
                @info "Alg = $alg, Integrand = $i, Dimension = $dim, Output Dimension = $nout"
                sol = solve(prob,alg,reltol=reltol,abstol=abstol)
                @test sol.u ≈ exact_sol_v[i](dim,nout,lb,ub) rtol = 1e-2
            end
        end
    end
end


#!/usr/bin/env julia

using Luxor

using Test

using Random
Random.seed!(42)

function drawpolyboundingbox(apoly)
    gsave()
    setline(0.3)
    setdash("dotted")
    poly(convert(Vector{Point}, BoundingBox(apoly)), :stroke, close=true)
    box(BoundingBox(apoly), :stroke)
    grestore()
end

function drawpoly(p, x, y, counter)
    gsave()
    translate(x, y)
    sethue("purple")

    # label old points
    @layer begin
        sethue("grey50")
        fontsize(8)
        for (n, pt) in enumerate(p)
            circle(pt, 1, :fill)
            label(string(n), :NW, pt, offset=5)
        end
    end

    psort = polysortbyangle(p)
    drawpolyboundingbox(psort)
    poly(psort, close=true, :stroke)

    # label sorted points
    for (n, pt) in enumerate(psort)
        circle(pt, 1, :fill)
        text(string(n), pt.x, pt.y)
    end

    sethue("green")
    cp = polycentroid(psort)
    circle(cp, 5, :fill)
    text(string(counter), cp.x, cp.y)

    # highlight cases where centroid isn't inside poly. Might be an error...
    if ! isinside(cp, psort)
        gsave()
        setdash("dotted")
        setopacity(0.2)
        sethue("red")
        circle(cp, 100, :fillstroke)
        grestore()
    end

    grestore()
end

function polycentroidsort(width, height)
    pagetiles = Tiler(width, height, 5, 5, margin=50)
    tilesize = pagetiles.tilewidth/2
    for (pos, n) in pagetiles

        p = randompointarray(rand(-tilesize:-tilesize), rand(-tilesize:-tilesize), rand(tilesize:tilesize), rand(tilesize:tilesize), rand(5:12))

        # check for axis-aligned edges too
        rand(1:10) > 7 && (p = Random.shuffle!(box(O, 250, 300, vertices=true)))
        drawpoly(p, pos.x, pos.y, n)
    end
end

function polycentroidtest(fname)
    width, height = 3000, 3000
    Drawing(width, height, fname)
    fontsize(20)
    background("white")
    origin()
    polycentroidsort(width, height)
    @test finish() == true
end

fname = "polycentroidsort.png"
polycentroidtest(fname)

println("...finished test: output in $(fname)")


# Introductory demonstration of IterationControl.jl

using Pkg
Pkg.activate(@__DIR__)
Pkg.instantiate()

# Here's a simple iterative mdel that computes Babylonian
# approximations to a square root:

mutable struct SquareRooter
    x::Float64     # input - number to be square rooted
    root::Float64  # current approximation of root
    training_losses::Vector{Float64} # successive approximation differences
    SquareRooter(x) = new(x, 1.0, Float64[])
end

function train!(m::SquareRooter, Δn::Int)
    m.training_losses = Float64[]
    for i in 1:Δn
        next_guess = (m.root + m.x/m.root)/2
        push!(m.training_losses, abs(next_guess - m.root))
        m.root = next_guess
    end
end

loss(m::SquareRooter) = abs(m.root^2 - m.x)
training_losses(m::SquareRooter) = m.training_losses

# And here it in action:

model = SquareRooter(9)
model.root

#-

train!(model, 2) # train for 2 iterations
model.root

#-

train!(model, 1) # train for 1 more iteration
model.root

#  Then we can replace the integer argument `n` in `train!(model, n)`
#  with a number of more sophisticated *controls* by "lifting" the method
# `train!` to the `IterationControl.train!` method defined in this
# package:

using IterationControl
IterationControl.train!(model::SquareRooter, n) =  train!(model, n)

# The lifted `train!` has the same functionality as the original one:

model = SquareRooter(9)
IterationControl.train!(model, 2)

model.root

# But now we can also do this:

IterationControl.train!(model, Step(2), NumberLimit(3), Info(m->m.root));

# Here each control is repeatedly applied until one of them triggers a
# stop. The first control `Step(2)` says "train the model two more
# iterations"; the second says "stop after 3 repetitions" (of the
# sequence of control applications); and the third, "log the value of
# the root to `Info`".

# If `model` admits a method returning a loss (for example, the
# difference between `x` and the square of `root`), then we can lift
# that method to `IterationControl.loss` to enable control using
# loss-based stopping criteria, such as a loss threshold. In the
# demonstation below, we also include a callback:

model = SquareRooter(4)
train!(model, 1)
loss(model)

#-

IterationControl.loss(model::SquareRooter) = loss(model)

losses = Float64[]
callback(model) = push!(losses, loss(model))

IterationControl.train!(model,
                        Step(1),
                        Threshold(0.0001),
                        Callback(callback));
#-

losses

# If training `model` generates user-inspectable "training losses" (one
# per iteration) then similarly lifting the appropriate access function
# to `IterationControl.training_losses` enables Prechelt's
# progress-modified generalization loss stopping criterion, `PQ`.

# `PQ` is the only criterion from the
# [EarlyStopping.jl](https://github.com/ablaom/EarlyStopping.jl) package
# not otherwise enabled when `IterationControl.loss` is overloaded as
# above.

# *Reference.* [Prechelt, Lutz
#  (1998)](https://link.springer.com/chapter/10.1007%2F3-540-49430-8_3):
#  "Early Stopping - But When?", in *Neural Networks: Tricks of the
#  Trade*, ed. G. Orr, Springer.

# The interface just described is sufficient for controlling
# conventional machine learning models with an iteration parameter, as
# this [tree boosting
# example](https://github.com/ablaom/IterationControl.jl/tree/master/examples/tree_booster)
# shows.

using Literate #src
Literate.markdown(@__FILE__, @__DIR__, execute=true) #src
Literate.notebook(@__FILE__, @__DIR__, execute=true) #src


using BenchmarkTools
using Printf
using Transducers

#### Parsing

function parseEntry(s::AbstractString)::Array{Bool,1}
    out = Array{Bool, 1}(undef, length(s))
    for i = 1:length(s)
        out[i] = (s[i] == '#')
    end
    out
end

#### Reading

function readMap(path)
    readlines(path) |> Map(line -> parseEntry(line)) |> collect
end

#### Logic

function countTrees(map, slope)
    slopeX, slopeY = slope
    count = 0; x = 1; y = 1
    while y <= length(map)
        row = map[y]
        if row[((x - 1) % length(row)) + 1]
            count += 1
        end
        x += slopeX; y += slopeY
    end
    count
end

function multiCountTrees(map, slopes)
    foldxt(*, slopes |> Map(slope -> countTrees(map, slope)))
end

#### Test

exampleMap = readMap("src/advent/day3/example.txt")
testMap = readMap("src/advent/day3/input.txt")

######### Part 1

testSlope = (3, 1)
@assert countTrees(exampleMap, testSlope) == 7

@printf("part1 = %d\n", countTrees(testMap, testSlope))
@btime countTrees(testMap, testSlope);

######### Part 2

testSlopes = ((1, 1), (3, 1), (5, 1), (7, 1), (1, 2))

@assert multiCountTrees(exampleMap, testSlopes) == 336

@printf("part2 = %d\n", multiCountTrees(testMap, testSlopes))
@btime multiCountTrees(testMap, testSlopes);


#!/usr/bin/env julia

using Base.Threads, FLoops

function _picalc(numsteps)
    slice = 1.0 / numsteps

    @floop @simd for i = 1:numsteps
        x = (i - 0.5) * slice
        @reduce(sum += 4.0 / (1.0 + x ^ 2))
    end

    return sum * slice
end

function picalc(numsteps)

    println("Calculating PI using:")
    println("  ", numsteps, " slices")
    println("  ", nthreads(), " thread(s)")

    start = time()
    mypi = _picalc(numsteps)
    elapsed = time() - start

    println("Obtained value of PI: ", mypi)
    println("Time taken: ", elapsed, " seconds")

end

numsteps = if length(ARGS) > 0
    parse(Int, ARGS[1])
else
    1_000_000_000
end

# Warm up kernel
_picalc(10)

# Run the full example
picalc(numsteps)


module ShaleDrillingLikelihood_Drilling_Test

const DOBTIME = false

using ShaleDrillingLikelihood

using Test
using StatsFuns
using Random
using BenchmarkTools
using Base.Threads
using InteractiveUtils
using Distributions

using Calculus
using Optim
using LinearAlgebra

using LinearAlgebra: checksquare
using Optim: minimizer

using ShaleDrillingLikelihood: SimulationDraws,
    DataDrill,
    TestDrillModel,
    DrillingTmpVars,
    DrillUnit,
    AbstractDrillRegime,
    DrillLease,
    ObservationDrill,
    InitialDrilling,
    DevelopmentDrilling,
    theta_drill_ρ,
    _model,
    update!,
    loglik_drill_lease!,
    loglik_drill_unit!,
    simloglik_drill_unit!,
    simloglik_drill_data!,
    _y

println("testing drilling likelihood")

@testset "Drilling Likelihood" begin

    Random.seed!(911)

    theta = [-0.3, 2.0, -2.0, -0.75, 0.5]
    @test 0.5 == theta_drill_ρ(TestDrillModel(), theta)

    data = DataDrill(
        TestDrillModel(), theta;
        minmaxleases=1:1,
        num_i=100, nper_initial=10:40, nper_development=10:40,
        num_zt=200, tstart=1:50
    )

    sim = SimulationDraws(100, data)
    println("number of periods is $(length(_y(data)))")

    grad = zeros(length(theta))
    hess = zeros(length(theta),length(theta))
    dtv = DrillingTmpVars(data)

    # fill!(grad, 0)
    # update!(sim, theta_drill_ρ(_model(data), theta))
    # @code_warntype simloglik_drill_unit!(grad, data[1], theta, view(sim, 1), true)
    # simloglik_drill_unit!(grad, data[3], theta, view(sim, 3), false)
    LL1 = simloglik_drill_data!(grad, hess, data, theta, sim, true)
    LL2 = simloglik_drill_data!(grad, hess, data, theta, sim, false)
    @test isfinite(LL1)
    @test isfinite(LL2)
    @test LL1 ≈ LL2

    # check that we don't update gradient here
    simloglik_drill_data!(grad, hess, data, theta, sim, true)
    gradcopy = copy(grad)
    simloglik_drill_data!(grad, hess, data, theta.*2, sim, false)
    @test all(grad .== gradcopy)

    # @testset "warntypes for drilling" begin
    #     unit = data[1]
    #     lease = unit[InitialDrilling()][1]
    #     simi = view(sim, 1)
    #     @code_warntype loglik_drill_lease!(  grad, lease, theta, simi[1], dtv[threadid()], true)
    #     @code_warntype loglik_drill_unit!(   grad, data[1], theta, simi[1], dtv[threadid()], true)
    #     @code_warntype simloglik_drill_unit!(grad, unit, theta, simi, true)
    # end

    # check finite difference
    @testset "check finite difference" begin
        let theta = theta.*0.5
            fdgrad = Calculus.gradient(x -> simloglik_drill_data!(grad, hess, data, x, sim, false), theta)
            fill!(grad, 0)
            simloglik_drill_data!(grad, hess, data, theta, sim, true)
            @test grad ≈ fdgrad
            @test !(grad ≈ zeros(length(grad)))
        end
    end

    let k = length(theta), hess = zeros(k,k)
        # @show @benchmark simloglik_drill_data!($grad, $hess, $data, $theta, $sim, false, false)
        # @show @benchmark simloglik_drill_data!($grad, $hess, $data, $theta, $sim, true, false)
        if DOBTIME
            print("")
            @show @benchmark simloglik_drill_data!($grad, $hess, $data, $theta, $sim, true, true)
            print("")
        end
    end

    println("initial tests done")

    @testset "drilling likelihood optimization" begin

        k = length(theta)

        function f(x)
            update!(sim, theta_drill_ρ(_model(data), x))
            LL = simloglik_drill_data!(zeros(k), zeros(k,k), data, x, sim, false, false)
            return -LL
        end

        function fg!(grad, x)
            tmphess = zeros(k,k)
            fill!(grad, 0)
            update!(sim, theta_drill_ρ(_model(data), x))
            LL = simloglik_drill_data!(grad, tmphess, data, x, sim, true, false)
            grad .*= -1
            return -LL
        end

        function h!(hess, x)
            grad = zeros(k)
            checksquare(hess) == length(x) || throw(DimensionMismatch())
            update!(sim, theta_drill_ρ(_model(data), x))
            LL = simloglik_drill_data!(grad, hess, data, x, sim, true, true)
            grad .*= -1
            return -LL
        end

        function invH0(x::AbstractVector)
            grad = zeros(k)
            hess = zeros(k,k)
            simloglik_drill_data!(grad, hess, data, x, sim, true, true)
            return inv(hess)
        end

        println("getting ready to optmize")
        odfg  = OnceDifferentiable(f, fg!, fg!, theta)
        tdfgh = TwiceDifferentiable(f, fg!, fg!, h!, theta)
        res = optimize(tdfgh, theta*0.5, BFGS(;initial_invH = invH0), Optim.Options(allow_f_increases=true, show_trace=true))
        @show res
        @show minimizer(res), theta

        vcovinv = invH0(res.minimizer)
        se = sqrt.(diag(vcovinv))
        tstats = minimizer(res) ./ se
        pvals = cdf.(Normal(), -2*abs.(tstats))
        coef_and_se = hcat(theta, minimizer(res), se, tstats, pvals)

        err = theta .- res.minimizer
        waldtest = err'*vcovinv*err
        @test ccdf(Chisq(length(theta)), waldtest) > 0.05
        @show coef_and_se

        rhohat = last(minimizer(res))
        rho_se = last(se)
        rho_t = (rhohat - last(theta)) / rho_se
        rho_p = ccdf(Normal(), -2*abs(rho_t))
        @show rhohat, last(theta), rho_t, rho_p

        # Base.showarray(stdout, coef_and_se)
    end

end # testset
end # module


module Archimedes

using LinearAlgebra
using Statistics

using Unitful
using Luxor

const _current_luxor_drawing = Ref{Luxor.Drawing}()

export Point2D,
       PointMass,
       mass,
       getx,
       gety,
       radius,
       bbox,
       centroid,
       gravitycenter,
       draw,
       drawing,
       current_drawing,
       BoxShip,
       corners,
       labeled_point,
       buoyancycenter,
       toship,
       isocarene,
       metacenter,
       setopacity,
       puttext

struct Point2D
    x::typeof(1.0u"m")
    y::typeof(1.0u"m")
end
getx(p::Point2D) = p.x
gety(p::Point2D) = p.y
Base.:-(a::Point2D, b::Point2D) = Point2D(a.x-b.x, a.y-b.y)
Base.:+(a::Point2D, b::Point2D) = Point2D(a.x+b.x, a.y+b.y)
Base.:*(a::Point2D, b::Number) = Point2D(a.x*b, a.y*b)
Base.:*(b::Number, a::Point2D) = Point2D(a.x*b, a.y*b)
Base.:/(a::Point2D, b::Number) = Point2D(a.x/b, a.y/b)
LinearAlgebra.norm(a::Point2D) = sqrt(a.x^2 + a.y^2)

struct PointMass
    coordinates::Point2D
    mass::typeof(1.0u"kg")
    radius::typeof(1.0u"m")
end
PointMass(x,y,m,r) = PointMass(Point2D(x,y),m,r)
coords(p::PointMass) = p.coordinates
mass(p::PointMass) = p.mass
getx(p::PointMass) = getx(coords(p))
gety(p::PointMass) = gety(coords(p))
radius(p::PointMass) = p.radius

"""
Get the bounding box (xmin, xmax, ymin, ymax) of an array of pointmasses
"""
bbox(pointmasses) = (extrema(getx.(pointmasses))..., extrema(gety.(pointmasses))...)

"""
Get the centroid of an array of pointmasses
"""
centroid(pointmasses) = Point2D(mean(getx.(pointmasses)), mean(gety.(pointmasses)))

"""
Get the center of gravity
"""
function gravitycenter(pointmasses)
  m = sum(mass.(pointmasses))
  x = sum(getx.(pointmasses) .* mass.(pointmasses)) / m
  y = sum(gety.(pointmasses) .* mass.(pointmasses)) / m
  r = sqrt(sum(radius.(pointmasses) .^ 2))
  return PointMass(x, y, m, r)
end

"""
Helper to map the points with units to pixel-coordinates
"""
struct CoordMapping
  origin::Point2D
  scaling::typeof(1.0/(1.0u"m"))
end

function CoordMapping(width::Number, bbox::Tuple)
  (xmin,xmax,ymin,ymax) = bbox
  center = Point2D(mean((xmin,xmax)), mean((ymin,ymax)))
  scaling = width/(xmax-xmin)
  return CoordMapping(center, scaling)
end

scale(x, mapping::CoordMapping) = x*mapping.scaling

function remap(p, mapping)
  (xoff, yoff) = (getx(mapping.origin), gety(mapping.origin))
  return Luxor.Point(((getx(p)-xoff, -(gety(p)-yoff)).*mapping.scaling)...)
end

"""
Initialize a drawing, returing the point mapping
"""
function drawing(bbox, figwidth=300)
  (xmin,xmax,ymin,ymax) = bbox
  ar = (xmax-xmin)/(ymax-ymin)
  figheight = Int(round(figwidth/ar))
  margin = 30
  bottom_padding = 40
  _current_luxor_drawing[] = Drawing(figwidth+2*margin, figheight+2*margin+bottom_padding, :svg)
  origin()
  background("white")
  return CoordMapping(figwidth, bbox)
end

function puttext(txt, p::Point2D, mapping::CoordMapping)
  sethue("black")
  c = remap(p,mapping)
  text(txt, c, halign=:center, valign=:top)
end

"""
Draws a pointmass into the current context
"""
function draw(p::PointMass, mapping::CoordMapping; hue="black")
  sethue(hue)
  c = remap(p,mapping)
  r = scale(radius(p), mapping)
  circle(c, r, :fill)
  spacing = 5.0
  step = 10.0
  text("x = $(getx(p))", Point(c.x,c.y+r+spacing), halign=:center, valign=:top)
  text("y = $(gety(p))", Point(c.x,c.y+r+spacing+step), halign=:center, valign=:top)
  text("m = $(mass(p))", Point(c.x,c.y+r+spacing+2*step), halign=:center, valign=:top)
end

function draw(p::Point2D, mapping::CoordMapping, r=5.0; hue="black", label="")
  sethue(hue)
  c = remap(p,mapping)
  circle(c, r, :fill)
  if label != ""
    text(label, Point(c.x+1.2*r,c.y+1.2*r), halign=:center, valign=:top)
  end
end

"""
Shows the drawing and removes the temp file
"""
function current_drawing()
  finish()
  return _current_luxor_drawing[]
end

struct BoxShip
  width::typeof(1.0u"m")
  height::typeof(1.0u"m")
  draft::typeof(1.0u"m")
  KG::typeof(1.0u"m")
  heel::Float64
  vshift::typeof(1.0u"m")

  BoxShip(width, height, draft, KG, heel=0.0, vshift=0.0u"m") = new(width,height,draft,KG,heel,vshift)
end

forward_trans(p, s::BoxShip) = Point2D(cos(s.heel)*getx(p) - sin(s.heel)*gety(p),  sin(s.heel)*getx(p) + cos(s.heel)*gety(p) + s.vshift)
inverse_trans(p, s::BoxShip) = Point2D(cos(s.heel)*getx(p) + sin(s.heel)*(gety(p) - s.vshift), -sin(s.heel)*getx(p) + cos(s.heel)*(gety(p) - s.vshift))

"""
Convert position p to ship coordinates
"""
toship(p, s) = inverse_trans(p, s) - Point2D(0.0u"m", s.height/2 - s.draft)

function corners(s::BoxShip)
  x = s.width/2
  ymax = s.height-s.draft
  ymin = -s.draft
  return forward_trans.(Point2D.([-x,x,x,-x], [ymin,ymin,ymax,ymax]), Ref(s))
end

function waterline(s::BoxShip)
  x = 1.4*s.width/2
  y = 0.0u"m"
  return (Point2D(-x,y), Point2D(x,y))
end

function gravitycenter(s::BoxShip)
  return forward_trans(Point2D(0.0u"m", s.KG-s.draft), s)
end

bbox(s::BoxShip) = 1.4 .* (-s.width/2, s.width/2, -s.draft, s.height-s.draft)

function wl_intersect(p1, p2)
  x1 = getx(p1)
  y1 = gety(p1)
  x2 = getx(p2)
  y2 = gety(p2)
  r = (x2-x1)/(y2-y1)
  return Point2D(-y1*r+x1, 0.0u"m")
end

"""
Corners of the underwater part
"""
function carene(s::BoxShip)
  ship_pts = corners(s)
  N = length(ship_pts)
  pts_above = collect(Iterators.filter((p) -> gety(p[2]) > 0u"m", enumerate(ship_pts)))
  sort!(pts_above, lt = (a,b) -> getx(a[2]) < getx(b[2]))
  l1 = pts_above[1][1]
  l2 = l1 % N + 1
  wl_left = wl_intersect(ship_pts[l1], ship_pts[l2])
  r1 = pts_above[end][1]
  r2 = (r1 - 2 + N) % N + 1
  wl_right = wl_intersect(ship_pts[r1], ship_pts[r2])
  pts_below = collect(Iterators.filter((p) -> gety(p[2]) < 0u"m", enumerate(ship_pts)))
  sort!(pts_below, lt = (a,b) -> getx(a[2]) < getx(b[2]))
  return (getindex.(pts_below, 2)..., wl_right, wl_left)
end

function metacenter(s::BoxShip)
  trap = carene(s)
  w_wl = getx(trap[end-1]) - getx(trap[end])
  F = inverse_trans(Point2D((getx(trap[end-1]) + getx(trap[end]))/2, 0.0u"m"),s)
  BM = (w_wl^3 / 12)/carene_area(s)
  B = inverse_trans(buoyancycenter(s),s)
  nvec = F - B
  Mship = B + Point2D(BM*sin(s.heel), BM*cos(s.heel))
  return forward_trans(Mship, s)
end

"""
Make a 3-vector out of a Point2D
"""
vec3(p::Point2D) = [getx(p), gety(p), 0.0u"m"]

"""
Area of a triangle
"""
function area(pts)
  v = vec3.(pts)
  return abs(cross(v[3]-v[1], v[2]-v[1])[3])/2
end

function triangulate(pts::Union{AbstractArray{ET},NTuple{N,ET} where N}) where ET
  c = centroid(pts)
  triags = Array{NTuple{3,ET}}(undef,length(pts))
  N = length(pts)
  for i in 1:length(pts)
    triags[i] = (c, pts[i], pts[i%N+1])
  end
  return triags
end

function buoyancycenter(s::BoxShip)
  trap = carene(s)
  triags = triangulate(trap)
  areas = area.(triags)
  centroids = centroid.(triags)
  A = sum(areas)
  x = sum(getx.(centroids) .* areas) / A
  y = sum(gety.(centroids) .* areas) / A
  return Point2D(x,y)
end

function carene_area(s::BoxShip)
  trap = carene(s)
  triags = triangulate(trap)
  return sum(area.(triags))
end

function isocarene(s0, θ)
  θ0 = s0.heel
  T = s0.draft
  DT_l = -T
  DT_u = T
  A0 = carene_area(s0)
  for i in 1:50
    DT = (DT_u+DT_l)/2
    s1 = BoxShip(s0.width, s0.height, T, s0.KG, θ+θ0, DT)
    A1 = carene_area(s1)
    if abs(A1-A0)/A0 < 1e-8
      return s1
    end

    if A1 < A0
      DT_u = DT
    else
      DT_l = DT
    end
  end
  error("isocarene did not converge")
end

function labeled_point(p, label, hue="black", radius=5.0)
  sethue(hue)
  circle(p, radius, :fill)
  text(label, Point(p.x+1.2*radius,p.y+1.2*radius), halign=:center, valign=:top)
end

function draw(m::CoordMapping, s::BoxShip, transformation=((p,::BoxShip) -> p); showM=true, showB=true)
  ship_pts = transformation.(corners(s),Ref(s))
  p = remap.(ship_pts, Ref(m))
  sethue("black")
  line(p[1], p[2], :stroke)
  line(p[2], p[3], :stroke)
  line(p[4], p[1], :stroke)
  sethue("darkgrey")
  line(p[3], p[4], :stroke)
  labeled_point(remap(transformation(gravitycenter(s),s),m), "G")
  if showM || showB
    M = remap(transformation(metacenter(s),s),m)
    B = remap(transformation(buoyancycenter(s),s),m)
    if showM
      labeled_point(M, "M")
    end
    if showB
      labeled_point(B, "B", "red")
    end
    if showM && showB
      setdash("dot")
      line(M, B, :stroke)
      setdash("solid")
    end
  end
  wl = remap.(transformation.(waterline(s),Ref(s)), Ref(m))
  sethue("blue")
  line(wl[1], wl[2], :stroke)
  #trap = carene(s)
  #F = remap(transformation(Point2D((getx(trap[end-1]) + getx(trap[end]))/2, 0.0u"m"),s),m)
  #labeled_point(F, "F", "blue")
  return m
end

function draw(s::BoxShip, figwidth=300, transformation=((p,::BoxShip) -> p); showM=true, showB=true)
  draw(drawing(bbox(s), figwidth), s, transformation, showM=showM, showB=showB)
end

setopacity = Luxor.setopacity

end # module


using SantasLittleHelpers
using Test
using Statistics, StatsBase, Dates, DataFrames

@testset "Simple Functions" begin
    x = rand(100)
    @test loggrowth(x)[end] ≈ 100*diff(log.(x))[end]
    @test autocorrelate(x) ≈ first(autocor(x,[1]))
    @test autocorrelate(abs,x) ≈ first(autocor(abs.(x),[1]))
    @test logdiff(x[1:4]) ≈ log(x[4])-log(x[1])

    @test monthtoquarter(12) == 4
    @test yrqtrfun(Date(2018,1,1)) == "2018Q1"

    @test simiterator(10,3)[end] == 4
    @test perioditerator(10,3)[end] == 1
end

@testset "Harder Functions" begin
    x = rand(100)

    varx = var(x)
    x2 = [sum(x[i-1:i]) for i in 2:100]
    testvr2 = var(x2) / (2*varx)

    @test varianceratio(x,1) == 1
    @test varianceratio(x,2) ≈ vr2(x)
    @test vr2(x) ≈ testvr2

    @test applyrolling(sum,x,-1:0,missing)[end] ≈ x2[end]
    @test applyrolling(makekernel(sum,-1:0),x,missing)[end] ≈ x2[end]
end

@testset "DataFrames" begin
    df = DataFrame(x=[1,2,NaN,3],y=[NaN,2,3,4])
    nantomissing!(df,:x)
    @test ismissing(df.x[3])
    nantomissing!(df)
    @test ismissing(df.y[1])
end


maxval = 1.0  # maximum absolute value of perturbations

# Large eddy size (m).
# Above this scale, the spectrum is
# white.  If you don't want to use
# this, make it larger than
# max(ni,nj)*dx.
large_eddy_scale = 1000000000.0

function ring_filter(Nx, Ny, Δx, Δy, L₁)
    # center point indices
    i_c = Nx/2 + 1
    j_c = Ny/2 + 1

    # Compute wavenumbers
    κ = zeros(Nx, Ny)
    for j in 1:Ny, i in 1:Nx
        κ[i, j] = √( (2π*(i-i_c) / (Nx*Δx))^2 + (2π*(j-j_c) / (Ny*Δy))^2 )
    end

    # Generate spectrum
    A = 1
    c = zeros(ComplexF64, Nx, Ny)
    for j in 1:Ny, i in 1:Nx
        r1 = rand()
        r2 = rand()
        c[i, j] = A * exp(-2π*im*Nx*r1) * exp(-2π*im*Ny*r2)
    end

    i_min = j_min = 0
    v_min = Inf
    for j in 1:Ny, i in 1:Nx
        val = abs(κ[i, j] - 2π/L₁)
        if val < v_min
            v_min = val
            i_min = i
            j_min = j
        end
    end

    threshold = max(
        abs(κ[i_min, j_min+1] - 2π/L₁),
        abs(κ[i_min, j_min-1] - 2π/L₁),
        abs(κ[i_min+1, j_min] - 2π/L₁),
        abs(κ[i_min-1, j_min] - 2π/L₁)
    )

    for j in 1:Ny, i in 1:Nx
        if abs(κ[i, j] - 2π/L₁) > threshold
            c[i, j] = 0
        end
    end

    spectrum_2d = copy(c)

    c = circshift(c, (Nx/2, Ny/2))
    KE = ifft(c)
    c = circshift(fft(KE), (Nx/2, Ny/2))

    Nk = min(Nx, Ny)
    sp = zeros(Nk)
    np = zeros(Nk)

    for j in 1:Ny, i in 1:Nx
        if Nx > Ny
            ik = √( ((i-i_c)*Ny/Nx)^2 + (j-j_c)^2 )
            ik = round(Int, ik)
        elseif Ny > Nx
            ik = √( (i-i_c)^2 + ((j-j_c)*Nx/Ny)^2 )
            ik = round(Int, ik)
        else
            ik = √( (i-i_c)^2 + (j-j_c)^2 )
            ik = round(Int, ik)
        end

        if ik > 0 && ik < Nk/2
            sp[ik] += abs(ccc[i, j])^2
            np[ik] += 1
        end
    end

    spectrum_1d = copy(sp)

    return abs2.(KE), spectrum_2d, spectrum_1d
end

Nx = Ny = 192
Δx = Δy = 125
L₁ = 1000

x = range(0, Nx*Δx, length=Nx)
y = range(0, Ny*Δy, length=Ny)

KE, s2, s1 = ring_filter(Nx, Ny, Δx, Δy, L₁)

l = @layout [
    a{0.7w} [b{0.5h}
             c{0.5h}]
]

pert_plot = contourf(x/1000, y/1000, KE, color=:dense, linewidth=0, xticks=0:4:24, xlabel="x (km)", yticks=0:4:24, ylabel="y (km)", title="Perturbation field", colorbar=nothing)
s2_plot = contourf(abs2.(s2), color=:dense, linewidth=0, xticks=[], yticks=[], colorbar=nothing, framestyle=:box, title="2D spectrum", xlabel="kx", ylabel="ky")
s1_plot = plot(log10.(s1), linewidth=2, label="", xlims=(0, 96), xticks=[], yticks=[], xlabel="k", ylabel="log E(k)", title="1D spectrum")
plot(pert_plot, s2_plot, s1_plot, layout=l)

Nx = Ny = 192
Δx = Δy = 1/192
L₁ = 0.3

x = range(0, Nx*Δx, length=Nx)
y = range(0, Ny*Δy, length=Ny)

KE, s2, s1 = ring_filter(Nx, Ny, Δx, Δy, L₁)

l = @layout [
    a{0.7w} [b{0.5h}
             c{0.5h}]
]

pert_plot = contourf(x, y, KE, color=:dense, linewidth=0, xlabel="x", ylabel="y", title="Perturbation field", colorbar=nothing)
s2_plot = contourf(abs2.(s2), color=:dense, linewidth=0, xticks=[], yticks=[], colorbar=nothing, framestyle=:box, title="2D spectrum", xlabel="kx", ylabel="ky")
s1_plot = plot(log10.(s1), linewidth=2, label="", xlims=(0, 96), xticks=[], yticks=[], xlabel="k", ylabel="log E(k)", title="1D spectrum")
plot(pert_plot, s2_plot, s1_plot, layout=l)


my_fun(x, y) = 2*x+ 3*y

der_my_fun(x, y) = ForwardDiff.derivative(x -> my_fun(x, y), x )


struct RPMS{AT} <: IRMeasurement
    sig::AT
    prepad::Int
    gain::Float64
end

"""
    rpms(samples; options...)

Generate periodic noise using the random phase multisine medhod [1], by starting
with a flat spectrum and randomizing the phases. Note that this is,
nondeterministic, so make sure you use the same measurement instance to generate
and analyze your stimulus.

## Options
$optiondoc_gain
$optiondoc_prepad

[1]: Mateljan, I., Signal selection for the room acoustics measurement, 1999,
IEEE Workshop on Applications of Signal Processing to Audio and Acoustics,
pp. 199–202.
"""
function rpms(L; prepad=L, gain=rpms_gain)
    N = L÷2+1
    X = ones(ComplexF64, N)
    # set phases to be uniform random in [0,2π]
    @. X *= exp(im*2π*rand())
    # DC component should be zero
    X[1] = 0.0
    if iseven(L)
        # Nyquist component should be real (it needs to equal its complex
        # conjugate)
        X[N] = 1.0
    end
    x = irfft(X, L) * sqrt(L)
    RPMS(x, prepad, gain)
end

# TODO: add trials support
stimulus(s::RPMS) = [zeros(s.prepad); s.sig * s.gain; zeros(length(s.sig))]
prepadding(s::RPMS) = s.prepad

function _analyze(s::RPMS, response::AbstractArray)
    mapslices(response, dims=1) do v
        xcorr(v[s.prepad+1:end], s.sig, padmode=:longest)[end÷2+1:end] / length(s.sig) / s.gain
    end
end


Maybe{T} = Union{T, Nothing}

# Convert grayscale array to binary saving porosity of the original
threshold(array :: AbstractArray{<: AbstractFloat}, porosity :: AbstractFloat) =
    array .> quantile(reshape(array, length(array)), porosity)

initial_guess(size, p :: AbstractFloat) =
    threshold(rand(Float64, size), p)

function porosity(s2ft :: AbstractArray{<: AbstractFloat}, size)
    s2 = irfft(s2ft, size[1]) / reduce(*, size)
    return 1 - s2[1]
end

"""
    two_point(array)

Calculate unnormalized two-point correlation function for array of
booleans. The result can be used in [`phaserec`](@ref) function.
"""
two_point(array :: AbstractArray{Bool}) = array |> rfft .|> abs2

# This is the core of PhaseRec algorithm.
#
# This function takes an array and replaces absolute value of its FFT
# with content of s2ft and then does inverse FFT.
function replace_abs(array   :: AbstractArray{Bool, N},
                     s2ft    :: AbstractArray{R, N}) where {R <: AbstractFloat, N}
    ft = rfft(array)
    repft = @. ft * sqrt(s2ft) / abs(ft)

    return replace(x -> isnan(x) ? 0 : x, repft)
end

# Make Gaussian low-pass filter
function make_filter(size, σ)
    array = zeros(Float64, size)
    # Filter width
    l = 4ceil(Int, σ) + 1
    w = l >> 1

    uidx = array |> CartesianIndices |> first |> oneunit
    for offset in -w*uidx:w*uidx
        k = Tuple(offset)
        idx = (mod(k + s, s) + 1 for (k, s) in zip(k, size)) |>
            Tuple |> CartesianIndex

        array[idx] = exp(-sum(k^2 for k in k)/(2σ^2))
    end

    return rfft(array ./ sum(array))
end

"""
    phaserec(s2ft, size; radius = 0.6, maxstep = 300, ϵ = 10^-5[, noise])

Reconstruct an image from the two-point correlation function. `s2ft`
is unnormalized two-point correlation function in frequency domain and
`size` are dimensions of the original image. Optional parameter
`radius` governs noise filtration. `maxsteps` is a maximal number of
iterations. Smaller `ϵ` usually produces better results, but default
value should be OK for all cases. `noise` is an optional array of
booleans which contains initial approximation.

# References
1. A. Cherkasov, A. Ananev, Adaptive phase-retrieval stochastic
   reconstruction with correlation functions: Three-dimensional images
   from two-dimensional cuts, Phys. Rev. E, 104, 3, 2021

See also: [`two_point`](@ref).
"""
function phaserec(s2ft  :: AbstractArray{<: AbstractFloat}, size;
                  radius   = 0.6,
                  maxsteps = 300,
                  ϵ        = 10^-5,
                  noise :: Maybe{AbstractArray{Bool}} = nothing)
    p = porosity(s2ft, size)
    @assert 0 < p < 1

    # Make initial guess for the reconstruction
    recon  = isnothing(noise) ? initial_guess(size, p) : noise
    # Make Gaussian low-pass filter
    filter = make_filter(size, radius)
    # Cost function based on S₂ map
    normfn(corr, rec) = norm((corr - two_point(rec))/length(corr))
    initnorm = normfn(s2ft, recon)
    oldn = 1.0

    for steps in 1:maxsteps
        # Restore S₂ function
        gray = replace_abs(recon, s2ft)
        # Apply low-pass filter
        gray = filter .* gray
        # Convert to two-phase image
        recon = threshold(irfft(gray, size[1]), p)

        n = normfn(s2ft, recon) / initnorm

        if (rem(steps, 10) == 1)
            @info "Cost = $(n)"
        end

        if oldn - n < ϵ || n > oldn
            break
        end

        oldn = n
    end

    return recon, normfn(s2ft, recon) / initnorm
end

"""
    phaserec(array; radius = 0.6, maxsteps = 300, ϵ = 10^-5[, noise])

Reconstruct `array` which must be an array of booleans. This is
equivalent to running `phaserec(two_point(array), size(array); ...)`.
"""
phaserec(array :: AbstractArray{Bool};
         radius   = 0.6,
         maxsteps = 300,
         ϵ        = 10^-5,
         noise    = nothing) =
    phaserec(two_point(array), size(array);
             radius   = radius,
             maxsteps = maxsteps,
             ϵ        = ϵ,
             noise    = noise)


# The model is the same Rijke tube configuration as in Tutorial 01. However,
# this time the FTF is customly defined. Let's start with the definition of the
# flame transfer function. The custom function must return the FTF and all its
# derivatives w.r.t. the complex freqeuncy. Therefore, the interface **must** be
# a function with two inputs: a complex number and an integer. For an n-τ-model
# it reads.
function FTF(ω::ComplexF64, k::Int=0)
    return n*(-1.0im*τ)^k*exp(-1.0im*ω*τ)
end
# Note, that I haven't defined `n` and `τ` here, but Julia is a quite generous
# programming language; it won't complain if we define them before making our
# first call to the function.

# Of course, it is sometimes hard to find a closed form expression for an FTF
# and all its derivatives. You need to specify at least these derivative orders
# that will be used by the methods applied to analyse the model. This is at
# least the first order derivative for beyn and the standard householder method.
# You might return derivative orders up to the order you need it using an if
# clause for each order. Anyway, the function may get complicated. The implicit
# method explained below is then a viable alternative.

# Now let's set-up the Rijke tube model. The data is the same as in tutorial 1
using WavesAndEigenvalues.Helmholtz
mesh=Mesh("Rijke_mm.msh",scale=0.001) #load mesh
dscrp=Dict() #initialize model descriptor
dscrp["Interior"]=(:interior, ()) #define resonant cavity
dscrp["Outlet"]=(:admittance, (:Y,1E15)) #specify outlet BC
γ=1.4 #ratio of specific heats
ρ=1.225 #density at the reference location upstream to the flame in kg/m^3
Tu=300.0    #K unburnt gas temperature
Tb=1200.0    #K burnt gas temperature
P0=101325.0 # ambient pressure in Pa
A=pi*0.025^2 # cross sectional area of the tube
Q02U0=P0*(Tb/Tu-1)*A*γ/(γ-1) #the ratio of mean heat release to mean velocity Q02U0
x_ref=[0.0; 0.0; -0.00101] #reference point
n_ref=[0.0; 0.0; 1.00] #directional unit vector of reference velocity
R=287.05 # J/(kg*K) specific gas constant (air)
speedofsound(x,y,z) = z<0. ? sqrt(γ*R*Tu) : sqrt(γ*R*Tb)
c=generate_field(mesh,speedofsound)
# btw this is the moment where we specify the values of n and τ
n=1 #interaction index
τ=0.001 #time delay

##
# but instead of passing n and τ and its values to the flame description we
# just pass the FTF
dscrp["Flame"]=(:flame,(γ,ρ,Q02U0,x_ref,n_ref,FTF)) #flame dynamics

#... discretize ...
L=discretize(mesh,dscrp,c)
# and done!
## Check the model
print(L)
# Independently of how you name it, your FTF will be displayed as `FTF`
# in the signature of the operator.

##
# Solving the problem shows that we get the same result as with the built-in
# n-τ-model in tutorial 1
sol,nn,flag=householder(L,340*2*pi,maxiter=20,tol=1E-11)
## changing the parameters
# Because the system parameters n and τ are defined in this outer scope,
# changing them will change the FTF and thus the model without rediscretization.
# For instance, you can completely deactivate the FTF by setting n to 0.
n=0
# Indeed the model now converges to purely acoustic mode
sol,nn,flag=householder(L,340*2*pi,maxiter=20,tol=1E-11)

# However, be aware that there is currently no mechanism keeping track of these
# parameters. It is the programmer's (that's you) responsibility to know the
# specification of the FTF when `sol` was computed.

# Also, note the parameters are defined in this scope. You cannot change it by
# iterating it in a for-loop or from within a function, due to julia's scoping
# rules.

## Something else than n-τ...
# Of course this is an academic example. In practice you will specify
# something very custom as FTF. Maybe a superposition of σ-τ-models or even
# a statespace model fitted to experimental data.

##TODO: , vectorfit
#implicit FTF modelling as in Silva et al ASME2020
dscrp["Flame"]=(:flame,(γ,ρ,Q02U0,x_ref,n_ref)) #no flame dynamics specified at all
H=discretize(mesh,dscrp,c)
sol_base,nn,flag=householder(H,340*2*pi,maxiter=20,tol=1E-11)
perturb_fast!(sol_base,H,:FTF,30)
## Newton-Raphson for finding flame response
ω0=sol_base.params[:ω]
ω(f,k=0)=sol(:FTF,f,15,15)

n=1.0
η0=0
for i=1:40
    Δη=η0-(FTF(ω(η0))-η0)/FTF(ω(η0,1))
    println(Δη)
end