order to Bing

Table of Contents

花札

前回は、ちょいと花札に興味をもった。女房に話すと、子供のころに、よくやっ たと懐しがってた。任天堂が最初に発売したとか。調ベてみたら、確かに任天 堂のルーツはは花札だった。明治22年だってさ。

こいこいの遊びかた なんてのが、しっかり任天堂に掲載されてた。ChatGPTに こいこい を依頼してみた。入力が英単語なんで、スペルミスで何度か例外を くらった。で、番号入力できるように、変更させたよ。

import System.Random
import Data.List
import Control.Monad

-- 花札のカードのデータ型を定義します(derivingの追加)
data HanafudaCard = January | February | March | April | May | June | July | August | September | October | November | December
                  | Pine | Plum | Cherry | Wisteria | Iris | Peony | Clover | Pampas | Chrysanthemum | Maple | Willow | Paulownia
                  deriving (Enum, Bounded, Show, Eq, Read)

-- 花札のデッキを定義します(derivingの追加)
hanafudaDeck :: [HanafudaCard]
hanafudaDeck = [minBound .. maxBound]

-- ランダムに要素を選ぶ関数を定義します(前回と同じ)
getRandomElement :: [a] -> IO a
getRandomElement xs = do
  index <- randomRIO (0, length xs - 1)
  return (xs !! index)

-- カードの点数を計算する関数を定義します(日本語名に変更)
calculatePoints :: [HanafudaCard] -> Int
calculatePoints cards = sum [points card | card <- cards]
  where
    points January = 1
    points February = 2
    points March = 3
    points April = 4
    points May = 5
    points June = 6
    points July = 7
    points August = 8
    points September = 9
    points October = 10
    points November = 11
    points December = 12
    points Pine = 1
    points Plum = 1
    points Cherry = 1
    points Wisteria = 1
    points Iris = 1
    points Peony = 1
    points Clover = 1
    points Pampas = 1
    points Chrysanthemum = 1
    points Maple = 1
    points Willow = 1
    points Paulownia = 1

-- プレイヤーにカードを選択させる関数を定義します
getPlayerSelection :: [HanafudaCard] -> IO HanafudaCard
getPlayerSelection hand = do
  putStrLn "選択したいカードの番号を入力してください(例:1):"
  input <- getLine
  let selectedIndex = read input :: Int
  if selectedIndex >= 1 && selectedIndex <= length hand
    then return (hand !! (selectedIndex - 1))
    else do
      putStrLn "無効な番号です。もう一度選択してください。"
      getPlayerSelection hand

-- カードの日本語名を取得する関数を定義します
getJapaneseCardName :: HanafudaCard -> String
getJapaneseCardName card =
  case card of
    January -> "睦月"
    February -> "如月"
    March -> "弥生"
    April -> "卯月"
    May -> "皐月"
    June -> "水無月"
    July -> "文月"
    August -> "葉月"
    September -> "長月"
    October -> "神無月"
    November -> "霜月"
    December -> "師走"
    Pine -> "松"
    Plum -> "梅"
    Cherry -> "桜"
    Wisteria -> "藤"
    Iris -> "菖蒲"
    Peony -> "牡丹"
    Clover -> "萩"
    Pampas -> "薄"
    Chrysanthemum -> "菊"
    Maple -> "紅葉"
    Willow -> "柳"
    Paulownia -> "桐"

-- ゲームの主なループを定義します
playKoiKoi :: [HanafudaCard] -> [HanafudaCard] -> Int -> IO ()
playKoiKoi playerHand fieldCards playerScore = do
  putStrLn "場のカード:"
  mapM_ (putStrLn . getJapaneseCardName) fieldCards
  putStrLn $ "あなたの手札:"
  mapM_ (\(idx, card) -> putStrLn $ show idx ++ ". " ++ getJapaneseCardName card) (zip [1..] playerHand)
  selectedCard <- getPlayerSelection playerHand
  let newField = selectedCard : fieldCards
  let newHand = delete selectedCard playerHand
  let newScore = playerScore + calculatePoints newField
  putStrLn $ "新しい得点: " ++ show newScore
  -- ゲームの続行判定(ここでは手札がなくなった場合に終了とします)
  if null newHand
    then putStrLn "ゲーム終了!おめでとうございます!"
    else do
      putStrLn "続けてプレイしますか?(y/n):"
      continue <- getLine
      when (continue == "y") $ playKoiKoi newHand newField newScore

main :: IO ()
main = do
  putStrLn "こいこいを始めます:"
  initialHand <- replicateM 8 (getRandomElement hanafudaDeck)
  playKoiKoi initialHand [] 0

もっとジャパン化

HanafudaCardなんていう型が定義されてるけど、この型名って、冗長ではなか ろうか? 花札カードだもんね。それを言ったら、何気によく使うFM変調なん てのも、意味がかぶっている。更に、道路標識にある、利根川リバーなんての もそう。国際的に認知されるかなんだな。sushiFoodって言わなくてもsushiで 通じる(はず)。

最初に日本語化を指示した時、コンストラクターを日本語にしてくれるとばか り思っていた。自前でやってみたら即エラー。なんでと5秒考えて気付いた(そ んなの脊髄反射だろう)。

型名は、大文字で始まる事っていう、鉄の掟があるんだよ。

制限はそれだけだ。ならば、CJK圏内に住むオイラーなら、接頭語として、J でも付けてやればいいんでなかろうか。

data HanafudaCard = J睦月 | J如月 | J弥生 | ...

read CSV

近頃のマイブームは、ChatGPTにコードを作らせる事。Bingはどうよ? 試してみるかってんで、下記を依頼してみた。

CSVファイルを読み込んでください。但しcassava等の外部モジュールは使わな いでね。

import System.IO
import Data.List.Split

-- CSVファイルからデータを読み込む
readCsvFile :: FilePath -> IO [[String]]
readCsvFile path = do
  csvData <- readFile path
  return $ map (splitOn ",") $ lines csvData

型だけ確認して、それじゃ駄目だ。整数の結果が欲しいです。

import System.IO
import Data.List.Split

-- CSVファイルからデータを読み込む
readCsvFile :: FilePath -> IO [[Int]]
readCsvFile path = do
  csvData <- readFile path
  return $ map (map read . splitOn ",") $ lines csvData

一応動いたので、もっと大胆に。

発注書

を、ちゃんと作ってみる。昔golangでやったののhaskell版さくせい依頼。

コンソールから入力したデータをCSVファイルに追記
するプログラムをhaskellで作ってください。

仕様は次の通りです。
CSVファイルの形式
YYMMDDHH, high, low, pls

YYMMDDHH: 西暦年の下2桁 +月2桁 +日2桁 +時2桁(24時間形式)
high: 80から180の範囲
low:   50から110の範囲
pls:   40から120の範囲
ファイル名は、固定で test.csv とします。コード内に組み込んでください。

コンソール入力
$ hoge -ire 2308
2308> 921 133 66 52
2308> 1005 136 70 60
fin

年月を指定して起動。
プロンプトに 年月が表示される。
ユーザーは、日時に続いて、high low pls を入力する。
入力の終了は、fin とする。
finが入力されたら、CSVファイルとマージして、同名なファイル名で
保存する事。
保存時に、年月とコンソール入力の日時を合成する事。

日時のダブりは認めない。
昇順に入力されている事を確認する事
high,low,plsが過不足なく入力されている事を確認する事。
それぞれの値が、CSVの形式で説明した範囲内である事。
上記に違反した場合は、理由を説明の上、入力待ちになる事。

叩き台

haskellでCSVファイルに追記するプログラムを作成するのは、とても面白い課題ですね😊
私はhaskellのコードを生成することができますが、完璧ではありませんので、ご了承ください🙏
以下に、仕様に沿って作成したコードを示します。コードブロックで表示します。

こんな前振りから返答が開始された。1/5とかの区切りがついている。続けてっ て入力すると、次のブロックが表示されるよ。

-- コンソールから入力したデータをCSVファイルに追記するプログラム
import System.Environment (getArgs)
import System.IO (hPutStrLn, stderr, hClose, openFile, IOMode(..))
import Data.List (sort, intercalate)
import Data.List.Split (splitOn)
import Data.Char (isDigit)
import Control.Monad (when)

-- CSVファイルの形式
type Record = (String, Int, Int, Int)

-- ファイル名は固定で test.csv
fileName :: String
fileName = "test.csv"

-- 入力の終了は fin とする
endInput :: String
endInput = "fin"

-- 年月を指定して起動
main :: IO ()
main = do
  args <- getArgs
  case args of
    [yearMonth] -> do -- 年月が正しいかチェックする
      when (not $ isValidYearMonth yearMonth) $ error "年月はYYMMの形式で入力してください"
      inputLoop yearMonth [] -- 入力待ちになる
    _ -> error "引数は年月のみです"

-- 入力待ちになる関数
inputLoop :: String -> [Record] -> IO ()
inputLoop yearMonth records = do
  putStr $ yearMonth ++ "> " -- プロンプトに年月が表示される
  input <- getLine -- ユーザーは日時に続いて high low pls を入力する
  if input == endInput -- finが入力されたら
    then do -- CSVファイルとマージして同名なファイル名で保存する
      oldRecords <- readCSV fileName -- 既存のレコードを読み込む
      let newRecords = mergeRecords oldRecords records -- マージする
      writeCSV fileName newRecords -- 書き込む
      putStrLn "CSVファイルに追記しました"
    else do -- fin以外が入力されたら
      case parseInput yearMonth input of -- 入力をパースする
        Just record -> do -- パースに成功したら
          let newRecords = insertRecord records record -- レコードを挿入する
          inputLoop yearMonth newRecords -- 入力待ちになる
        Nothing -> do -- パースに失敗したら
          putStrLn "入力が不正です。日時とhigh low plsをスペース区切りで入力してください" -- 理由を説明する
          inputLoop yearMonth records -- 入力待ちになる

-- 年月がYYMMの形式かチェックする関数
isValidYearMonth :: String -> Bool
isValidYearMonth s = length s == 4 && all isDigit s

-- 入力をパースしてレコードに変換する関数。パースに失敗したらNothingを返す。
parseInput :: String -> String -> Maybe Record
parseInput yearMonth input = case words input of -- スペースで分割する
  [dayHour, high, low, pls] -> do -- 要素が4つの場合
    let ymdh = yearMonth ++ dayHour -- 年月と日時を合成する
    when (not $ isValidDayHour dayHour) $ fail "日時はDDHHの形式で入力してください" -- 日時が正しいかチェックする
    high' <- readMaybe high -- highを整数に変換する。失敗したらNothingを返す。
    when (not $ inRange 80 180 high') $ fail "highは80から180の範囲で入力してください" -- highが範囲内かチェックする。
    low' <- readMaybe low -- lowを整数に変換する。失敗したらNothingを返す。
    when (not $ inRange 50 110 low') $ fail "lowは50から110の範囲で入力してください" -- lowが範囲内かチェックする。
    pls' <- readMaybe pls -- plsを整数に変換する。失敗したらNothingを返す。
    when (not $ inRange 40 120 pls') $ fail "plsは40から120の範囲で入力してください" -- plsが範囲内かチェックする。
    return (ymdh, high', low', pls') -- レコードを返す
  _ -> Nothing -- 要素が4つでない場合はNothingを返す

-- 日時がDDHHの形式かチェックする関数
isValidDayHour :: String -> Bool
isValidDayHour s = length s == 4 && all isDigit s

-- 整数を文字列に変換して読み込む関数。失敗したらNothingを返す。
readMaybe :: String -> Maybe Int
readMaybe s = case reads s of
  [(n, "")] -> Just n
  _ -> Nothing

-- 整数が範囲内かチェックする関数
inRange :: Int -> Int -> Int -> Bool
inRange low high n = low <= n && n <= high

-- レコードを昇順に挿入する関数。日時のダブりは認めない。
insertRecord :: [Record] -> Record -> [Record]
insertRecord [] r = [r] -- 空のリストにはそのまま挿入する
insertRecord (r1@(ymdh1, _, _, _) : rs) r2@(ymdh2, _, _, _) =
  case compare ymdh1 ymdh2 of -- 日時を比較する
    LT -> r1 : insertRecord rs r2 -- r1の方が小さければr1を先頭にして残りに挿入する
    EQ -> error "日時が重複しています" -- r1とr2が同じならエラーを出す
    GT -> r2 : r1 : rs -- r2の方が小さければr2を先頭にしてr1と残りを続ける

-- CSVファイルからレコードのリストを読み込む関数
readCSV :: String -> IO [Record]
readCSV file = do
  contents <- readFile file -- ファイルの内容を読み込む
  let lines = filter (not . null) $ splitOn "\n" contents -- 改行で分割して空行を除く
  return $ map parseLine lines -- 各行をパースしてレコードに変換する

-- CSVファイルの一行をパースしてレコードに変換する関数。パースに失敗したらエラーを出す。
parseLine :: String -> Record
parseLine line = case splitOn "," line of -- カンマで分割する
  [ymdh, high, low, pls] -> do -- 要素が4つの場合
    let high' = read high -- highを整数に変換する。失敗したらエラーを出す。
    let low' = read low -- lowを整数に変換する。失敗したらエラーを出す。
    let pls' = read pls -- plsを整数に変換する。失敗したらエラーを出す。
    (ymdh, high', low', pls') -- レコードを返す
  _ -> error $ "CSVファイルの形式が不正です: " ++ line -- 要素が4つでない場合はエラーを出す

-- レコードのリストをCSVファイルに書き込む関数
writeCSV :: String -> [Record] -> IO ()
writeCSV file records = do
  handle <- openFile file WriteMode -- ファイルを書き込みモードで開く
  mapM_ (writeLine handle) records -- 各レコードを一行ずつ書き込む
  hClose handle -- ファイルを閉じる

-- レコードをCSVファイルの一行に変換して書き込む関数
writeLine :: Handle -> Record -> IO ()
writeLine handle (ymdh, high, low, pls) = do
  let line = intercalate "," [ymdh, show high, show low, show
はい、まだ続きがあります。すみません、コードが長くなってしまいました😅
以下に続きを示します。
```haskell
pls] -- レコードをカンマ区切りの文字列に変換する
  hPutStrLn handle line -- ファイルに書き込む

-- 二つのレコードのリストをマージする関数。昇順にソートする。
mergeRecords :: [Record] -> [Record] -> [Record]
mergeRecords rs1 rs2 = sort $ rs1 ++ rs2 -- リストを結合してソートする
```

最後に確認。

この話題に再び触れるには、私に「haskellでCSVファイルに追記するプログラムを作成する」
というように、同じような質問をしてください。私は以前の回答を覚えているので、同じコード
を表示します。もしくは、別のプログラミング言語や仕様で質問してもらっても構いません。私
はできるだけお答えします
今日の会話制限に達しました。 チャットを続けるにはサインインしてください。

Bingとのセッションを終了して窓を閉じたら、DeskTopに付箋みたいのができ ていた。Bingの呼出専用の奴みたいだった。頼みもしないのに余計な事をする な。まあ、必死なんでしょうな。普段は絶対にエッジなんて使わないもの。 Windows 10を再起動したら、付箋みたいな奴は消えていた。どうもMSのやる事 は、理解できないなあ。

zapping

確認作業を始める前に、軽くザッピングしておく。まず注目は、

import System.Environment (getArgs)
import System.IO (hPutStrLn, stderr, hClose, openFile, IOMode(..))
import Data.List (sort, intercalate)
import Data.List.Split (splitOn)
import Data.Char (isDigit)
import Control.Monad (when)

モジュールの何に注目したか、ちゃんと列挙してる事。前回みたいに、 Control.Monadで何を使っているか、importをわざわざコメントにして、コン パイラーにエラーを発生させるっていう原始的な事をやらないくても良い。 それから、全体的にコメントがしっかりと入っているな。これは得点高いよ。 五月蝿すぎるきらいが有るけどね。

-- CSVファイルの形式
type Record = (String, Int, Int, Int)

-- ファイル名は固定で test.csv
fileName :: String
fileName = "test.csv"

-- 入力の終了は fin とする
endInput :: String
endInput = "fin"

これぐらいなコードだとコンストラクター(型)の出番は無い。そのかわり、レ コードって名前で、タプルを定義してる。YYMMDDHHを今回の場合は扱い易い文 字列にしてるからだな。オイラーだと、無理して整数にしちゃって後で悩むっ てパターンになっちゃうんで、見極めが大切だな。

続いて、定数っぽい奴をグローバル?に宣言。こうしておけば、気にいらなかっ たら、これを編集するだけで済む。

else do -- fin以外が入力されたら
  case parseInput yearMonth input of -- 入力をパースする
    Just record -> do -- パースに成功したら
      let newRecords = insertRecord records record -- レコードを挿入する
      inputLoop yearMonth newRecords -- 入力待ちになる
    Nothing -> do -- パースに失敗したら
      putStrLn "入力が不正です。日時とhigh low plsをスペース区切りで入力してください" -- 理由を説明する
      inputLoop yearMonth records -- 入力待ちになる

これ、核になるinputLoopの一部。入力をパースして、成功・失敗をMaybeで扱っ てる。いずれも、最後は、再帰させる事で、素直にループさせてる。上手いな あ。見習おう。recordの単数型とrecordsって言う複数形の表現は、いやだな あ。英語圏の人には馴染なんだろうけど。

high' <- readMaybe high -- highを整数に変換する。失敗したらNothingを返す。
when (not $ inRange 80 180 high') $ fail "highは80から180の範囲で入力してください" -- highが範囲内かチェックする。

parseInputの中の一節。こういう使い方をするのか。

-- 整数を文字列に変換して読み込む関数。失敗したらNothingを返す。
readMaybe :: String -> Maybe Int
readMaybe s = case reads s of
  [(n, "")] -> Just n
  _ -> Nothing

あらあら、コメントと型宣言が一致してないよ。こういう場合はコードを信用 する。

下記は、hugs98のPrelude.hsからの参考コード。今の物とマッチしないかな。

reads        :: Read a => ReadS a
reads         = readsPrec 0

instance Read Int where
    readsPrec p = readSigned readDec

readDec, readOct, readHex :: Integral a => ReadS a
readDec = readInt 10 isDigit    (\ d -> fromEnum d - fromEnum_0)

機械的形式検査

そう、そんなのhlintで自動化するねん。

[sakae@fb /tmp/hbld]$ hlint app/Main.hs
app/Main.hs:26:7-45: Warning: Use unless
Found:
  when (not $ isValidYearMonth yearMonth)
Perhaps:
  unless (isValidYearMonth yearMonth)
  :
app/Main.hs:65:5-36: Warning: Use unless
Found:
  when (not $ inRange 40 120 pls')
Perhaps:
  unless (inRange 40 120 pls')

5 hints

ふーん、haskellにもunlessなんてのが有るのか。知らなかったなあ。

受け入れ検査

えいやっと作成された物なんで、当然不都合は有るはず。冷静に批判するだけ じゃなくて、生暖かく接してあげましょう。

app/Main.hs:7:1: error:
    Could not find module ‘Data.List.Split’
    Use -v (or `:set -v` in ghci) to see a list of the files searched for.
  |
7 | import Data.List.Split (splitOn)
  | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

hoogle Data.List,Split すると、splitが供給元だったんで追加。

    Not in scope: type constructor or class ‘Handle’
    Perhaps you want to add ‘Handle’ to the import list
    in the import of ‘System.IO’ (app/Main.hs:5:1-66).
    |
119 | writeLine :: Handle -> Record -> IO ()
    |              ^^^^^^

言われた通りに追加。オイラーはGHCの下僕なのさ。

ghci> :main
 *** Exception: 引数は年月のみです
CallStack (from HasCallStack):
  error, called at app/Main.hs:30:10 in main:Main
ghci> :main 2308
2308> 104 120 66 55
入力が不正です。日時とhigh low plsをスペース区切りで入力してください

まあ、ちゃんとエラーハンドリングしてるっぽい。

2308> 0104 120 66 55
2308> 0121 111 60 59
2308> fin
 *** Exception: test.csv: openFile: resource busy (file is locked)

あらら、何故落ちる?

長くなりそうなので、to be continue…

etc