From: Julien Moutinho Date: Mon, 13 Jan 2025 18:45:33 +0000 (+0100) Subject: init X-Git-Url: https://git.sourcephile.fr/haskell/mpms.git/commitdiff_plain?ds=sidebyside init --- 53946443a9270d87c6de11afc59e67f27e97652e diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..bb3d4b9 --- /dev/null +++ b/.gitignore @@ -0,0 +1,19 @@ +*.actual.* +*.eventlog +*.eventlog.html +*.eventlog.json +*.hi +*.hp +*.o +*.orig +*.prof +*.root +.direnv/ +.ghc.environment.* +.stack-work/ +dist/ +dist-newstyle/ +dump-core/ +hlint.html +result* +.pre-commit-config.yaml diff --git a/Main.hs b/Main.hs new file mode 100755 index 0000000..eac855e --- /dev/null +++ b/Main.hs @@ -0,0 +1,203 @@ +#!/usr/bin/env -S nix -L shell .#ghc --command runghc +-- #!/usr/bin/env -S nix -L shell .#ghc .#ghcid --command ghcid --test :main +-- SPDX-FileCopyrightText: 2022 Julien Mouyinho +-- SPDX-License-Identifier: CC0-1.0 +{-# OPTIONS_GHC -Wno-missing-signatures #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main where + +-- import Blaze.ByteString.Builder (Builder) +import Data.ByteString qualified as BS +import Relude +import System.IO qualified as IO +import Text.Blaze +import qualified Text.Blaze.Html5 as H +import qualified Text.Blaze.Html5.Attributes as HA +import qualified Text.Blaze.Renderer.Utf8 as Blaze +import Data.List ((\\)) +import Data.List qualified as List + +data I = D | M | C | Y + deriving (Eq, Ord, Show) +data Cell = I I | H I + deriving (Eq, Ord, Show) + +mpms4 :: a -> a -> a -> a -> a -> a -> a -> a -> [[a]] +mpms4 iD iM iC iY hD hM hC hY = + [ [iD, iM, iC, iY] + , [iC, iY, iD, iM] + , [hC, hY, hD, hM] + , [hD, hM, hC, hY] + ] + +isValid :: [Cell] -> Bool +isValid [I D, I M, I C, I Y] = True +isValid [H D, H M, H C, H Y] = True +isValid [I a, I b, H aa, H bb] | a == aa && b == bb = True +isValid _ = False + +squary :: [[((Integer, Integer), Cell)]] +squary = + zipWith (\r -> zipWith (\c -> ((r,c),)) [0..]) [0..] $ + mpms4 (I D) (I M) (I C) (I Y) (H D) (H M) (H C) (H Y) +allPaths = combins 4 (concat squary) +validPaths = filter (isValid . sort . (snd <$>)) $ allPaths +validSortedPaths = sortBy (compare `on` (snd <$>)) validPaths +validSortedCoords = sort $ (fst <$>) <$> validPaths + +mostPerfectMagicSquare4 :: Fractional a => a -> a -> a -> a -> [[a]] +mostPerfectMagicSquare4 d m c y = mpms4 d m c y (h d) (h m) (h c) (h y) + where h x = ((d + m + c + y) / 2) - x + +square :: [[Int]] +square = (round @Rational <$>) <$> mostPerfectMagicSquare4 24 03 19 74 + +pathsByCombin :: [[[(Integer, Integer)]]] +pathsByCombin = + [ [ [ (0,c) | c <- [0..3] ] ] + , [ [(0,c0), (0,c1), (0,c2), (1,c3)] + | [c0, c1, c2] <- combins 3 [0..3] + , let c3 = (List.head ([0..3] \\ [c0, c1, c2]) - 2) `mod` 4 + ] + , [ [(0,c0), (0,c1), (1,c2), (1,c3)] + | [c0, c1] <- combins 2 [0..3] + , let [c2, c3] = ([0..3] \\ [c0, c1]) <&> (\c -> (c - 2) `mod` 4) + ] + , [ [(0,c0), (0,c1), (2,c2), (2,c3)] + | [c0, c1] <- combins 2 [0..3] + , let [c2, c3] = [c0, c1] <&> (\c -> (c - 2) `mod` 4) + ] + , [ [(0,c0), (0,c1), (3,c2), (3,c3)] + | [c0, c1] <- combins 2 [0..3] + , let [c2, c3] = [c0, c1] + ] + , [ [(0,c0), (1,c1), (1,c2), (1,c3)] + | [c0] <- combins 1 [0..3] + , let [c1, c2, c3] = ([0..3] \\ [c0]) <&> (\c -> (c - 2) `mod` 4) + ] + , [ [(0,c0), (1,c1), (2,c2), (2,c3)] + | [c0] <- combins 1 [0..3] + , [c1] <- combins 1 ([0..3] \\ [(c0 + 2) `mod` 4]) + , let [c2, c3] = [(c0 + 2) `mod` 4, c1] + ] + , [ [(0,c0), (1,c1), (2,c2), (3,c3)] + | [c0] <- combins 1 [0..3] + , [c1] <- combins 1 ([0..3] \\ [(c0 + 2) `mod` 4]) + , [c2, c3] <- [[(c0+2)`mod`4, (c1+2)`mod`4], [c1, c0]] + ] + , [ [(0,c0), (1,c1), (3,c2), (3,c3)] + | [c0] <- combins 1 [0..3] + , [c1] <- combins 1 ([0..3] \\ [(c0 + 2) `mod` 4]) + , let [c2, c3] = [c0, (c1+2)`mod`4] + ] + , [ [(1,c0), (1,c1), (1,c2), (1,c3)] + | [c0, c1, c2, c3] <- combins 4 [0..3] + ] + , [ [(1,c0), (1,c1), (2,c2), (2,c3)] + | [c0, c1] <- combins 2 [0..3] + , let [c2, c3] = [c0, c1] + ] + , [ [(1,c0), (1,c1), (2,c2), (3,c3)] + | [c0, c1] <- combins 2 [0..3] + , let [c2, c3] = [c0, (c1 + 2) `mod` 4] + ] + , [ [(1,c0), (1,c1), (3,c2), (3,c3)] + | [c0, c1] <- combins 2 [0..3] + , let [c2, c3] = [(c0 + 2) `mod` 4, (c1 + 2) `mod` 4] + ] + , [ [(2,c0), (2,c1), (2,c2), (2,c3)] + | [c0, c1, c2, c3] <- combins 4 [0..3] + ] + , [ [(2,c0), (2,c1), (2,c2), (3,c3)] + | [c0, c1, c2] <- combins 3 [0..3] + , let [c3] = [0..3] \\ [c0, c1, c2] + ] + , [ [(2,c0), (2,c1), (3,c2), (3,c3)] + | [c0, c1] <- combins 2 [0..3] + , let [c2, c3] = [c0, c1] + ] + , [ [(2,c0), (3,c1), (3,c2), (3,c3)] + | [c0] <- combins 1 [0..3] + , let [c1, c2, c3] = ([0..3] \\ [(c0 + 2) `mod` 4]) + ] + , [ [(3,c0), (3,c1), (3,c2), (3,c3)] + | [c0, c1, c2, c3] <- combins 4 [0..3] + ] + ] +ol :: [b] -> [(Integer, b)] +ol = zip [0..] + +main :: IO () +main = do + IO.withFile "mpms.html" IO.WriteMode $ \h -> + Blaze.renderMarkupToByteStringIO (BS.hPutStr h) do + H.docTypeHtml do + H.head do + H.title "Most-Perfect Magic Square" + H.link ! HA.rel "stylesheet" + ! HA.type_ "text/css" + ! HA.href "mpms.css" + H.body do + H.ul do + H.li $ "#squares = " <> show (length validSortedCoords) + H.li $ "sum = " <> show (sum (List.head square)) + H.div ! HA.class_ "squares" $ do + forM_ validSortedCoords $ \path -> + H.div ! HA.class_ "square" $ do + forM_ (ol square) $ \(rowCoord, row) -> + forM_ (ol row) $ \(colCoord, num) -> + H.span ! HA.class_ ("square-num"<>""<>(if (rowCoord,colCoord) `elem` path then " num-path" else "")) $ + fromString $ show num + +-- | @'nCk' n k@ retourne le nombre de combinaisons +-- de longueur 'k' d’un ensemble de longueur 'n'. +-- +-- Computed using the formula: +-- @'nCk' n (k+1) == 'nCk' n (k-1) * (n-k+1) / k@ +nCk :: Integral i => i -> i -> i +n`nCk`k | n<0||k<0||n, p.26 +combinOfRank :: Integral i => i -> i -> i -> [i] +combinOfRank n k rk | rk<0||n`nCk`k [a] -> [[a]] +combins k xs = combinsK xs List.!! (length xs - k) + +-- | @combinsK xs@ retourne toutes les combinaisons +-- de longueur allant de @length xs@ à 0 de la liste 'xs', +-- +-- Algorithme dynamique permettant un calcul de 'combins' +-- relativement rapide du fait du partage de 'combinsKmoins1'. +combinsK :: [a] -> [[[a]]] +combinsK [] = [[[]]] +combinsK (x : xs) = + zipWith (++) ([] : combinsKmoins1) + (map (map (x :)) combinsKmoins1 ++ [[]]) + where combinsKmoins1 = combinsK xs diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..0871428 --- /dev/null +++ b/flake.lock @@ -0,0 +1,25 @@ +{ + "nodes": { + "nixpkgs": { + "locked": { + "lastModified": 1734323986, + "narHash": "sha256-m/lh6hYMIWDYHCAsn81CDAiXoT3gmxXI9J987W5tZrE=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "394571358ce82dff7411395829aa6a3aad45b907", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "nixpkgs": "nixpkgs" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..24aba64 --- /dev/null +++ b/flake.nix @@ -0,0 +1,95 @@ +# SPDX-FileCopyrightText: 2022 Julien Mouyinho +# SPDX-License-Identifier: CC0-1.0 +{ + description = "Most-Perfect Magic Square"; + inputs = { + nixpkgs.url = "flake:nixpkgs"; + }; + outputs = + inputs: + let + lib = inputs.nixpkgs.lib; + # Helper to build for each system in `lib.systems.flakeExposed`. + perSystem = + f: + lib.genAttrs lib.systems.flakeExposed ( + system: + f rec { + inherit system; + pkgs = import inputs.nixpkgs { inherit system; }; + haskellPackages = pkgs.haskellPackages; + } + ); + in + { + # `nix -L build` + packages = perSystem ( + { pkgs, system, haskellPackages, ... }: + { + # The Glasgow Haskell Compiler (GHC) + # Here made available as `.#ghc` for Main.hs's shebang + ghc = haskellPackages.ghcWithPackages ( + haskellPackages: [ + # Extra Haskell packages available + haskellPackages.blaze-builder + haskellPackages.blaze-html + haskellPackages.blaze-markup + haskellPackages.relude + haskellPackages.text + haskellPackages.transformers + ] + ); + ghcid = pkgs.ghcid; + # A compiled version of `Main.hs` + # (instead of an interpreted one when run as `./Main.hs`) + # To avoid writing a `.cabal` file, `ghc --make` is called directly here, + # but should the script become a full fledge executable, + # a `.cabal` file should be written instead. + default = pkgs.stdenv.mkDerivation { + name = "Main"; + src = ./.; + buildInputs = [ + inputs.self.packages.${system}.ghc + ]; + buildPhase = '' + mkdir -p $out/bin + ghc -o "$out/bin/Main" -O2 --make ./Main.hs + ''; + }; + } + ); + # `nix develop` or `direnv allow` + devShells = perSystem ( + { pkgs, system, ... }: + { + default = pkgs.mkShell { + nativeBuildInputs = [ + inputs.self.packages.${system}.ghc + pkgs.haskellPackages.haskell-language-server + pkgs.haskellPackages.hlint + pkgs.reuse + ]; + }; + } + ); + # `nix flake check` + checks = perSystem (args: with args; { + git-hooks-check = inputs.git-hooks.lib.${system}.run { + src = ./.; + hooks = { + ormolu.settings.cabalDefaultExtensions = true; + cabal-fmt.enable = true; + fourmolu.enable = true; + hlint.enable = true; + nixfmt-rfc-style.enable = true; + reuse = { + enable = true; + entry = "${pkgs.reuse}/bin/reuse lint"; + pass_filenames = false; + }; + }; + }; + }); + }; +} + diff --git a/magic-squares.html b/magic-squares.html new file mode 100644 index 0000000..5efb7eb --- /dev/null +++ b/magic-squares.html @@ -0,0 +1,2 @@ + +Most-Perfect Magic Square
  • #squares = 132
  • sum = 120
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
2431974197424341-143657365741-14
\ No newline at end of file diff --git a/mpms.css b/mpms.css new file mode 100644 index 0000000..a56d492 --- /dev/null +++ b/mpms.css @@ -0,0 +1,37 @@ +.squares-by-combin { + display: flex; + flex-flow: row; + flex-wrap: wrap; +} +.squares { + display: flex; + flex-flow: row; + flex-wrap: wrap; + justify-content: space-between; +} +.square { + margin-left: 1ex; + margin-right: 1ex; + margin-bottom: 1ex; + margin-top: 1ex; + font-family: monospace; + display: grid; + gap: 3px; + grid-template-columns: repeat(4, 1fr); + //justify-items: center; + justify-self: center; + font-size: 18pt; + //border: 3px solid black; +} +.square-row { + /*grid-template-columns: repeat(4, 1em);*/ +} +.square-num { + display:flex; + justify-content: center; + outline: 3px solid #666; + padding:1ex 1ex; +} +.num-path { + background-color:red; +}