MSYS2 上で stack upgrade (Haskell)

使っていたstackのバージョンが1.7.0.1だったのでバージョンを上げようと思った.そこで MSYS2 上で $stack upgrade したがパーミッションの問題でうまくいかない.
「管理者として実行」でMSYS2シェルを立ち上げて$stack upgradeしてもうまくいかない.

$stack upgrade を実行したときの最後のメッセージが

Should I try to perform the file copy using sudo? This may fail
Try using sudo? (y/n) y
Going to run the following commands:

-  sudo cp C:\Users\Username\AppData\Roaming\local\bin\stack.exe C:\stack-1.7.0.1-windows-x86_64\stack.exe.tmp
-  sudo mv D:\stack-1.7.0.1-windows-x86_64\stack.exe.tmp D:\stack-1.7.0.1-windows-x86_64\stack.exe

だったので,「管理者として実行」でMSYS2シェルを立ち上げてから

$ cp "C:\Users\Username\AppData\Roaming\local\bin\stack.exe" "C:\stack-1.7.0.1-windows-x86_64\stack.exe.tmp"
$ mv "D:\stack-1.7.0.1-windows-x86_64\stack.exe.tmp" "D:\stack-1.7.0.1-windows-x86_64\stack.exe"

したらうまくいったようだ:

$ stack --version
Version 1.7.1, Git revision 681c800873816c022739ca7ed14755e85a579565 (5807 commits) x86_64 hpack-0.28.2
広告

Haskellによる日本語テキスト処理(Windows上で)

Haskellでテキストを処理しようとするとき,このように書きたくなるであろう:

-- テキストをHTMLに変換する
module Main where

import System.Environment(getArgs)

htmlEncode :: String -> String
htmlEncode [] = []
htmlEncode (c:cs) = (f c) ++ htmlEncode cs
  where
    f :: Char -> String
    f '' = ">"
    f '&' = "&"
    f '"' = """
    f a = [a]

main :: IO ()
main = do
  [inputF, outputF] <- getArgs  :: IO [String]
  inputText <- readFile inputF
  let outText = unlines $ htmlEncode  (lines inputText) :: String
  writeFile outputF outText

上のプログラムをWindows上で日本語(utf-8)が含まれたテキストを処理することを考える:
$ stack exec converter -- app/Main.hs main.htm
すると「 hGetContents: invalid argument (invalid byte sequence)」というようなことを言われてうまく処理できなかった.テキストがShift-JISとして読まれているためにこうなるらしい(よく理解できていない).

ロケールを変更すると良いらしいのだが方法がよくわからなかったので次のようにプログラム側で対処した:

-- テキストをHTMLに変換する
module Main where

import System.Environment(getArgs)
import System.IO (IOMode (..), hGetContents, hSetEncoding, openFile, hPutStr, hClose)
import GHC.IO.Encoding (utf8)

htmlEncode :: String -> String
htmlEncode [] = []
htmlEncode (c:cs) = (f c) ++ htmlEncode cs
  where
    f :: Char -> String
    f '' = ">"
    f '&' = "&"
    f '"' = """
    f a = [a]

main :: IO ()
main = do
  [inputF, outputF] <- getArgs  :: IO [String]
  handle <- openFile inputF ReadMode
  hSetEncoding handle utf8
  inputText <- hGetContents handle :: IO String
  let outText = unlines $ htmlEncode  (lines inputText) :: String
  ohandle <- openFile outputF WriteMode
  hSetEncoding ohandle utf8
  hPutStr ohandle outText
  hClose ohandle

optparse-genericを使ったバージョンは:

-- テキストをHTMLに変換する
{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE TypeOperators        #-}

module Main where

import System.IO (IOMode (..), hGetContents, hSetEncoding, openFile, hPutStr, hClose)
import GHC.IO.Encoding (utf8)
import Options.Generic --stack install optparse-generic

data OptionInput  w = OptionInput
  { rawtext :: w ::: String           "raw text file to be transformed"
  , htmlout :: w ::: String           "HTML output file"
  } deriving (Generic)

instance ParseRecord (OptionInput Wrapped)
deriving instance Show (OptionInput Unwrapped)

htmlEncode :: String -> String
htmlEncode [] = []
htmlEncode (c:cs) = (f c) ++ htmlEncode cs
  where
    f :: Char -> String
    f '' = ">"
    f '&' = "&"
    f '"' = """
    f a = [a]

main :: IO ()
main = do
  x  html"
  let
    inputF = rawtext x :: String
    outputF = htmlout x :: String
  handle <- openFile inputF ReadMode
  hSetEncoding handle utf8
  inputText <- hGetContents handle :: IO String
  let outText = unlines $ htmlEncode  (lines inputText) :: String
  ohandle <- openFile outputF WriteMode
  hSetEncoding ohandle utf8
  hPutStr ohandle outText
  hClose ohandle

参考にした記事:WindowsでHaskellを扱う時によく遭遇するエラーと対処法

一万円を崩す方法(Haskell)

一万円を両替して崩す方法は何通りあるだろうか.ただし:
・百円玉,五百円玉,千円札を自由に(好きなだけ)使って良い.
・五百円記念硬貨は10枚までしか使えない.
・二千円札は2枚までしか使えない.

この問題は以前の千円を崩す方法(Haskell)の変種である.新しい要素は五百円記念硬貨(普通の五百円玉と区別される)と二千円札である.どちらも個数(枚数)に制限がある.

答えは1561通りになるはず.

以前の記事では組み合わせ的な考察だけから漸化式を導いて解いたが,今回は母関数を使わねば漸化式を導くことができなかった.

これを求めためのHaskellプログラムは次のようになる:

p n = if n < 0 then 0
      else if n `rem` 100 == 0 then 1
      else 0
q n | (n < 0) = 0
    | otherwise = p n + q (n-500)
r n | (n < 0) = 0
    | otherwise = q n + r (n-1000)
s n | (n < 0) = 0
    | otherwise = r n - r (n-5500) + s (n-500)
t n | (n < 0) = 0
    | otherwise = s n - s (n-6000) + t (n-2000)

問題の答えは t 10000として求まる.

ブログに数式を書くのが面倒になったので,数列を母関数を通して扱う話からはじめて,このプログラムを導く過程をPDFにまとめてみた.(文字を大きくしておいたのでスマホでも読めると思う):数列と母関数

切手を貼る方法(Haskell)

■問題:2セント,4セント,6セント,8セントの切手を封筒に一列に貼って10セントにしたい.何通りの方法があるか?(異なる並べ方は違う方法としてカウントする).

■注意:つまり「2,2,4,2」と「4,2,2,2」は違う方法としてカウントされる.

■問題出典:Pólya & Szegöの “Problems and Theorems in Analysis I”の問題3である.

{b_n}によって,『{n}セントを支払う方法の数』を表す.組み合わせについての簡単な考察により

{b_0 = 1.}
・負の添字に対して {b_n = 0.}
{b_n = b_{n-2} + b_{n-4} + b_{n-6} + b_{n-8}.}

がわかる.これを素直にHaskellのコードに移すと:

b :: Int -> Int
b n | (n < 0) = 0
    | (n ==0) = 1
    | otherwise = b (n-2) + b (n-4) + b (n-6) + b (n-8)

となる.よって b 10 を求めればよい.

$ ghci
Prelude> :l b.hs
[1 of 1] Compiling Main             ( b.hs, interpreted )

Ok, modules loaded: Main.
*Main> b 10
15

答えは15通りである.

■ Pólya & Szegöの “Problems and Theorems in Analysis I” では,さらに数列 {b_n}の母関数の閉じた式が扱われている.(今回は必要ないので扱わない.)

32ビット?64ビット?(自分用メモ)

■gccが32ビットか64ビットか:
gcc -v の出力の Target: のところを見る.

32ビットの場合 Target: mingw32
64ビットの場合 Target: x86_64-pc-msys

などのようになる.システムの細かな差異によって文字列は少しずつ違うが,64ビットの場合 x86_64 が部分文字列としてしばしば含まれる.

■ghcが32ビットか64ビットか:
次のようなファイルを作る:

main = print ()

そして

$ ghc --make foo.hs
[1 of 1] Compiling Main             ( foo.hs, foo.o )
Linking foo.exe ...

$ file foo.exe

32ビットの場合には
PE32 executable (console) Intel 80386, for MS Windows

64ビットの場合には 
PE32+ executable (console) x86-64, for MS Windows

のようになる.

■おまけ:
自分がどの gcc を使ってるのかわからなくなった場合などは
which -a gcc
すればよい.使い分けをしたい場合は適宜 .bashrc に alias を張ればよさそう.

HaskellからFFIでCの配列を扱う(マーシャリング)

HaskellのFFIについてはこのブログでも例えばこんな記事で扱っている.

今回はその記事では触れなかったマーシャリングについて扱う.まずは次のようなCの関数があったとしよう:

#include <stdlib.h>
#include <stdio.h>
#include "c_header.h"

/*
int sum(int* p);

int fib(int** pp, int n);
*/

int sum(int* p, size_t n)
{
  if(n == 0){ return 0; }
  size_t i;
  int retval = 0;
  for(i = 0; i < n; ++i)
  {
    retval += p[i];
  }
  return retval;
}

int fib(int** pp, int n)
{
  if(n<=0){ return 1;}
  *pp = malloc(n * sizeof(int));
  if(n>=1){ (*pp)[0] = 1;}
  if(n>=2){ (*pp)[1] = 1;}
  if(n>=3){
    int i;
    for(i=2; i < n; ++i)
    {
      (*pp)[i] = (*pp)[i-1] + (*pp)[i-2];
    }
  }
  return 0;
}

これらのコードは次のように使われる:

#include <stdio.h>
#include <stdlib.h>
#include "src/c_header.h"

#define N 10
int main(void)
{
  int array[] = {1,2,3,4,5,6,7,8,9,10};

  int s = sum(array, sizeof(array)/sizeof(array[0]));
  printf("sum=%d\n",s);

  int* p = 0;
  int r = fib(&p,N);
  if(r==1){ printf("failed"); }
  else{
    int i;
    for(i=0; i < N; ++i)
    {
      printf("fib(%d)=%d\n",i,p[i]);
    }
  }
  free(p);
  return 0;
}

sumやfibは次のようにHaskellから扱える:

module Lib
    where

import Foreign.C.Types
import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign

-- int sum(int* p, size_t n);
foreign import ccall "c_header.h sum" cSum
  :: Ptr CInt -> CSize -> IO CInt

hSum :: [Int] -> IO Int
hSum xs =
  let
    xs' = fromIntegral <$> xs :: [CInt]
    len   = fromIntegral $ length xs :: CSize
  in
  do
    arr <- newArray xs' :: IO (Ptr CInt)
    l <- return len  :: IO CSize
    ret <- cSum arr l :: IO CInt
    return $ fromIntegral ret

-- int fib(int** pp, int n);
foreign import ccall "c_header.h fib" c_fib
  :: Ptr (Ptr CInt) -> CInt -> IO CInt

hFib :: Int -> IO [Int]
hFib n =
    do
      ptrOut <- malloc  :: IO (Ptr (Ptr CInt))
      n' <- return $ fromIntegral n :: IO CInt
      ret <- c_fib  ptrOut  n' :: IO CInt
      out <- peekArray n =<< peek ptrOut :: IO [CInt]
      free =<< peek ptrOut
      free ptrOut
      return (fromIntegral <$> out) :: IO [Int]

cSum と hSum, c_fibとhFibのシグネチャは結構ずれている.
関数cSumは sum と同様にポインタとサイズを受け取る.hSum ではサイズを配列から計算しているので長さを引数にする必要がない.
また,c_fib では二重ポインタと長さを引数にしているが,hFibでは長さだけが引数となっている.c_fib の引数となっている二重ポインタは出力用の変数だからである.

次のコードはhSum,hFibの使用例である.

module Main where

import Lib

main :: IO ()
main =
  do
    a <- hSum [1,2,3,4]
    print a
    xs <- hFib 15
    print xs

stack でこのコードをビルドする場合,stack.yaml に次のような行を加えねばならない:

c-sources:  src/c_impl.c

optparse-generic (Haskell)

自分用メモ.

必要なことはすべて https://github.com/Gabriel439/Haskell-Optparse-Generic-Library から辿れるhttp://hackage.haskell.org/package/optparse-generic/docs/Options-Generic.htmlに載っている.

■optparse-genericとは何ですか?:コマンドライン引数を処理するライブラリの一つです.

■インストール:stack install optparse-generic

■サンプル:

{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleInstances  #-}  -- One more extension.
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE StandaloneDeriving #-}  -- To derive Show
{-# LANGUAGE TypeOperators      #-}

import Options.Generic --stack install optparse-generic

data OptionInput  w = OptionInput
  { foo :: w ::: Int            <?>"Documentation for the foo flag"
  , bar :: w ::: Double         <?>"Documentation for the bar flag"
  , baz :: w ::: String         <?>"Documentation for the baz flag"
  , qux :: w ::: Maybe String   <?>"Documentation for the qux flag"
  , quux :: w ::: Bool          <?>"Documentation for the quux flag"
  } deriving (Generic)

instance ParseRecord (OptionInput Wrapped)
deriving instance Show (OptionInput Unwrapped)

main = do
    x <- unwrapRecord "program short description"
    let i = foo x :: Int
    let d = bar x :: Double
    let s = baz x :: String
    let s' = qux x :: Maybe String
    let b = quux x :: Bool
    print (x :: OptionInput Unwrapped)

■サンプルのビルド:stack ghc optiontest.hs
必要に応じて,package.yaml で
dependencies:
– optparse-generic

■サンプルを動かす:optiontest.exe --foo 2 --bar 3.478 --baz "hoge" --qux "fuga"

uniq 的な関数(Haskell)

Haskell のリストから重複要素を除去する関数はnubである.「同じかどうか」を判定する関数を引数に取る nubBy を使いたい場合もある.これらの関数はリスト全体を舐めて重複要素を除去する.

扱っている配列がソート済みである場合も多い.その場合,隣接要素だけ見ていけば重複要素を除去できるはずである.そうすれば少しだけ効率が良いかも知れない.そう考えてこんな関数を書いてみた:

uniq :: (Eq a) => [a] -> [a]
uniq = foldr  uniqAux []
  where uniqAux :: (Eq a) => a -> [a] -> [a]
        uniqAux t [] = [t]
        uniqAux t (u:us) = (if t == u then [u] else [t,u]) ++ us

uniqBy を作るのも簡単である.

※効率がどうこうと言ったが,性能比較はまだしていない.

千円を崩す方法(Haskell)

次のような問題を考えてみましょう:

千円を両替して崩す方法は何通りあるだろうか.ただし,一円玉,五円玉,十円玉,五十円玉,百円玉,五百円玉を自由に(好きなだけ)使って良いものとする.

まず問題を一般化し,つぎのように考えます.{A_n}によって「{n}円を一円玉で崩す方法の数」を表すことにします.(と言っても{n\ge 0}ならば常に{A_n = 1}なのですが).

また,{B_n}によって「{n}円を一円玉と五円玉で崩す方法の数」を,

{C_n}によって「{n}円を一円玉と五円玉と十円玉で崩す方法の数」を,

{D_n}によって「{n}円を一円玉と五円玉と十円玉と五十円玉で崩す方法の数」を,

{E_n}によって「{n}円を一円玉と五円玉と十円玉と五十円玉と百円玉で崩す方法の数」を,

最後に{F_n}によって「{n}円を一円玉と五円玉と十円玉と五十円玉と百円玉と五百円玉で崩す方法の数」を表すことにします.

このように定式化すると,クイズの答えは{F_{1000}}と表されます.あとはこの具体的な数値を求めれば良いわけです.

さて,{F_n}はを「n円を五百円玉を一枚も使わないで表した場合の数」と「(n-500)円をすべてのコインを好きなだけ使って表した場合の数」の和だと考えられます.
(追記2018/08/27 少し説明を補います.{n}円を全てのコインを使って崩した場合を全て列挙した集合を{X}としましょう.{X}を (i)五百円玉を一つも含まないもの (ii)少なくとも1枚の五百円玉を含むもの に分割できます.それぞれの場合からなる集合を{X_1,X_2}としましょう.{X = X_1 + X_2} (非交和)ですから,{|X| = |X_1| + |X_2|} となります.明らかに{|X_1| = E_n}です.{X_2}の全ての要素から五百円玉を一つ抜くと,それぞれは{n-500}円を崩したものになっています.したがって{|X_2| = F_{n-500}}です.
).よって

{F_n = E_n + F_{n-500}}

となります.よって,{F_n}の計算を{E_{n},\,F_{n-500}}の計算に還元できます.

同様に考えれば
{E_n = D_n + E_{n-100}}などの式が得られます.ただし,負のインデックスに対しては{A_n, B_n, C_n, D_n, E_n, F_n}はいずれもゼロとします.この考えをそのままHaskellコードにすれば次のようになります:

fA n | (n < 0) = 0
     | otherwise = 1

fB n | (n < 0) = 0
     | otherwise = fA n + fB (n-5)

fC n | (n < 0) = 0
     | otherwise = fB n + fC (n-10)

fD n | (n < 0) = 0
     | otherwise = fC n + fD (n-50)

fE n | (n < 0) = 0
     | otherwise = fD n + fE (n-100)

fF n | (n < 0) = 0
     | otherwise = fE n + fF (n-500)

これらの定義を書いてGHCiで:l 1000yen.hs してやってから fF 1000 を計算させると248908という答えが得られます.

したがって,一円玉,五円玉,十円玉,五十円玉,百円玉,五百円玉を自由に(好きなだけ)使って千円を両替する方法は全部で248908通りあることになります.

この問題はポリア他『組合せ論入門』p.11(近代科学社)で扱われている問題を改変したものです.(元の問題は1ドルを1セント,5セント,10セント,25セント,50セントで崩す問題です.)この問題はポリアのお気に入りだったのか,Pólya & Szegö “Problems and Theorems in Analysis I” にも収録されています.)

この記事では漸化式を組み合わせ論的な考えで導きましたが,ポリアの本では母関数を利用して漸化式を導いています.興味のある方は是非ポリアの『組合せ論入門』を読んでみてください.

Haskell の QuickCheck を自動化する

ライブラリを開発していると、複数のテストを一挙に回したくなるかもしれませんね。そんなときはこうします。

{-# LANGUAGE TemplateHaskell #-}

import Data.List
import Test.QuickCheck

-- 与えられた2つのリストを連結する
cat :: (Eq a) => [a] -> [a] -> [a]
cat [] ys = ys
cat (x:xs) ys = x : (xs `cat` ys)

-- cat が結合律を満たすかどうかのテスト
prop_cat xs ys zs = (xs `cat` ys) `cat` zs == xs `cat` (ys `cat` zs)

-- 最初のリストから二番目のリストの要素を除去したリストを作る
sub :: (Eq a) => [a] -> [a] -> [a]
sub [] ys = []
sub (x:xs) ys | x `elem` ys = xs `sub` ys
| otherwise = x : (xs `sub` ys)

-- sub が結合律を満たすかどうかのテスト
prop_sub xs ys zs = (xs `sub` ys) `sub` zs == xs `sub` (ys `sub` zs)
--to run this test, > quickCheck prop_cap

--最初のリストに含まれている要素を除外しつつ2つの与えられたリストをマージする
ucat :: (Eq a) => [a] -> [a] -> [a]
ucat [] ys = ys
ucat (x:xs) ys | x `elem` ys = x : (xs `ucat` (ys `sub` [x]))
| otherwise = x : (xs `ucat` ys)

-- ucat が結合律を満たすかどうかのテスト
prop_ucat xs ys zs = (xs `ucat` ys) `ucat` zs == xs `ucat` (ys `ucat` zs)

return []
main = $forAllProperties (quickCheckWithResult stdArgs { maxSuccess = 2000 })

■動かし方/その出力例

$ stack runghc qc.hs
Run from outside a project, using implicit global project config
=== prop_cat from qc.hs:12 ===
+++ OK, passed 2000 tests.

=== prop_sub from qc.hs:20 ===
*** Failed! Falsifiable (after 9 tests and 7 shrinks):
[0]
[]
[0]

=== prop_ucat from qc.hs:29 ===
+++ OK, passed 2000 tests.

■コードの解説
cat, sub, ucat というリスト演算を定義し、それらが結合法則を満たすかどうかチェックしています。テストの結果、cat は合格、subは失格(つまり結合法則の反例が見つかった)、ucatは合格となりました。

■ポイント
1. TemplateHaskell を使う。
2. テストの名前は prop_ で始まる。 (TemplateHaskellを使っていることからの制約)
3. return[] とかいうキモいやつは我慢。 (TemplateHaskellを使っていることからの制約)
4. main は一番最後に来る。 (TemplateHaskellを使っていることからの制約)