resistor-cube-0.0.1: src/Main.hs

{- |
Consider a cube of resistors of equal resistance.
What is the overall resistance from one corner to the opposite one?
-}
{-# LANGUAGE TypeOperators #-}
module Main where

import qualified Numeric.LAPACK.Matrix.Shape as MatrixShape
import qualified Numeric.LAPACK.Matrix.Triangular as Triangular
import qualified Numeric.LAPACK.Matrix as Matrix
import qualified Numeric.LAPACK.Vector as Vector
import Numeric.LAPACK.Format ((##))

import qualified Data.Array.Comfort.Storable as Array
import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Storable ((!))
import Data.Array.Comfort.Shape ((:+:)((:+:)))


data Coord = C0 | C1 deriving (Eq, Ord, Show, Enum, Bounded)
data Dim = D0 | D1 | D2 deriving (Eq, Ord, Show, Enum, Bounded)
type Corner = (Coord,Coord,Coord)
type Edge = (Dim,Coord,Coord)

type ShapeEnum = Shape.Enumeration
type CornerShape = (ShapeEnum Coord, ShapeEnum Coord, ShapeEnum Coord)
type EdgeShape = (ShapeEnum Dim, ShapeEnum Coord, ShapeEnum Coord)

type Matrix height width = Matrix.General height width


cornerShape :: CornerShape
cornerShape = (Shape.Enumeration, Shape.Enumeration, Shape.Enumeration)

edgeShape :: EdgeShape
edgeShape = (Shape.Enumeration, Shape.Enumeration, Shape.Enumeration)


{-
We also need a currentMatrix that implements Kirchhoff's current law
but it turns out to equal 'transpose voltageMatrix'.
This makes fullMatrix symmetric.
-}
voltageMatrix :: Matrix EdgeShape CornerShape Double
voltageMatrix =
   Matrix.fromRowMajor $
   Array.sample
      (edgeShape, cornerShape)
      (\((ed,ex,ey), c) ->
         let ((cx, cy), cz) = selectCornerCoords ed c
         in  if ex==cx && ey==cy
               then
                  case cz of
                     C0 ->  1
                     C1 -> -1
               else 0)


selectCornerCoords :: Dim -> Corner -> ((Coord, Coord), Coord)
selectCornerCoords ed (cx,cy,cz) =
   case ed of
      D0 -> ((cy, cz), cx)
      D1 -> ((cx, cz), cy)
      D2 -> ((cx, cy), cz)

sourceCorner, destCorner :: Corner
sourceCorner = (C0,C0,C0)
destCorner = (C1,C1,C1)

resistances :: Vector.Vector EdgeShape Double
resistances = Vector.constant edgeShape 1


fullMatrix :: Triangular.Symmetric (():+:(EdgeShape:+:CornerShape)) Double
fullMatrix =
   Triangular.stackSymmetric
      (Triangular.symmetricFromList MatrixShape.RowMajor () [0])
      (Matrix.singleRow MatrixShape.RowMajor $
         Vector.unit (edgeShape:+:cornerShape) (Right sourceCorner)) $
   Triangular.stackSymmetric
      (Triangular.diagonal MatrixShape.RowMajor resistances)
      voltageMatrix
      (Vector.constant
         (MatrixShape.symmetric MatrixShape.RowMajor cornerShape) 0)


main :: IO ()
main = do
   fullMatrix ## "%2.f"
   let solutionVec =
         Matrix.unliftColumn MatrixShape.ColumnMajor
            (Triangular.solve fullMatrix) $
         Vector.unit (():+:(edgeShape:+:cornerShape)) (Right (Right destCorner))
   print $ - solutionVec ! Right (Right destCorner)

{-
result: total resistance is 5/(2+2+2)
-}