20 Jul 2019, 18:53

2019年7月 開発環境構築メモ(Windows7)

しばらくプログラミングをしていなかったので環境を見直してみる。どうせ大してやらないので最小限やることだけ書く。

ユーザ環境変数

SCOOP = D:\scoop
MSYS2_PATH_TYPE = inherit

インストール

MSYS2とVisual Studio CodeもScoopでインストールしても良いかもしれない。

インストール後に

  • scoop install git
  • scoop install haskell
  • scoop install hugo

Visual Studio Code

  • settings.json
// 既定の設定を上書きするには、このファイル内に設定を挿入します
{
    /* editor */
    "editor.fontSize": 20,
    "editor.rulers": [80],
    "editor.wordWrap": "off",
    "editor.multiCursorModifier": "ctrlCmd",
    "editor.acceptSuggestionOnEnter": "off",
    "files.trimTrailingWhitespace": true,
    "workbench.editor.enablePreview": false,
    "workbench.startupEditor": "none",
    "workbench.colorTheme": "Abyss",
    "extensions.autoUpdate": false,
    "zenMode.hideStatusBar": false,

    /* shell */
    "terminal.integrated.shell.windows": "D:\\msys64\\msys2_shell.cmd",
    "terminal.integrated.shellArgs.windows": [
        "-mingw64", "-defterm", "-no-start", "-here", "-full-path"
    ],
    "terminal.integrated.setLocaleVariables": true,

    /* vim */
    "vim.hlsearch": true,
    "vim.handleKeys": {
        "<C-d>": false,
        "<C-k>": false,
    },
    "vim.insertModeKeyBindings": [
        {
            "before": ["f", "d"],
            "after" : ["<Esc>"]
        }
    ],
}
  • keybindings.json
// 既定値を上書きするには、このファイル内にキー バインドを挿入します
[
// ctrl+enterで行末へ移動
{
  "key": "ctrl+enter",
  "command": "cursorEnd",
  "when": "editorTextFocus && !editorReadonly"
},
]

参考リンク

13 Jan 2019, 15:19

HaskellでFFIを書く準備

以下の2つのパターンについてFFIをやってみた。

  1. ライブラリで自作のCの関数を使う
  2. 外部のライブラリに対するバインディングを書く

1. ライブラリで自作のCの関数を使う

GitHubに上げました

  • フォルダ構成

    app
    - Main.hs
    cbits
    - person.c
    include
    - person.h
    src
    - Person.hsc
    
  • package.yaml

extra-source-files:
- README.md
- ChangeLog.md
- include/**
- cbits/**

library:
  source-dirs: src
  include-dirs:
  - include
  c-sources:
  - cbits/*.c
  build-tools:
  - hsc2hs:hsc2hs

これだけでstack buildしてstack runできる。

2. 外部のライブラリに対するバインディングを書く

例えばRWH17章のようにPCREのバインディングを書くなら

  • 準備

    pacman -S mingw64/mingw-w64-x86_64-pcre
    
  • フォルダ構成

    app
    - Main.hs
    include
    - pcre.h    -- mingw64/includeからコピー
    src
    - Pcre.hsc
    
  • package.yaml

extra-source-files:
- README.md
- ChangeLog.md
- include/**

library:
  source-dirs: src
  extra-libraries:
  - pcre
  include-dirs:
  - include
  build-tools:
  - hsc2hs:hsc2hs
  • stack.yaml
# Extra directories used by stack for building
extra-include-dirs:
- D:\msys64\mingw64\include
extra-lib-dirs:
- D:\msys64\mingw64\lib

メモ

  • extra-librariesを設定するとVSCodeのSimple GHCが動作しなくなる

    • "ghcSimple.workspaceType": "bare-stack"でとりあえず動く
  • hsc2hsを使って手動で変換したいとき

    • stack exec -- hsc2hs src/Pcre.hsc -I./include
    • -Iで指定しないとGHCのincludeしか探しに行かない

02 Jan 2019, 23:05

Haskellでオンライン対戦じゃんけんゲーム

マルチスレッドプログラミング難しい

  • forkFinallyとかwithAsyncとかraceとかconcurrentlyとかどれを使えば良いのか
  • 検索してもちょうどいい教材的なコードが見つからない
  • race_ (putStrLn =<< getLine) (return ())getLineの終了を待つのはなぜ?

コード

  • nc localhost 1234で起動
  • バグあり
    • Main.hs: <socket: 444>: commitBuffer: invalid argument (Invalid argument)
    • なにこれ?
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
{-# LANGUAGE RecordWildCards #-}

module Main where

import Control.Exception
import Control.Monad
import Control.Monad.STM
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
import Data.Unique
import Network
import System.IO
import Text.Printf
import qualified Data.Map.Strict as M

main :: IO ()
main = withSocketsDo $ do
  global <- newGlobal
  forkIO $ monitorClients global

  socket <- listenOn (PortNumber 1234)
  putStrLn "Listening on port 1234 ..."
  let loop = forever $ do
        (hdl, host, port) <- accept socket
        printf "Connection %s: %s\n" host (show port)
        forkFinally
          (clientMain global hdl)
          (\_ -> hPutStrLn hdl "disconnected (press enter key)" >> hClose hdl)
  loop `finally` (sClose socket)

--------------------------------------------------------------------------------

data Global = Global
  { clients :: TVar (M.Map Unique Client)
  }

newGlobal :: IO Global
newGlobal = Global <$> newTVarIO M.empty

addClient :: Global -> Client -> IO ()
addClient Global{..} client@Client{..} = atomically $ do
  modifyTVar' clients $ \m -> M.insert clientId client m

removeClient :: Global -> Client -> IO ()
removeClient Global{..} Client{..} = atomically $ do
  modifyTVar' clients $ \m -> M.delete clientId m

monitorClients :: Global -> IO ()
monitorClients Global{..} = do
  k <- M.size <$> readTVarIO clients
  loop k
 where
  loop k = join . atomically $ do
    m <- readTVar clients
    let k' = M.size m
    case () of
      _ | k  == k'  -> retry
        | k' == 2   -> return $ do
            let (c1:c2:_) = M.elems m
            matchMaking c1 c2
            loop k'
        | otherwise -> return $ do
            printf "There are %d player in room\n" k'
            loop k'

matchMaking :: Client -> Client -> IO ()
matchMaking c1 c2 = do
  a <- async $ fight c1 c2
  atomically $ do
    writeTChan (clientRecvChan c1) (Fight a)
    writeTChan (clientRecvChan c2) (Fight a)

--------------------------------------------------------------------------------

data Message
  = ClientInput String
  | ClientDisconnected
  | Fight (Async ())

readMessage :: Client -> IO Message
readMessage Client{..} = do
  msg <- atomically $ readTChan clientRecvChan
  case msg of
    ClientDisconnected -> throwIO (userError "disconnected")
    _                  -> return msg

--------------------------------------------------------------------------------

data Client = Client
  { clientId       :: Unique
  , clientHandle   :: Handle
  , clientRecvChan :: TChan Message
  }

clientMain :: Global -> Handle -> IO ()
clientMain global hdl = do
  hSetNewlineMode hdl universalNewlineMode
  hSetBuffering hdl LineBuffering
  client <- newClient hdl
  runClient client `finally` cleanUp client
 where
  runClient client = do
    addClient global client
    a1 <- async $ clientInputReceiver client
    a2 <- async $ clientRecvChanHandler client
    wait a2 `finally` forkIO (cancel a1)

  cleanUp client = do
    removeClient global client

clientInputReceiver :: Client -> IO ()
clientInputReceiver Client{..} = flip finally disconnect $ forever $ do
  line <- hGetLine clientHandle
  atomically $ writeTChan clientRecvChan (ClientInput line)
 where
  disconnect = do
    atomically $ writeTChan clientRecvChan ClientDisconnected

clientRecvChanHandler :: Client -> IO ()
clientRecvChanHandler client = loop
 where
  loop = do
    msg <- readMessage client
    case msg of
      ClientInput s -> putStrLn s >> loop
      Fight a       -> wait a

newClient :: Handle -> IO Client
newClient hdl = do
  u <- newUnique
  c <- newTChanIO
  return Client
    { clientId       = u
    , clientHandle   = hdl
    , clientRecvChan = c
    }

--------------------------------------------------------------------------------

data Hand
  = Rock
  | Paper
  | Scissors
  deriving (Eq, Show)

instance Ord Hand where
  Rock     `compare` Paper    = LT
  Rock     `compare` Scissors = GT
  Paper    `compare` Scissors = LT
  Paper    `compare` Rock     = GT
  Scissors `compare` Rock     = LT
  Scissors `compare` Paper    = GT
  _        `compare` _        = EQ

fight :: Client -> Client -> IO ()
fight c1 c2 = loop
 where
  hdl1 = clientHandle c1
  hdl2 = clientHandle c2
  loop = do
    (h1, h2) <- concurrently (getHand c1) (getHand c2)
    hPrintf hdl1 "You: %s, Opponent: %s\n" (show h1) (show h2)
    hPrintf hdl2 "You: %s, Opponent: %s\n" (show h2) (show h1)
    case h1 `compare` h2 of
      LT -> do
        hPutStrLn hdl1 "You lose..."
        hPutStrLn hdl2 "You win!"
      GT -> do
        hPutStrLn hdl1 "You win!"
        hPutStrLn hdl2 "You lose..."
      EQ -> loop

getHand :: Client -> IO Hand
getHand client@Client{..} = loop
 where
  loop = do
    hPutStrLn clientHandle "1=Rock, 2=Paper, 3=Scissors:"
    (ClientInput k) <- readMessage client
    case k of
      '1':_ -> return Rock
      '2':_ -> return Paper
      '3':_ -> return Scissors
      _     -> loop

31 Dec 2018, 22:58

2018年12月 開発環境構築メモ(Windows7)

ユーザ環境変数

SCOOP = D:\scoop
STACK_ROOT = D:\sr

インストール

MSYS2

  • ~/.bash_profile
P1="/c/PortableGit/cmd"
P2="/d/stack/local/bin"
P3="/d/scoop/shims"
PATH="${PATH}:${P1}:${P2}:${P3}"

if [ -f "${HOME}/.bashrc" ] ; then
  source "${HOME}/.bashrc"
fi
  • ~/.bashrc
source ~/git-completion.bash
eval "$(stack --bash-completion-script stack)"
  • gitstack.exeでTAB補完が効くようにする
  • stack.exeでないと補完が効かない(stackではダメ)
  • git-completion.bash

Stack

  • $STACK_ROOT/config.yaml
templates:
  params:
    author-name: lvs7k
    author-email: lvs7k@example.com
    category: Your Projects Category
    copyright: 'Copyright (c) 2019 lvs7k'
    github-username: lvs7k

skip-msys: true
local-bin-path: D:\stack\local\bin
local-programs-path: D:\stack\

Visual Studio Code

  • settings.json
// 既定の設定を上書きするには、このファイル内に設定を挿入します
{
    /* editor */
    "editor.fontSize": 20,
    "editor.rulers": [80],
    "editor.wordWrap": "off",
    "editor.multiCursorModifier": "ctrlCmd",
    "editor.acceptSuggestionOnEnter": "off",
    "files.trimTrailingWhitespace": true,
    "workbench.editor.enablePreview": false,
    "workbench.startupEditor": "none",
    "workbench.colorTheme": "Abyss",
    "extensions.autoUpdate": false,
    "zenMode.hideStatusBar": false,

    /* shell */
    "terminal.integrated.shell.windows": "D:\\msys64\\msys2_shell.cmd",
    "terminal.integrated.shellArgs.windows": [
        "-mingw64", "-defterm", "-no-start", "-here", "-full-path"
    ],
    "terminal.integrated.setLocaleVariables": true,

    /* vim */
    "vim.hlsearch": true,
    "vim.handleKeys": {
        "<C-d>": false,
        "<C-k>": false,
    },
    "vim.insertModeKeyBindings": [
        {
            "before": ["f", "d"],
            "after" : ["<Esc>"]
        }
    ],

    /* Haskell */
    "ghcSimple.bareStartupCommands": [],
    "ghcSimple.workspaceType": "bare-stack",
    "[haskell]": {
        "editor.tabSize": 2,
        "editor.detectIndentation": false
    },
}
  • keybindings.json
// 既定値を上書きするには、このファイル内にキー バインドを挿入します
[
// ctrl+enterで行末へ移動
{
  "key": "ctrl+enter",
  "command": "cursorEnd",
  "when": "editorTextFocus && !editorReadonly"
},
// ターミナルの切り替え
{
  "key": "ctrl+shift+j",
  "command": "workbench.action.terminal.focusNext",
  "when": "terminalFocus"
},
{
  "key": "ctrl+shift+k",
  "command": "workbench.action.terminal.focusPrevious",
  "when": "terminalFocus"
}
]

その他

  • pacman -Syu
  • pacman -S base-devel
  • pacman -S mingw-w64-x86_64-toolchain
  • stack setup
  • scoop install hugo

GHCiでctrl-cが動作しない

  • stack exec -- ghcii.shinvalid argumentエラーで使えない
  • pacman -S winpty
  • winpty stack ghci

VSCode拡張のSimple GHCが動作しない

参考リンク

29 Nov 2018, 22:06

Haskellで蟻本(初級編) - GCJの問題に挑戦してみよう(1)

※蟻本の入力例でしかテストしていません

下2つはコンテストで出たとして解けなそう…。

Minimum Scalar Product

{-# LANGUAGE BangPatterns, FlexibleContexts #-}

import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.STRef
import Data.List

-- Minimum Scalar Product (2008 Round1A A)
q1 :: Int -> [Int] -> [Int] -> Int
q1 n xs ys = sum $ zipWith (*) xs' ys'
  where
    xs' = sort xs
    ys' = sortBy (flip compare) ys
  • 蟻本の解説参照

Crazy Rows

-- Crazy Rows (2009 Round2 A)
q2 :: Int -> [String] -> Int
q2 n xss = runST $ do
    a <- newListArray (1, n) (fmap last1 xss) :: ST s (STUArray s Int Int)
    ans <- newSTRef 0
    forM_ [1 .. n] $ \i -> do
        ai <- readArray a i
        when (ai > i) $ do
            js <- flip filterM [i + 1 .. n] $ \j -> do
                aj <- readArray a j
                return $ aj <= i
            when (not $ null js) (swap ans a i (head js))
    readSTRef ans
  where
    last1 xs = length $ dropWhile (/= '1') (reverse xs)
    swap ans a i j
        | i == j    = return ()
        | otherwise = do
            aj  <- readArray a j
            writeArray a j =<< readArray a (j - 1)
            writeArray a (j - 1) aj
            modifySTRef' ans (+ 1)
            swap ans a i (j - 1)
  • MArray面倒くさい

Bribe the Prisoners

-- Bribe the Prisoners (2009 Round 1C C)
q3 :: Int -> Int -> [Int] -> Int
q3 p q as = runST $ do
    dp <- newArray ((0, 0), (q + 1, (q + 1))) maxBound :: ST s (STUArray s (Int, Int) Int)
    sequence_ [writeArray dp (i, i + 1) 0 | i <- [0 .. q]]
    forM_ [2 .. q + 1] $ \w -> do
        forM_ [0 .. (q + 1) - w] $ \i -> do
            let j = i + w
            t <- fmap minimum $ forM [i + 1 .. j - 1] $ \k -> do
                dpik <- readArray dp (i, k)
                dpkj <- readArray dp (k, j)
                return (dpik + dpkj)
            writeArray dp (i, j) (t + a ! j - a ! i - 1 - 1)
    readArray dp (0, q + 1)
  where
    a = listArray (0, q + 1) (0 : as ++ [p + 1])
  • dp[i][j] := (i, j)を解放するのに必要な金貨
    • 例2) P = 20, Q = 3, A = {3, 6, 14}
      • 配列Aを作る時に両端を追加してA = [0, 3, 6, 14, 21]
      • 例えばdp[0][3]は左端と囚人14は解放済みとして、囚人3と囚人6を解放するのに必要な金貨の最小枚数
  • まず幅が1の時を0で初期化する
    • 幅が1、例えばdp[2][3]は間に解放すべき囚人がいないため金貨不要
  • 幅が2(間に1人解放すべき囚人が存在する)から幅Q+1までループ
  • 最初に解放する囚人をすべて試し、最小コストのものを探す
    • 例えばdp[0][3]dp[0][1] + dp[1][3]dp[0][2] + dp[2][3]の小さい方
    • 先に囚人3と囚人6のどちらを解放するにしても14 - 0 - 1 - 1の金貨は必要

Millionaire

-- Millionaire (2008 APAC local onsites C)
q4 :: Int -> Double -> Int -> Double
q4 m p x = go m gx
  where
    m2 = 2 ^ m
    go 0 j
        | j == m2   = 1.0
        | otherwise = 0.0
    go i j = maximum $ do
        v <- [0 .. min j (m2 - j)]
        return $ p * (memo ! (i - 1, j + v)) + (1 - p) * (memo ! (i - 1, j - v))
    memo = listArray ((0, 0), (m, m2)) [go i j | i <- [0 .. m], j <- [0 .. m2]]
    gx = (x * m2) `div` 1000000
  • 例としてM = 2, P = 0.5, X = 500000を考える
  • dp[i][j] := 残りラウンドがiで、所持金がグループjのとき、最善の戦略をとってお金を持って帰れる確率
  • 所持金のグループ
    • ラウンド数が2のとき
      • j = 0, 0 ~ 249,999
      • j = 1, 250,000 ~ 499,999
      • j = 2, 500,000 ~ 749,999
      • j = 3, 750,000 ~ 999,999
      • j = 4, 1,000,000 ~
  • 配列を埋め終わった状態はこんな感じになる

            [0]    [1]    [2]    [3]    [4]
    dp[0] | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 |
    dp[1] | 0.00 | 0.00 | 0.50 | 0.50 | 1.00 |
    dp[2] | 0.00 | 0.25 | 0.50 | 0.75 | 1.00 |
    
  • 例えばdp[1][2]を更新するときはどうなるか

    • イメージ的にはdp[1][2]から見てV字の先の値が必要になって、掛けた金額に応じてV字の角度が変化する(意味不明)
    • 掛けた金額が0なら、勝とうが負けようがdp[0][2]の状態になって
    • 全額かけたなら、勝てばdp[0][4]の状態になって負ければdp[0][0]の状態になって
    • その間の金額をかけたら、dp[0][1], dp[0][3]みたいな…
  • 最初に持っている金額500,000はグループ2なので答えはdp[2][2]0.50

    • 蟻本のint i = (ll)X * n / 1000000;の部分で最初の所持金がどのグループか判別している
    • 500,000 / (1,000,000 / 2^2) == 500,000 * 2^2 / 1,000,000 == 2