IC-705のAMラジオ用アンテナ

 手軽にAMラジオをIC-705で聞けないか、フェライトバーアンテナを試してみた。今、入手が難しくなっているらしいけれど、ヤフオクでラジオから取り外したと思われるものをたまたま見つけて290円で落札させていただいた。１次側が670uHほどだったので、中波なら40pF前後を並列につなぐ必要がある。たまたま半固定の小型バリコンがあったので、２個並列でつないで、２次側を無線機のアンテナ側につなぐ。窓のそばに、アルミ線で位置を調整すると、５９+20dBと、十分な感度。意外とフェライトバーアンテナのゲインは高いようだ。　

アクリル板のケースに収めて小型アンテナにすることができた

　MLAと理屈は同じようで、調べてみると、高Qで帯域外ノイズを除去、電界ノイズに鈍感（磁界のみ検出）　といった効果があるとか。

VY24G/D i5-520MにLinux Mint

 i5-520Mは第一世代で、Win11も23H2までは、SSD化や４GBメモリで騙しだましつかってきましたが、さすがに25H2は、かなり無理がありそうだったので、諦めてLinuxを試すことに。ところが、標準インストールだとなかなかうまくいきません。しばらくして、原因がつかめました。

・BIOSでUSBメモリでは、読み取れずUSB HDDで読み取れました。(DVDでは遅すぎて無理があります。ＵＳＢメモリを使いましたが、なぜかＵＳＢ　ＨＤＤを選択しないとだめでした。）

・標準インストールだと最近のLinuxはほとんどGPTのため、うまくいきません。事前にMBR(msdos)に変更が必要です。ここが一番のネックのようです。

　Linux Mint ,MX Linuxあたりに候補をしぼりましたが、最終的にMint xfceにしてみました。Windowsと配置が似ていて使いやすい感じがします。注意点としてはGPartedであらかじめ、MBRのパーティション（/,swap./home等）を作っておき、Mintのインストーラでは、新規インストールせずに、カスタマイズのほうを選択して、マウント処理とブート領域設定していきます。途中、警告らしきメッセージも出ますが、無視して進めたところ、うまくいきました。第一世代のＣＰＵは想定していないようですが、しばらくは、ＰＣを無駄にせず、動画視聴等に活用できそうです。

Win11の25H2を古いPC（第３～４世代）に入れる場合の覚書

ノートA573などの第３世代でも、工夫次第でぎりぎり25H2が入るようです。一回目起動しなくなったので、なんとかならないかとChatGPTの助けを借りて、うまくいきました。

　H97M-PLUS　i5-4460 も使っていますが、こちらも同様な方法でうまくいきました。

　Bios（F2キー断続押しで起動するとOk）セキュアブートをoffとするといいようです。そのためには、A573のBIOSでは一時的に管理者パスワード入れないと編集できないようでした。

〇 BIOS　設定のポイント
CSM（互換モード） Enabled 古いOS/MBRディスクとの互換性を確保
Secure Boot / OS Type Disabled または Other OS Windows 11の署名チェックを回避
Fast Boot（高速モード） Disabled 起動チェックを省略せず、SSD/USBを確実に認識
Boot Priority / Legacy First Legacy First ON 古い形式（MBR/USB/SSD）を優先して起動
⚡ Fast Bootは速度優先、Legacy Firstは互換性優先の意味

〇インストールUSB作成　　Rufusなどで作成
パーティション形式：MBR（UEFI + CSM対応）
ファイルシステム：NTFS（容量大きめの場合）
「TPM・Secure Boot回避オプション」を有効にするとより安全

〇インストール後の調整（任意）
GPT形式に変換してUEFI純正起動
CSMを無効、OS Typeを「Windows UEFI mode」に戻すと、Secure Boot利用可能
古いPCでも安定してWindows 11を使える

〇注意点
第３～４世代でギリギリライン
安定して使うなら、Windows 10延命 or UbuntuなどLinuxを検討

※Win11が最近のPCしか対応しなくなったことが、余力ある古いPC(SSD化やメモリ増設は必要ですが）にとっては、Linux流行のきっかけになる？

Haskell入門 型以外の安全性の確保 P286

 actionIO :: IO a -> IO a
actionIO action = do
  mv <- newEmptyMVar    --スレッド間通信用の空のMVarの箱をつくる
  _tid <- forkIO $ do           --スレッドをたてて
    result <- try action         --actionを実行　成功ならRight 値  例外なら Left eを返す

    putMVar mv result         --結果(Either SomeException a)をMVarに入れる
  result <- takeMVar mv    --メインスレッドでMVarから結果を受ける。入るまで待つ動作。
  case result of                       つまり、actionが終わるまで待って結果を受け取る
    Left e  -> throwIO e
    Right r -> return r

　forkIOでスレッドをわけると、普通はその中で起きた例外が親スレッドに伝わらない。

でも、この関数では、例外をつかまえ　MVarを通して親スレッドに返している。

久しぶりに室内MLAアンテナでDX

 18MHzバンドで久しぶりDXが開けていた。ゼヤ（Asiatic Russia)の局長さんとFT8で交信できた。5Wの室内アンテナで届いたので、コンディションがよかったようだ。

 FT8でオンエアしている局の密度をみると、やはり、欧州、日本、北米が目立っているのがわかる。

Haskell入門 モナドによるDSLの実現 ~operational~ P274

型の変換を細かく追って、整合性を確認はしてみましたが、けっこう込み入っていて、それに気を取られると全体の構造がわかりにくいので、おおまかにとらえることも大事かと思いました。runSalesTという関数が、再帰を使って、レシピを読み取っていく構造になっているようです。

　その際、ポイントが　:>>=という関数のようです。　（ひとつの命令）:>>= (それに続く残りの命令）　この残りの命令である右辺がkとなっていて、　これが次のrunSalesTへ再帰で渡される構造になっているようです。そして、次のrunSalesTで、また先頭の（ひとつの命令）が取り出され、それに応じて枝分かれした処理が行われ、...これを繰り返していく。

 　ちょうど、リストを順に処理していく再帰と同じ構造のようです。func( [a:k])=（何らかの処理   func(k)) の形。

　簡単なoperational使ったDSLのコードをChatGPTに頼んで作ってもらいました。

sample.hs

import Control.Monad.Operational -- 命令（Instruction）の定義 data CalcInstr a where Push :: Int -> CalcInstr () Add :: CalcInstr () ShowTop :: CalcInstr () type MyProgram = Program CalcInstr -- 命令を組み立てるための関数 push :: Int -> MyProgram () push n = singleton (Push n) add :: MyProgram () add = singleton Add showTop :: MyProgram () showTop = singleton ShowTop -- インタプリタ（命令の意味づけ） runCalc :: MyProgram a -> [Int] -> IO [Int] runCalc prog stack = case view prog of Return _ -> return stack instr :>>= k -> case instr of Push n -> runCalc (k ()) (n:stack) Add -> case stack of (x:y:rest) -> runCalc (k ()) ((x+y):rest) _ -> error "stack underflow" ShowTop -> case stack of (x:_) -> print x >> runCalc (k ()) stack [] -> error "empty stack" -- 実際のプログラム myProg :: MyProgram () myProg = do push 3 push 4 add showTop main :: IO () main = do _ <- runCalc myProg [] return ()

.yamlに- operationalを追加必要し stack runghc  sample.hsで7と表示します。

あるいはstack runghc --package operational sample.hsでもいいようです。

Haskell入門 Applicativeスタイル パーサー P251

 既習のモナドを組み合わせると、パーサーもこんなふうになるというよい例だと思います。ただ、かなり複雑にはなってきていますが。 20170401のような日付のパーサーの例です。

data YMD = YMD Int Int Int deriving Show    
countRead :: Read a => Int -> Parser Char -> Parser a
countRead i = fmap read . count　 i　　
ymdParser :: Parser　 YMD                                                                    
ymdParser = YMD <$> countRead 4 digit <*> countRead 2 digit <*> countRead 2 digit　

1. YMD は関数：データコンストラクタ YMD は、単なる値ではなく
　YMD :: Int -> Int -> Int -> YMD　という「Intを3つ受け取って YMD を返す関数」でもある。
2. countRead の役割：countRead n digit は「数字を n 個読み取り、それを整数として解釈する」パーサーである。
　例えば：　countRead 4 digit :: Parser Int（年を読む）
　　　　　　countRead 2 digit :: Parser Int（月や日を読む）
3. <＄> で最初の適用：(<＄>) :: (a -> b) -> Parser a -> Parser b
　a = Int　　b = Int -> Int -> YMD　　関数 f = YMD　値 Parser a = countRead 4 digit
　したがって：　　YMD <＄> countRead 4 digit　:: Parser (Int -> Int -> YMD)
　ここで、Parser の中には「年をすでに受け取った部分適用関数 YMD y」が入っている。
4. <*> で次々に引数を渡す：次の <*> により
　　Parser (Int -> Int -> YMD) <*> Parser Int　:: Parser (Int -> YMD)
　　さらにもう一度 <*> を使うと：
　　Parser (Int -> YMD) <*> Parser Int　::　 Parser YMD
※イメージ表せば
　<$>：外の関数を箱に入れる 　　　<*>：箱の中の関数に箱の中の値を渡す 

Haskell入門 Readerモナド P１８６

 testrun env = ( `runReader` env) 　＄ do　③
  cons1 <- consume
  cons2 <- consumue
  constOthers <-  local (\e->e{powSaveMode =True}) $ do
     cons3 <- consume              ①　　　　　　　　　　　②
     cons4 <- consume
     return (cons3 + cons4}
  return (cons1+cons2+consOthers)

local :: (r->r) -> Reader r a -> Reader r a    
                 ①　　　　②　　　　　　　　　　①がモード切替の関数　②do以降が対象

　「最初２回通常モード後半２回がSaveモードで電力を測定したものをすべて合計」というレシピをつくり（③のdo以降）それに、testrunのenvでその都度PowerEnvを入れてやる。そんな、流れでしょうか。

 (   ) `runReader` env   は　runReader   (    )   env    ということ?のようです。(   )が未適用のところでここに③のdo以下のレシピがくるような、部分適用かと。

Haskell入門 P179 Alternative型クラスでMaybeを使う

let assocs = [("hiratara",39),("shu1",0),("masaharu",32)]
do age <- lookup "honma" assocs <|> lookup "hiratara" assocs 　　①
      guard $ age < 20　②
      return age 
②が、分かりづらかった。

guard True = pure ()  つまり Just ()
guard False= empty つまり　Nothing

　「do式でMaybeを使った場合、①や②のどの行であっても、Nothingが出たらそこでストップして、Nothingを返す（つまり全体の結果がNothing）。最後まで行けばJust ageですが。」　

　この「どの行であっても」がポイントになりそうです。これがあるからモナドが便利なんだろうと思いますが。この性質は、以前にも目にしていて、そのときは理解していたつもりでしたが、しばらくすると忘れてしまうようで、きちんとした言葉でメモしておくことも大事かもしれません。

Haskell 代数的データ型、レコード記法(data)とnewTypeについて

 〇　data BookInfo = Book Int String [String] deriving (Show)
型コンストラクタ名　=データコンストラクタ名　フィールドの型１　フィールドの型２,,,
（新しい型の名前=型構成子）　　　（値構成子）　　　　　　（構成要素1,2,,,,）
データコンストラクト名を関数として扱い、Int,String,,,という型の引数に適用するとBookInfoの型の新しい値を生成できる 　　myInfo=Book 978~ "〇〇" ....

〇　data Bool = False | True   代数的データ型　　パターンマッチで使用

〇　レコード記法：フィールドに名前
data Employee = NewEmployee { employeeAge :: Integer , employeeName::String,...}
　employee = NewEmployee { employeeName="~ ,em~   }
   employeeName employeeで名前にアクセスできる　アクセサは関数

〇newType　NewtypeInt  = N Int deriving (Eq,Ord,Show)　N 1<　N 2は　Ordで可、+不可
    data DataInt = D Int  deriving (Eq,Ord,Show)と比べると制限がある
　・ちょうど一つのフィールドのみ可　　　newType Okay=ExactlyOne Int
　・パラメータは問題なし　　newType Param a b = Param (Either a b)
  　　レコード記法も可  ただしフィールド無は不可　複数の値構成子も不可

newType NTIndexed a =NewNTIndexed { unNTIndexed :: (Integer,a)} deriving Show
　NewNTIndexedとunNTIndexedが、NtIndexed aと (Integer,a)を行き来するための関数として使えるのが便利らしい。

※なお、newtype Ph a = MkPh (Int,a)として、:t MkPhとしてみたらMkPh :: (Int, a) -> Ph aとなりました。　外側から見ると Ph aでも、中身は (Int,a)ということになります。内部構造 (Int, a) は隠して、簡潔に見せたいという考え方？

Haskell 型クラスについて

 Haskell入門とRealWorlHaskellあたりを参考に型クラスについて　まとめたみた
Java　　　　　　　　　Haskell
インターフェース　　　型クラス　　　　　型がもつべきメソッドを規定
具象クラス　　　　　　インスタンス　　　規定されたメソッドの実装
インスタンス　　　　　値　　　　　　　　個々のデータ

class BasicEq  a  where　　　　← BasicEqという型クラスを宣言
   isEqual ::  a -> a -> Bool         　インスタンスの型はaで表現　
   isEqal x y = not (isNotEqual x y)    ←このようなディフォルト実装あれば、インスタンス
   isNotEqual :: a -> a -> Bool　　　　で繰り返しの実装を省力化できる
   isNotEqual x y= not (isEqual x y)

　この型クラスのインスタンスである型は　この型クラスの中で定義されている関数を実装しているならどんな型でもいい。　この型クラスでは１つだけ関数を定義している。

  関数の型を並べるときにその名前(a)をインスタンスのクラスを表すのに使うことが必要。
:t isEqualを確認すると 

　 isEqual ::  ( BasicEq a ) => a->a-> Bool  

　これは、「任意の型aに対して　aがBasicEqのインスタンスである限り、isEqual は　型aのパラメータを２つ取り、Boolを返す」　

isEaqualの定義は
instance BasicEq Bool where
  isEqual True True = True
 isEqual False False =True
 isEqual _  _  =False
instance BasicEq Color where
  isEqual Red Red = True
 .....  のようにインスタンスの種類を増やせる

Haskell入門 P390

 サーバー側のビルドがうまくいかず、苦労していたけれど、deriveJSONエラーが、どうやら、上にあるものですでに処理されているものを、下の方で使うということらしい。順序を次のように変えてみたら、うまくビルドできた。最近の仕様は厳しくなっているのかもしれない。

deriveJSON defaultOptions ''Money
deriveJSON defaultOptions ''AuctionItemId
deriveJSON defaultOptions ''ItemId
deriveJSON defaultOptions ''NewItem
deriveJSON defaultOptions ''Item
deriveJSON defaultOptions ''Term
deriveJSON defaultOptions ''NewUser
deriveJSON defaultOptions ''UserId
deriveJSON defaultOptions ''Inventory
deriveJSON defaultOptions ''AuctionRequest
deriveJSON defaultOptions ''AuctionServerRequest
deriveJSON defaultOptions ''AuctionException
-- deriveJSON defaultOptions ''UUID
deriveJSON defaultOptions ''User
deriveJSON defaultOptions ''AuctionItem
deriveJSON defaultOptions ''AuctionResponse
deriveJSON defaultOptions ''AuctionServerResponse

あとは、client.hsについては、以下行の削除したら、なんとかビルドが通った。

--import qualified System.Console.Haskeline.MonadException as Haskeline (catch)

--instance Catch.MonadThrow (InputT IO) where

--    throwM e = liftIO $ throwIO e

--instance Catch.MonadCatch (InputT IO) where

--    catch act handler = Haskeline.catch act $ \e ->

--        if isSyncException e

--            then handler e

--            else throwIO e

あとは、サーバ側のMain.hsがサンプルにはなかった？ようなので追加し、.cabalもそれに合わせてmain-isを修正すると、すべてビルドを終えることができた。

※サーバへのクライアントのアクセスも、GUIでなく、すべてコマンドライン操作なので、昔のパソコン通信のようなもので、久々に懐かしい感覚を思い出しました。

クラウド経由の家計簿データ保存

 　これまで、raspiにテキストデータとして、外出中の買い物データを保存して、自作家計簿ソフトでインポートするようにしていたけれど、実際、旅行中など使ってみると、削除や編集の機能もないと不便だった。そこで、sqlite3を使って、raspiのbottleはWebAPI形式にしてみた。

　スマホはjavaでCRUDができるようにしたが、これが一番時間がかかった。完全にMVCに則ってコーディングするため、メンテはしやすいだろうけど、最初はなかなか大変。画面の該当行を長押しで、編集・削除もできるようにしたところ、けっこう便利になった。一般のクラウドでとなると、維持費もまあまあかかると思うので、個人利用なら、やはり、raspiが一番の節約になりそう。

　raspiは、省エネのわりに、SSRと組み合わせてタイマー機能、タッチパッドPC起動、ネットラジオ録音とさまざま活用できて手放せない存在になっている。

gitのリモートへのクローン（備忘録）

 githubにも、方法が表示されますが、念のため手順をまとめてみました。最近は、公開鍵も使うようになっているので。

・　mkdir myproject　　cd myproject　　　　　　git init
・　echo "# My Project" > README.md　　　　　　git add .
　　git commit -m "first commit"
・リモート側で空リポジトリ作成
　　　（例: GitHubで myproject を新規作成）

・　ssh-keygen -t ed25519 -C "your_email@example.com"（または -t rsa でもOK）＞公開鍵 (~/.ssh/id_ed25519.pub) を GitHub の[Settings] → [SSH and GPG keys] → New SSH key に登録（アカウントのほうのSettingsで）＞(~/.ssh/config)につぎのようにして443ポートを使うように指定、ルータのフィルタリングを通過させたい場合必要

Host github.com
  Hostname ssh.github.com
  Port 443
  User git

・ssh -T git@github.com　で接続確認

・git remote set-url origin git@github.com:ユーザー名/リポジトリ名.git

   によりパスワード不要になる。

・ローカルのブランチ名が master の場合は git branch -M main で統一

・git push -u origin main

※毎回のプッシュを簡単にするためスクリプトを作ったら、けっこう便利。
git add .
git commit -m "commit_$1"
git push -u origin main

gitPush.sh に第一引数としてコメントも入れられるよう、上記のスクリプトにした

wslでtomcat10

root権限で　ネット上の情報を参考にwslでtomcat10を動かしてみた。

wget https://downloads.apache.org/tomcat/tomcat-10/v10.1.44/bin/apache-tomcat-10.1.44.tar.gz
tar -xzvf apache-tomcat-10.1.44.tar.gz
apache-tomcat-10.1.44/bin/startup.sh で起動
apache-tomcat-10.1.44/bin/shutdown.sh　で停止
localhost:8080でWindowsからも見ることができた。

pico apache-tomcat-10.1.44/conf/tomcat-users.xml
 <role rolename="manager-gui"/>
  <user username="admin" password="pass" roles="manager-gui"/>

myapp/  <---プロジェクト名

 ├─ WEB-INF/

 │    ├─ classes/

 │    └─ lib/

 └─ src/

           └─ HelloServlet.java　という構成にして

つぎに、jspはwebappsの下のプロジェクト名直下において、表示なるか確認

index.jsp

<%@ page language="java" contentType="text/html; charset=UTF-8" pageEncoding="UTF-8"%> <!DOCTYPE html> <html> <head> <meta charset="UTF-8"> <title>JSP テスト</title> </head> <body> <h1>Hello, JSP!</h1> <p>現在の日時: <%= new java.util.Date() %></p> </body> </html>

http://localhost:8080/myapp

そして、servletは プロジェクトのディレクトリで

javac -d WEB-INF/classes  src/HelloServlet.javaで、コンパイルすると、表示が確認できる。

ライブラリ指定必要な時は、javac -d WEB-INF/classes -cp /home/user/tomcat10/apache-tomcat-10.1.44/lib/servlet-api.jar src/HelloServlet.javaのように-cpオプションで指定

HelloWorld.java

import java.io.*; import jakarta.servlet.*; import jakarta.servlet.http.*; import jakarta.servlet.annotation.WebServlet; @WebServlet("/hello") public class HelloServlet extends HttpServlet { @Override protected void doGet(HttpServletRequest request, HttpServletResponse response) throws ServletException, IOException { response.setContentType("text/html;charset=UTF-8"); PrintWriter out = response.getWriter(); out.println("<h1>Hello, Servlet on Tomcat 10!</h1>"); } }

http://localhost:8080/myapp/hello

Haskellのテストの仕様について

注意点が２つほど 　このへんは、ChatGPTでもなかなか気づけなかった。まだ、試行錯誤できる人間よりは、AIは不利かもしれない。

・テストファイルひとつならSpec.hs のままでも OK
しかし、複数だと、Main.hsとしないとだめな仕様になっているようです。このへんは、気づきにくいところ。

・cabalファイルにはpackage.yamlの設定が反映されるけれど、個別のファイルの設定は反映されず、globalスコープのdependencies:のところに、依存関係を記述しないとだめだった。

dependencies:
  - base >= 4.7 && < 5
  - text
  - bytestring
  - aeson
  - sqlite-simple　　などのように
  

Haskell Scottyをapache転送で外向けに

 内部LANでのサーバ稼働はうまくいったので、外向けに以前設定したraspi2のapache転送をそのまま利用することにした。ただ、これも一筋縄でいかなかった。（クッキーを利用する場合は、転送処理は難しいようなので、あくまで簡易的な利用にとどめる予定）

・sudo nano /etc/apache2/sites-available/default-ssl.confで、以下のような行を追加

ProxyPass /hs http://追加ラズパイのローカルipアドレス:3000

これで、外部からsslでhttps://ホスト.ドメイン/hsでアクセスすると追加raspi3の3000ポートに転送される。

他に苦労したところでは、

・raspi間の転送がうまくいくように、ルータのipフィルタリングの許可設定を追加

・webアプリに0,0,0,0でリスンするようにコードを書き換える必要があった。そうしないと、なぜか転送がうまくいかなかった。なお、キャッシュが残っているとうまくいかないこともあるので、ビルド、ブラウザは適宜、キャッシュクリアの操作が必要かも。あと、warpを.yamlに追加する必要があった。

  app/Main.hs

{-# LANGUAGE OverloadedStrings #-} module Main(main) where import Web.Scotty import Network.Wai.Handler.Warp (defaultSettings, setPort, setHost) main :: IO () main = do let warpSettings = setPort 3000 $ setHost "0.0.0.0" defaultSettings scottyOpts (Options 1 warpSettings) $ do get "/" $ html "<h1>Hello</h1>" get "/bye" $ html "<h1>Goodbye</h1>"

※追記：アパッチ転送で注意が必要なのは、/の転送は最後にしないとだめということ。ルートの後に、転送の設定をしてもそれは、無視されるようです。順序が大事なようです。

Haskell入門 Ｗｅｂアプリ(覚書）

 １０章のＷｅｂアプリを読み終えたのはいいけれど、Spockは実際にビルドしても、依存関係のエラーでかなり面倒なことが判明。いろいろ、バージョンを変えて調整したが、ネット上の情報も少なく諦める。せっかくのSpockの勉強も無駄？になったようで、ちょっと回り道してしまった感じもある。

　とりあえず、Scottyあたりが、比較的メンテもされているようなので、そちらを試すことにした。まずは、簡単なコードをしばらくしまい込んでいたraspi3で、動作確認をしてみた。

・stack new sample           cd sample
・package.yamlについて:   executables>sample-exe>dependenciesに
    - sample
    - http-types
    - aeson
    - scotty

・Main.hsについて
　 {-# LANGUAGE OverloadedStrings #-} module Main where import Web.Scotty main :: IO () main = scotty 3000 $ do get "/" $ html "<h1>Hello</h1>" get "/bye" $ html "<h1>Goodbye</h1>"

・stack build       stack install
    stack exec sample-exe   でhttp://raspiのアドレス:3000/でアクセス

これで、ようやく動作の確認はできた。

    ちなみにコード修正後はstack runで　　ビルドと実行ができるようだ

     stack cleanでビルド結果を削除（再ビルドしたいとき）

Haskell入門P368 ルーティング、本体

HaskellでSpockを使ったルーティングは、慣れるまで大変そうですが、無駄のない構成という感じがします。

-- src/Web/WeightRecorder.hsに追記。 authHook :: WRAction WRContext authHook = do ctx <- getContext mUser <- fmap wrsesUser readSession case mUser of Nothing -> startView Nothing Just user -> return $ ctx { wrconUser = Just user } -- src/Web/WeightRecorder.hsに追記。 -- ルーティング定義。 spockApp :: WRApp () () spockApp = prehook (return emptyContext) $ do prehook authHook $ do get root $ mainView Nothing post "new_record" newRecordAction post "register" registerAction post "login" loginAction -- src/Web/WeightRecorder.hsに追記。 weightRecorderMiddleware :: WRConfig -> IO WAI.Middleware weightRecorderMiddleware cfg = do -- テンプレートの読み込み。 starttpl <- loadStartTemplate cfg maintpl <- loadMainTemplate cfg -- 状態を作成。 let state = WRState { wrstStartTemplate = starttpl , wrstMainTemplate = maintpl } pool <- sqlitePool $ wrcDBPath cfg -- セッションと状態を渡して設定を作成。 spCfg <- defaultSpockCfg emptySession (PCPool pool) state spock spCfg spockApp -- 生成。 -- src/Web/WeightRecorder.hsに追記。 sqlitePool :: FilePath -> IO (Pool Connection) sqlitePool dbpath = createPool (connectSqlite3 dbpath) disconnect 1 60 5 -- src/Web/WeightRecorder.hsに追記。 runWeightRecorder :: WRConfig -> IO () runWeightRecorder cfg = runSpock (wrcPort cfg) (weightRecorderMiddleware cfg)

authHook:ログイン認証

・ctx <- getContextについて：ユーザーからのリクエスト関連情報が、ある時点で箱にはいっていて、そこから、とりだしたのがctxへいく、というイメージ。

・mUser <- fmap wrsesUser readSessionについて：オブジェクトにフィールド名を関数として適用すると、該当フィールドの要素を返す仕組みになっている(P96).

readSession :: WRAction (SessionVal UserSession):現在のリクエストに紐づく セッション情報 を取得する関数 data UserSession = UserSession { wrsesUser :: Maybe User....から、取り出しmUserに

spockApp:ルーティング

・外側のprehookは認証なし、内側はauthHookで認証　うまく階層的に配置してわかりやすい構造

・get,postの別やURLと対応するActionが並べられている。

prehook (return emptyContext) $

 ├─ prehook authHook $ do

 │    ├─ get root

 │    └─ post "new_record"

 ├─ post "register"       ← authHook は適用されない

 └─ post "login"          ← authHook は適用されない

weightRecorderMiddleware:WAI ミドルウェアとして起動するための処理

・runWeightRecorder cfgで定義されているように、runSpockで呼ばれる。

  　　ここで、spock spCfg spockApp にreturnがないが、do内のモナド計算なので不要

Haskell入門 P364 グラフ表示部の実装

-- グラフ表示の実装。 weightGraphValue :: [WRecord.WeightRecord] -> WRAction [Value] weightGraphValue wrs = do flatWrs <- liftIO $ mapM flat wrs let wrss = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ flatWrs return $ map groupToValue wrss where -- WeightRecord型を日付と体重のタプルにして扱いやすくする。 flat wr = do ztime <- toZonedTime $ WRecord.time wr let ztimeStr = TM.formatTime TM.defaultTimeLocale "%m/%d" ztime w = WRecord.weight wr return (ztimeStr, w) -- グループをmustacheで扱うための値にする。 groupToValue gr = let dt = head $ map fst gr -- groupByの仕様からgrは[]ではなく、headが使える wt = avg $ map snd gr avg xs = sum xs / fromIntegral (length xs) in object ["day" ~> dt, "weight" ~> wt]

ここも、分かりにくいところがあり、ChatGPTの助けを借りるが、ほぼ完ぺきにわかりやすく説明してくれるので、非常に助かる。

・weightGraphValueはMustacheへ渡すValueを返すのが役目。

・liftIO $ mapM flat wrsについて：flatでweightはそのまま使い、日付のみ"%m/%d"形式に変換し、 flat::WeightRecord-> IO (String,Double)　よりmapM flat wrsはIO[(String,Double)]を返す。このへんは、mapMの働きを覚えてないと使えない、正直言って、前に学習(P174)したことを忘れており、復習して気づいた感じ。IOを含んでいるのでliftIOでWRActionモナドに持ち上げている。

・let wrss = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ flatWrsについて:

 sortBy (compare `on` fst) は、fstの日付でソートしている。groupBy ((==) `on` fst) は同じ日付のものをまとめるらしい。つまり[ [("08/20",60.5), ("08/20",61.0)],  [("08/21",60.8)]となる。wrssはリストのリストになります。(==)にそういう機能があることなど、非常に細かいところだけどChatGPTがしっかり解説してくれたのには、驚いた。

　本によれば、onは第二引数の関数を適用してから、第一引数の２項演算子を適用するという働きらしい。これと、上記の説明をみて、ようやく意味が理解できた。

・groupToValueについて：　　:: [(String, Double)] -> Valueである。

 　　dt = head $ map fst gr→ グループの日付を取り出す（全部同じなので先頭でOK）。

　　 wt = avg $ map snd gr→ 複数記録がある場合は平均を取る。

　なるほど、うまくでてきています。これを使えばgroupToValue [("08/20",60.5),("08/20",61.0)]→ object ["day" ~> "08/20", "weight" ~> 60.75]となります。

Haskell入門 P354 各種操作の実装

registerAction :: WRAction a registerAction = do name <- param' "name" -- paramで値を取り出す。 password <- param' "password" when (null name || null password) $ startView (Just "入力されてない項目があります") -- 未入力項目があれば入力を促す。 n <- runSqlite $ insertUser (NewUser name password) when (n <= 0) $ startView (Just "登録に失敗しました") -- INSERT失敗時に登録失敗を返す。 startView (Just "登録しました。ログインしてください。")

whenはtrueならアクションを実行、startViewは実行したら次の行にはいかない。

runSqlite で　(Connection -> IO m)を引数にとるため、insertUserの部分適用をうまく使っている。　(insertUser  :: IConnection c  => NewUser -> c -> IO Integerなので)

このへんがHaskellの簡潔さにつながっているのだと思う。

Haskell入門 P352 コントローラの開発

P352「type WRApp ctx= SpockCtxN ctx WRConnection WRSession WRState

type WRAciton = SpockActionCtx WRCibtext WRConnection WRSession WRState

WRAppとWRActionはWeightRecoder アプリケーションで利用するモナドです。
先ほどコンテキストにはWRContextを使うものとしてsrc/Web/Core.hsに定義しました。
　しかし、/のコンテキストは必ず()になるため、WRContextは適しません。そのため、ルーティングに用いるWRAppでは()にも対応できるよう、ctxを指定できるよう定義しています。一方で、ロジックを実際に記述するWRActionのコンテキストは、()を受け取らないようにできるため、型変数ではなくWRContext固定としています。このため、ルーティングの根本でコンテキストをWRContextに設定する必要があります。」

　この部分がよくわからなかった。どうやら、型変数ctxの例がWRContextという型などであるようだ。WRappとWRActionは厳密に関連しているのかと思ったけれど、必ずしもそういうことではなかったよう。WRAction が型変数をとらない理由は、型を固定して型安全にしたいからのよう。WRApp はルートや URL ごとに ctx が異なる可能性があるので型変数で柔軟にしている。そういうことらしい。WRappは設定データだから、いろんなデータを設定できる方がいい、でもWRActionは、安全性が求められるのである程度使える設定データは制限したい、そんな感じだろうか。

Haskell入門 P347 ユーザー登録のためのINSERT

 仕組みがわかりにくかった。

module Model.User ( NewUser(NewUser, nuName, nuPassword) , nuName' , nuPassword' , insertUser , selectUser ) where -- import 省略 data NewUser = NewUser { nuName :: !String , nuPassword :: !String } makeRecordPersistableDefault ''NewUser -- 射影を定義。 piNewUser :: HRR.Pi User.User NewUser piNewUser = NewUser HRR.|$| User.name' HRR.|*| User.password' -- src/Model/User.hsに追記。 -- 第一引数で新ユーザ、第二引数で接続を指定。 insertUser :: IConnection c => NewUser -> c -> IO Integer insertUser u conn = do mHashed <- -- ハッシュ生成。第一引数はハッシュ化ポリシー設定。 hashPasswordUsingPolicy slowerBcryptHashingPolicy $ enc . nuPassword $ u case mHashed of -- ハッシュ生成失敗の場合。 Nothing -> do hPutStrLn stderr "Failed to hash password" return 0 -- ハッシュ生成成功の場合。 Just hashed -> do let ins = HRR.typedInsert User.tableOfUser piNewUser u' = u { nuPassword = dec hashed } -- トランザクション維持。 withTransaction conn $ \conn' -> -- ここでINSERT文実行。 DHR.runInsert conn' ins u' `catch` \e -> do hPrint stderr (e :: SqlError) return 0 -- ハッシュ化した情報を取り扱うエンコーダとデコーダ。 enc :: String -> BS.ByteString enc = encodeUtf8 . pack dec :: BS.ByteString -> String dec = unpack . decodeUtf8 -- src/Model/User.hsに追記。 -- 第一引数にユーザ名、第二引数にパスワード、第三引数に接続を指定。 selectUser :: IConnection c => String -> String -> c -> IO (Maybe User.User) selectUser name pass conn = do -- runQueryでクエリ実行で情報取り出し、listToUniqueでリストを一意に。 user <- DHR.runQuery conn q name >>= DHR.listToUnique return $ user >>= checkHash where -- 関数の性格上、where以下に定義する。 -- クエリの定義 q :: HRR.Query String User.User q = HRR.relationalQuery . HRR.relation' . HRR.placeholder $ \ph -> do a <- HRR.query User.user HRR.wheres $ a HRR.! User.name' HRR..=. ph return a -- ハッシュをチェックする。 checkHash :: User.User -> Maybe User.User checkHash user | validated = Just user | otherwise = Nothing where hashed = User.password user -- ハッシュ化したパスワードとの照合。 validated = validatePassword (enc hashed) (enc pass)

そこで、次のような質問をChatGPTにしてみた。

Q1：piNewUserは、どういうふうに使い方をするのですか？

Ans: let ins = HRR.typedInsert User.tableOfUser piNewUser がポイント

typedInsert :: Table User -> Pi User NewUser -> Insert NewUser

第1引数 User.tableOfUser → 「Userテーブルそのもの」

第2引数 piNewUser → 「NewUser から User のカラムに対応付ける射影」

let ins = HRR.typedInsert User.tableOfUser piNewUser

    u'  = u { nuPassword = dec hashed }                ins は INSERT 文のひな型

DHR.runInsert conn' ins u'     と実行すると、

u' :: NewUser の値（ユーザー名とハッシュ済パスワード）を

piNewUser に従って User テーブルの name, password カラムに対応付け

実際に DB へ INSERT

Q2: 要するに、手順を最初にくみたてて、最後に、runInsertで実行するのですね。

Ans:  はい、その理解でバッチリです！

  まとめると：

   piNewUser で「どう射影するか」を定義（テーブルと型の橋渡し）。

   typedInsert で「INSERT文のひな型」を作成。

   runInsert で「実際の値」を流し込んでDBに送信。

※　Haskellは、手続き型のように「値を受け取りながら逐次SQL発行」というやり方はあまりせず、まず「設計図を型安全に作る → 値を流し込む」という 宣言的な流れ

　型安全性が高い：SQL文やカラム名の間違いをコンパイル時に検出できる

　SQLインジェクション対策が組み込みである：値を直接文字列連結しないので安全

　トランザクション管理が明確：withTransaction の中で設計図に値を流し込むので、途中でエラーがあればロールバック可能

　コードの再利用性が高い：射影（piNewUser のような定義）を作っておくと、INSERTや　　SELECTで同じマッピングを使い回せる

　などの利点があるらしい

Q3:makeRecordPersistableDefault ''NewUser　はどういう意味？

Ans:NewUser を Relational-Record の「DBに入出力できる型」として登録する宣言、Template Haskell によって必要な型クラスインスタンスを自動生成している

「この型をSQLに流せるようにしますよ！」と最初に宣言しておく儀式 みたいなもの

Q4:Template Haskellとは？（P340にも説明はありますが）

Ans:「Haskellプログラム自身を生成する Haskellプログラム」を書ける

Q5:自動生成ですね。DjangoやRuby on Railsなどでも、DB初期化で似たような処理あったような気がしますね.

Ans:まさに Django や Ruby on Rails と同じ発想です。

Rails/Django = 実行時に自動生成・マッピング

Haskell(TH) = コンパイル時に自動生成・型安全にマッピング

Q6:user <- DHR.runQuery conn q name >>= DHR.listToUniqueのDHR.listToUniqueの働きは？

Ans:[] の場合 → Nothing を返す、[x] の場合 → Just x を返す、[x, y, ...] の場合 → エラーか Nothing を返す。「DB側にユニーク制約があるとは限らない」設計を想定。

Q7:checkHash user | validated = Just user | otherwise = Nothingの意味は？

Ans: if ... else if ... else if ... elseのイメージで、最初にtrueになったところが　checkHash userの値。ガードの機能(p62で既習)

Haskell入門 P326 処理のまとめ

stack install で実行ファイルを作り、動作確認してみた。これも、一筋縄ではいかず、Windowsだと、文字エンコードなど配慮しないとうまくいかなかった。エラーメッセージ見たり、ChatGPTに聞いたりしながら、なんとか解決。

 

echo [{"age":"aa","name":"名前","telnumber":"abcdef"},"age":"bb","name":"abcd","telnumber":"jkl"}] > test.json

としてファイルをつくってから

hjq-exe "{\"name\":.[1].name,\"telnumber\":.[1].telnumber}" test.json

としたらうまくいった。ハイフンがあるとうまくいかず、カットする必要あった。なかなか、大変だった。

package.yamlのdependenciesは最終的にこのようになった dependencies: - base >= 4.7 && < 5 - text - megaparsec - aeson - lens - lens-aeson - vector - unordered-containers - errors - bytestring - aeson-pretty Hjq.hsは {-# LANGUAGE OverloadedStrings #-} module Data.Hjq ( hjq ) where import Control.Error.Util import Data.Aeson import Data.Text as T import Data.ByteString.Lazy as B import Data.Hjq.Parser import Data.Hjq.Query import Data.Aeson.Encode.Pretty import Data.Bifunctor (first) hjq :: B.ByteString -> T.Text -> Either T.Text B.ByteString hjq jsonString queryText = do value <- note "Invalid json format." $ decode jsonString query <- first T.pack $ parseJqQuery queryText -- String -> Either Text _ result <- executeQuery query value -- Either Text Value return $ encodePretty result Main.hsは module Main where import System.Environment import System.Exit import Data.Hjq import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import System.Exit (ExitCode(..)) main :: IO () main = do args <- getArgs case args of (q : file : []) -> do jsonLazy <- BL.readFile file printResult $ hjq jsonLazy (T.pack q) -- ここでは q が正しい (q : []) -> do jsonLazy <- BL.getContents printResult $ hjq jsonLazy (T.pack q) -- ここも q _ -> putStrLn "Invalid arguments" >> exitWith (ExitFailure 1) printResult :: Either T.Text BL.ByteString -> IO () printResult (Right s) = do BL.putStr s putStrLn "" -- 改行を追加 printResult (Left s) = do T.putStrLn s exitWith $ ExitFailure 1

Hjq.hs

・note:MaybeをEitherに変換　　　　decode:ByteStringをValueに変換

　first:Rightはそのまま、Leftに関数を適用

Haskell入門 P323 テストようやく終了

 本のままでは、動かず新しいバージョンに合わせた修正が必要だった。

-- Spec.hs ********************* {-# LANGUAGE OverloadedStrings #-} import Test.HUnit import qualified Data.Text() import Data.Text (Text,unpack) import Data.Hjq.Parser import Data.Hjq.Query(applyFilter,executeQuery) -- import qualified Data.HashMap.Strict as H import qualified Data.Vector as V import Data.Aeson import qualified Data.Aeson.KeyMap as KM import Control.Lens import Data.Aeson import Data.Aeson.Lens jqFilterParserTest :: Test jqFilterParserTest = TestList [ "jqFilterParser test 1" ~: parseJqFilter "." ~?= Right JqNil , "jqFilterParser test 2" ~: parseJqFilter ".[0]" ~?= Right (JqIndex 0 JqNil) , "jqFilterParser test 3" ~: parseJqFilter ".fieldName" ~?= Right (JqField "fieldName" JqNil) , "jqFilterParser test 4" ~: parseJqFilter ".[0].fieldName" ~?= Right (JqIndex 0 (JqField "fieldName" JqNil)) , "jqFilterParser test 5" ~: parseJqFilter ".fieldName[0]" ~?= Right (JqField "fieldName" (JqIndex 0 JqNil)) ] jqFilterParserSpacesTest :: Test jqFilterParserSpacesTest = TestList [ "jqFilterParser spaces test 1" ~: parseJqFilter " . " ~?= Right JqNil , "jqFilterParser spaces test 2" ~: parseJqFilter " . [ 0 ] " ~?= Right (JqIndex 0 JqNil) , "jqFilterParser spaces test 3" ~: parseJqFilter " . fieldName " ~?= Right (JqField "fieldName" JqNil) , "jqFilterParser spaces test 4" ~: parseJqFilter " . [ 0 ] . fieldName " ~?= Right (JqIndex 0 (JqField "fieldName" JqNil)) , "jqFilterParser spaces test 5" ~: parseJqFilter " . fieldName [ 0 ] " ~?= Right (JqField "fieldName" (JqIndex 0 JqNil)) ] -- ************************: jqQueryParserTest :: Test jqQueryParserTest = TestList [ "jqQueryParser test 1" ~: parseJqQuery "[]" ~?= Right (JqQueryArray []) , "jqQueryParser test 2" ~: parseJqQuery "[.hoge,.piyo]" ~?= Right (JqQueryArray [JqQueryFilter (JqField "hoge" JqNil), JqQueryFilter (JqField "piyo" JqNil)]) , "jqQueryParser test 3" ~: parseJqQuery "{\"hoge\":[],\"piyo\":[]}" ~?= Right (JqQueryObject [("hoge", JqQueryArray []), ("piyo", JqQueryArray [])]) ] jqQueryParserSpacesTest :: Test jqQueryParserSpacesTest = TestList [ "jqQueryParser spaces test 1" ~: parseJqQuery " [ ] " ~?= Right (JqQueryArray []) , "jqQueryParser spaces test 2" ~: parseJqQuery " [ . hoge , . piyo ] " ~?= Right (JqQueryArray [JqQueryFilter (JqField "hoge" JqNil), JqQueryFilter (JqField "piyo" JqNil)]) , "jqQueryParser spaces test 3" ~: parseJqQuery "{ \"hoge\" : [ ] , \"piyo\" : [ ] } " ~?= Right (JqQueryObject [("hoge", JqQueryArray []), ("piyo", JqQueryArray [])]) ] -- ***************** applyFilterTest :: Test applyFilterTest = TestList [ "applyFilter test 1" ~: applyFilter (unsafeParseFilter ".") testData ~?= Right testData , "applyFilter test 2" ~: (Just $ applyFilter (unsafeParseFilter ".string-field") testData) ~?= fmap Right (testData^?key "string-field") , "applyFilter test 3" ~: (Just $ applyFilter (unsafeParseFilter ".nested-field.inner-string") testData) ~?= fmap Right (testData ^? key "nested-field" . key "inner-string") , "applyFilter test 4" ~: (Just $ applyFilter (unsafeParseFilter ".nested-field.inner-number") testData) ~?= fmap Right (testData ^? key "nested-field" . key "inner-number") , "applyFilter test 5" ~: (Just $ applyFilter (unsafeParseFilter ".array-field[0]") testData) ~?= fmap Right (testData ^? key "array-field" . nth 0) , "applyFilter test 6" ~: (Just $ applyFilter (unsafeParseFilter ".array-field[1]") testData) ~?= fmap Right (testData ^? key "array-field" . nth 1) , "applyFilter test 7" ~: (Just $ applyFilter (unsafeParseFilter ".array-field[2].object-in-array") testData) ~?= fmap Right (testData ^? key "array-field" . nth 2 . key "object-in-array") ] executeQueryTest :: Test executeQueryTest = TestList -- [ "executeQuery test 1" ~: executeQuery (unsafeParseQuery "{}") testData ~?= Right (Object $ H.fromList []) [ "executeQuery test 1" ~: executeQuery (unsafeParseQuery "{}") testData ~?= Right (Object $ KM.fromList []) , "executeQuery test 2" ~: executeQuery (unsafeParseQuery "{ \"fielda\": . , \"fieldb\": .string-field }") testData ~?= -- Right (Object $ H.fromList [("fielda", testData), ("fieldb", String "string value")]) Right (Object $ KM.fromList [("fielda", testData), ("fieldb", String "string value")]) , "executeQuery test 3" ~: executeQuery (unsafeParseQuery "[ .string-field, .nested-field.inner-string ]") testData ~?= Right (Array $ V.fromList [String "string value", String "inner value"]) ] ----- testData :: Value -- testData = Object $ H.fromList testData = Object $ KM.fromList [ ("string-field", String "string value") -- , ("nested-field", Object $ H.fromList , ("nested-field", Object $ KM.fromList [ ("inner-string", String "inner value") , ("inner-number", Number 100) ] ) , ("array-field", Array $ V.fromList [ String "first field" , String "next field" -- , Object (H.fromList , Object (KM.fromList [ ("object-in-array", String "string value in object-in-array") ] ) ] ) ] unsafeParseFilter :: Text -> JqFilter unsafeParseFilter t = case parseJqFilter t of Right f -> f -- Left s -> error $ "PARSE FAILURE IN A TEST : " ++ unpack s Left s -> error $ "PARSE FAILURE IN A TEST : " ++ s unsafeParseQuery :: Text -> JqQuery unsafeParseQuery t = case parseJqQuery t of Right q -> q -- Left s -> error $ "PARSE FAILURE IN A TEST : " ++ unpack s Left s -> error $ "PARSE FAILURE IN A TEST : " ++ s main :: IO () main = do result <- runTestTT $ (TestList [ jqFilterParserTest , jqFilterParserSpacesTest , jqQueryParserTest , jqQueryParserSpacesTest , applyFilterTest , executeQueryTest ]) print result -- Parser.hs ****************************************** {-# LANGUAGE OverloadedStrings #-} module Data.Hjq.Parser ( JqFilter(..) , parseJqFilter , JqQuery(..) , parseJqQuery ) where import Text.Megaparsec import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L import Data.Void (Void) import qualified Data.Text as T import Data.Char () ------------------------------------------------------------ -- JqFilter 定義 ------------------------------------------------------------ data JqFilter = JqNil | JqField String JqFilter | JqIndex Int JqFilter deriving (Show, Read, Eq) type Parser = Parsec Void String ------------------------------------------------------------ -- JqFilter パーサ ------------------------------------------------------------ parseJqFilter :: T.Text -> Either String JqFilter parseJqFilter s = case parse (sc *> topFilter <* eof) "" (T.unpack s) of Left err -> Left (errorBundlePretty err) Right v -> Right v topFilter :: Parser JqFilter topFilter = schar '.' *> filterRest filterRest :: Parser JqFilter filterRest = try parseIndex <|> try parseField <|> pure JqNil parseField :: Parser JqFilter parseField = do name <- lexeme (some (letterChar <|> schar '-' ) ) rest <- option JqNil (schar '.' *> filterRest <|> parseIndex) return $ JqField name rest parseIndex :: Parser JqFilter parseIndex = do idx <- schar '[' *> lexeme L.decimal <* schar ']' rest <- option JqNil (schar '.' *> filterRest <|> parseField) return $ JqIndex idx rest ------------------------------------------------------------ -- JqQuery 定義 & パーサ ------------------------------------------------------------ data JqQuery = JqQueryObject [(T.Text, JqQuery)] | JqQueryArray [JqQuery] | JqQueryFilter JqFilter deriving (Show, Read, Eq) parseJqQuery :: T.Text -> Either String JqQuery parseJqQuery s = case parse (sc *> jqQueryParser <* eof) "" (T.unpack s) of Left err -> Left (errorBundlePretty err) Right v -> Right v jqQueryParser :: Parser JqQuery jqQueryParser = queryArray <|> queryObject <|> queryFilter queryArray :: Parser JqQuery queryArray = do _ <- schar '[' elems <- jqQueryParser `sepBy` schar ',' _ <- schar ']' return $ JqQueryArray elems queryObject :: Parser JqQuery queryObject = do _ <- schar '{' kvs <- qObj `sepBy` schar ',' _ <- schar '}' return $ JqQueryObject kvs where qObj = do key <- schar '"' *> (T.pack <$> some letterChar) <* schar '"' _ <- schar ':' val <- jqQueryParser return (key, val) queryFilter :: Parser JqQuery queryFilter = JqQueryFilter <$> topFilter ------------------------------------------------------------ -- 共通補助 ------------------------------------------------------------ sc :: Parser () sc = L.space space1 empty empty lexeme :: Parser a -> Parser a lexeme = L.lexeme sc schar :: Char -> Parser Char schar c = lexeme (char c) -- Query.hs ********************************************* {-# LANGUAGE OverloadedStrings #-} module Data.Hjq.Query where import Control.Lens import Control.Monad import Data.Monoid import Data.Hjq.Parser import Data.Aeson import Data.Aeson.Lens -- import Data.Text as T import qualified Data.Vector as V -- import qualified Data.HashMap.Strict as H import qualified Data.Text as T import Data.Aeson.Key (fromText) import qualified Data.Aeson.KeyMap as KM import qualified Data.Aeson.Key as Key applyFilter :: JqFilter -> Value -> Either T.Text Value applyFilter (JqField fieldName n) obj@(Object _) = join $ noteNotFoundError (T.pack fieldName) (fmap (applyFilter n) (obj ^? key (fromText(T.pack fieldName)))) applyFilter (JqIndex index n) array@(Array _) = join $ noteOutOfRangeError index (fmap (applyFilter n) (array ^? nth index)) applyFilter JqNil v = Right v applyFilter f o = Left $ "unexpected pattern : " <> tshow f <> " : " <> tshow o executeQuery :: JqQuery -> Value -> Either T.Text Value executeQuery (JqQueryObject o) v -- = fmap (Object . H.fromList) . sequence . fmap sequence $ fmap (fmap $ flip executeQuery v) o = fmap (Object . KM.fromList . fmap (\(k,v) -> (Key.fromText k, v))) . sequence . fmap sequence $ fmap (fmap $ flip executeQuery v) o executeQuery (JqQueryArray l) v = fmap (Array . V.fromList) . sequence $ fmap (flip executeQuery v) l executeQuery (JqQueryFilter f) v = applyFilter f v noteNotFoundError :: T.Text -> Maybe a -> Either T.Text a noteNotFoundError _ (Just x) = Right x noteNotFoundError s Nothing = Left $ "field name not found" <> s noteOutOfRangeError :: Int -> Maybe a -> Either T.Text a noteOutOfRangeError _ (Just x) = Right x noteOutOfRangeError s Nothing = Left $ "out of range : " <> tshow s tshow :: Show a => a -> T.Text tshow = T.pack . Prelude.show

よくわからないところを確認してみた。

Spec.hs

・applyFilterTestについて

   ^?  指定データを１部取り出したいとき使用(lens)

　nth 2 リストの３番目要素取り出し

   fmap Right (testData^?key "string-field") だと  fmap::(a->b)->f a->f bでみると

　(a->b)がRight　　f aがMaybe Value   f bがJustつまりMaybe(Either e Value)

　これにRightが適用なるようだ

Parser.hs

・queryArrayの　jqQueryParser `sepBy` schar ','　について

　　sepByは中値だが、２引数関数で　schar ','を区切りとして　jqQueryParserでパース

Query.hs

・applyFilter (JqField fieldName n) obj@(Object _)

  = join $ noteNotFoundError (T.pack fieldName) (fmap (applyFilter n) (obj ^? key (fromText(T.pack fieldName))))  について

   obj@(Object _)はObjectとか確認し、その値をobjとして利用可能

　joinはMaybeをはずすため

・executeQuery (JqQueryObject o) v

   = fmap (Object . KM.fromList . fmap (\(k,v) -> (Key.fromText k, v)))

    . sequence　②

    . fmap sequence　①

    $ fmap (fmap $ flip executeQuery v) o　　について        

    左辺の(JqQueryObject o) vは{"name":.name,"age":.age}::[(Text,JqQuery)]

    右辺の fmap $ flip executeQuery v のflipは引数を逆順にして、部分適用を意図した 通りにするために使う。(flip executeQuery v) q == executeQuery q v　

　 fmap (fmap $ flip executeQuery v) は、内側のfmapで( , )への処理を、外側のfmapで上の関数使って[  , , ]への処理を行う。

　　sequenceは①で　Eitherを外に出していく　[(either Text (Text,Value))]

        ②で　Ehter Text　[(Text,Value)]にする

　　　パーシングは、なかなか複雑

Haskell入門 P318

 スペースがある場合のパース

Spec.hs

{-# LANGUAGE OverloadedStrings #-} import Test.HUnit import qualified Data.Text() import Data.Hjq.Parser jqFilterParserTest :: Test jqFilterParserTest = TestList [ "jqFilterParser test 1" ~: parseJqFilter "." ~?= Right JqNil , "jqFilterParser test 2" ~: parseJqFilter ".[0]" ~?= Right (JqIndex 0 JqNil) , "jqFilterParser test 3" ~: parseJqFilter ".fieldName" ~?= Right (JqField "fieldName" JqNil) , "jqFilterParser test 4" ~: parseJqFilter ".[0].fieldName" ~?= Right (JqIndex 0 (JqField "fieldName" JqNil)) , "jqFilterParser test 5" ~: parseJqFilter ".fieldName[0]" ~?= Right (JqField "fieldName" (JqIndex 0 JqNil)) ] jqFilterParserSpacesTest :: Test jqFilterParserSpacesTest = TestList [ "jqFilterParser spaces test 1" ~: parseJqFilter " . " ~?= Right JqNil , "jqFilterParser spaces test 2" ~: parseJqFilter " . [ 0 ] " ~?= Right (JqIndex 0 JqNil) , "jqFilterParser spaces test 3" ~: parseJqFilter " . fieldName " ~?= Right (JqField "fieldName" JqNil) , "jqFilterParser spaces test 4" ~: parseJqFilter " . [ 0 ] . fieldName " ~?= Right (JqIndex 0 (JqField "fieldName" JqNil)) , "jqFilterParser spaces test 5" ~: parseJqFilter " . fieldName [ 0 ] " ~?= Right (JqField "fieldName" (JqIndex 0 JqNil)) ] main :: IO () main = do result <- runTestTT $ (TestList [jqFilterParserTest,jqFilterParserSpacesTest]) print result

Parser.hs

{-# LANGUAGE OverloadedStrings #-} module Data.Hjq.Parser ( JqFilter(..) , parseJqFilter ) where import Text.Megaparsec import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L import Data.Void (Void) import qualified Data.Text as T -- JqFilter の定義 data JqFilter = JqNil | JqField String JqFilter | JqIndex Int JqFilter deriving (Show, Eq) -- Megaparsec のパーサ型 type Parser = Parsec Void String -- Text を受け取り String に変換してパース parseJqFilter :: T.Text -> Either String JqFilter parseJqFilter s = --case parse topFilter "" (T.unpack s) of case parse (sc *> topFilter <* eof) "" (T.unpack s) of Left err -> Left (errorBundlePretty err) Right v -> Right v -- トップレベルのパーサ topFilter :: Parser JqFilter topFilter = do _ <- schar '.' -- 最初のドットを消費 filterRest -- ドットの後の要素を判断 filterRest :: Parser JqFilter filterRest = try parseIndex <|> try parseField <|> pure JqNil -- フィールド名パーサ parseField :: Parser JqFilter parseField = do --name <- some letterChar name <- lexeme (some letterChar) -- ★ 空白をスキップする rest <- option JqNil (schar '.' *> filterRest <|> parseIndex) return $ JqField name rest -- 配列インデックスパーサ parseIndex :: Parser JqFilter parseIndex = do --idx <- schar '[' *> L.decimal <* schar ']' idx <- schar '[' *> lexeme L.decimal <* schar ']' -- ★ rest <- option JqNil (schar '.' *> filterRest <|> parseField) return $ JqIndex idx rest -- 空白を処理するヘルパー sc :: Parser () sc = L.space space1 empty empty -- トークンラッパ lexeme :: Parser a -> Parser a lexeme = L.lexeme sc symbol :: String -> Parser String symbol = L.symbol sc -- 文字1個版（いわゆる schar） schar :: Char -> Parser Char schar c = lexeme (char c)

本ではscharが標準である？のかもしれないが、新しいライブラリにはないようで、作る必要があった。ChatGPTから作ってもらう。ついでに、以下のような説明もしてもらうが、 Megaparsec自体なじみがないので、難しい感じが。理解できるようになるためには、もう少し時間がかかりそう。

1. sc :: Parser ()

sc = L.space space1 empty empty

目的：空白やコメントをまとめてスキップする

L.space は Megaparsec が提供する空白スキップ用パーサ。

引数：

space1 → 1個以上の空白文字（' ', '\t', '\n'）をスキップ

empty → 行コメントの始まり（今回は使わないので空）

empty → ブロックコメントの始まり（今回は使わないので空）

つまり、この sc は「空白があるところを自由に無視する」パーサです。

2. lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc
目的：トークンを読んだあと、自動で空白をスキップする
使い方：
lexeme L.decimal    -- 数字を読み取ったあと、空白を消費
lexeme (some letterChar)  -- 識別子を読み取ったあと、空白を消費
イメージ：
入力: "123   "
lexeme L.decimal → 123 を返す、空白も消費ない場合は、後ろの空白が残り、パースが失敗しやすくなります。

3. symbol :: String -> Parser String
symbol = L.symbol sc
目的：記号（キーワードや演算子）を読んだあと空白をスキップ
例：
symbol "."  -- ドットを読み取り、空白も消費     symbol "["  -- 左ブラケットを読み取り、空白も消費      内部的には lexeme (string s) と同じような働きです。

4. schar :: Char -> Parser Char
schar c = lexeme (char c)
目的：単一文字のトークンを読み取り、空白をスキップ
文字 . や [ ] の後ろに空白があっても問題なくパースできる
例：
schar '.'  -- "." と後ろの空白をまとめて消費      schar '['  -- "[" と後ろの空白をまとめて消費

他にParser.hsで追加で確認したいところ：
・type Parser = Parsec Void String：  Void　エラーの型（ない）　　String　入力の型
　　Parsecのほうがカスタマイズしやすい　Parser a=Parsec Void String a     a：結果
・filterRest = try parseIndex <|> try parseField <|> pure JqNil
      try:失敗して消費しないなら　<|>の右へ　　失敗して消費したら<|>の右は試さない
      消費の意味：対象テキスト ab　でパーサーacなら消費する、対象テキストcdでパーサー　　
　　　　　　　　efなら消費してない
・  name <- lexeme (some letterChar) 
　　　someは１回以上繰り返し　　letterChar: a~zA~Zのパース
・  rest <- option JqNil (schar '.' *> filterRest <|> parseField)
　　　　option::   a      ->        Paser a       ->        Paser a
          　　　ディフォルト値　　試すパーサ　　　失敗したらaのディフォルト値返す

Haskell入門 P316 修正コード

 P316のコードが動作しなかったので、ChatGPTから同等のものに書き直してもらったのがこちら。新しいライブラリMegaparsecを使うといいらしい。

Parser.hs

{-# LANGUAGE OverloadedStrings #-} module Data.Hjq.Parser ( JqFilter(..) , parseJqFilter ) where import Text.Megaparsec import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L import Data.Void (Void) import qualified Data.Text as T -- JqFilter の定義 data JqFilter = JqNil | JqField String JqFilter | JqIndex Int JqFilter deriving (Show, Eq) -- Megaparsec のパーサ型 type Parser = Parsec Void String -- Text を受け取り String に変換してパース parseJqFilter :: T.Text -> Either String JqFilter parseJqFilter s = case parse topFilter "" (T.unpack s) of Left err -> Left (errorBundlePretty err) Right v -> Right v -- トップレベルのパーサ topFilter :: Parser JqFilter topFilter = do _ <- char '.' -- 最初のドットを消費 filterRest -- ドットの後の要素を判断 filterRest :: Parser JqFilter filterRest = try parseIndex <|> try parseField <|> pure JqNil -- フィールド名パーサ parseField :: Parser JqFilter parseField = do name <- some letterChar rest <- option JqNil (char '.' *> filterRest <|> parseIndex) return $ JqField name rest -- 配列インデックスパーサ parseIndex :: Parser JqFilter parseIndex = do idx <- char '[' *> L.decimal <* char ']' rest <- option JqNil (char '.' *> filterRest <|> parseField) return $ JqIndex idx rest

・type Parser =Parsec Void String     :Voidがエラーの型（ない）　Stringが入力の型
　　　Parser 　　a　　　　 =　　　Parsec Void String  a
　限られた使い方　aが結果　　　　　Parsecのほうがカスタマイズしやすいといえる
・try paraseIndex <|>   try parseField  <|> pure JqNil    で<|>は左が失敗したら右ためす
　　　tryは　失敗しても入力を消費せず次を代わりにためす　（入力を巻き戻す）
・some letterChar     :  some １回以上繰り返し　　letterChar　a~zA~Zのパース
・option JqNil  (char '.' *> filterRest <|>  parseField)
      option::  a -> Parser a -> Parser a    
         ディフォルト値->試すパーサ->失敗したら ディフォルトaを返す
      char '.' *> filterRest    :  .を消費し、filterRest返す
       ここではtry不要。すでにfilterRestの中でtryは終えているので

Haskell入門 P316

 このへんのパーサ扱ったところはかなりややこしくなっている。
結局、コードが古くてうまく動作せず、別のライブラリを使うことになった。

でも、いちおう、古いほうも、コードをいろいろ確認してみた。
・showParserResult $ parse (jqFilterParser <* endOfInput) s `feed` ""は
showParserResult $ (parse (jqFilterParser <* endOfInput) s) `feed` ""と同じ意味
<* endOfInput　該当しないところはパースせず　`feed` ""はパース停止の決まり文句のようなものらしい

・fmap pack $ many1 (letter <|> char '-' <|>..... digit())について
many1　は  letter <|> char '-' <|> ... <|> digit は 1文字分のパーサー
many1 (...) はこれを 1回以上繰り返して成功した結果をリスト [Char] にまとめる
fmap pack によって [Char] → Text に変換  
        letter :: Parser Char なので   many1 letter :: Parser [Char] になります。
箱（Parser）はそのままで　中身 [Char] が Text に変わる

・JqIndex ＜＄＞　パース１　＜＊＞　バース２　の意味について復習
＜＄＞で最初に部分適用の関数ができて、その関数のまだ未適用な部分に＜＊＞を順次適用していくしくみ
　パーサの場合、関数がつぎつぎと、無限に適用できる引数があるようなもの。その場合は、つねに、部分適用な関数のままでJqIndexが残ることになるといえそう。再帰状態になるのかも。

Haskell入門 P315 パーサの作成

 本のコードのままではだめで、けっこう厳密さが要求された。バージョンの違いか？

・型のスコープとインポートは明示的に
・Text と String は別物    (T.pack ".")で　Textに
・コンストラクタもエクスポートリストで見えるようにする     (..)など利用
・stack.yaml / package.yaml の依存関係はビルド対象ごとに確認(ライブラリも指定）

といった注意も必要なことがわかる。

ちなみに修正したものは

Spec.hs
import Test.HUnit import System.Exit (exitFailure, exitSuccess) import Data.Hjq.Parser (JqFilter(..)) import Data.Hjq (parseJqFilter) import qualified Data.Text as T main :: IO () main = do counts <- runTestTT $ TestList [ jqFilterParserTest ] if errors counts + failures counts == 0 then exitSuccess else exitFailure jqFilterParserTest :: Test jqFilterParserTest = TestList ["jqFilterParser test 1" ~: parseJqFilter (T.pack ".") ~?= Right JqNil ]
Parser.hs
module Data.Hjq.Parser ( JqFilter(..) ) where import qualified Data.Text as T data JqFilter = JqField T.Text JqFilter | JqIndex Int JqFilter | JqNil deriving (Show,Read,Eq)
Hjq.hs
module Data.Hjq where import qualified Data.Text as T import Data.Hjq.Parser (JqFilter(..)) parseJqFilter :: T.Text -> Either String JqFilter parseJqFilter _ = Right JqNil
package.yaml
library: source-dirs: src dependencies: - base >= 4.7 && < 5 - text >= 2.1.2 executables: hjq-exe: dependencies: - hjq - text >= 2.1.2 tests: hjq-test: dependencies: - hjq - HUnit - text >= 2.1.2

Haskell入門 P314 HUnitによる自動テスト

 テストファーストの考え方をとっているようで、最初にテストの方法がでていた。
ただ、本の内容はバージョンが古くそのままでは動かなかった。
・Test suite not yet implementedとでるので
　　package.yamlにtest:hjq-test:dependencies:のところに - HUnitを追加
　　Spec.hs　の先頭にimport Test.HUnit　追加
・文字エンコードでエラーがでるので
　　Dosプロンプトのショートカットに　cmd /k "chcp 65001 &&  cd　パス"のように、事前にエンコード切り替えをいれる
・runTestTTの型が新しいバージョンでは　返り値が IO Countsというものらしいので
　以下のようなコードにするらしい。

import Test.HUnit
import System.Exit (exitFailure, exitSuccess)
main :: IO ()
main = do
    counts <- runTestTT $ "Test1" ~: 1 + 1 ~?= 2
    if errors counts + failures counts == 0
        then exitSuccess
        else exitFailure

これで、ようやく、うまく動作した。

Haskell入門P286

以下のコードの目的は、子スレッドのエラーがメインスレッドに影響しないようにしたいため、隔離しているようです。

actionIO ::  IO a -> IO a
actionIO  action = do
 mv <- newEmptyMVar :: IO (MVar (Either SomeException a))
 _tid <- forkIO $ do
  result <- try acttion
  putMVar mv result
 result <- takeMVar mv
 case result of
  Left e -> throwIO e
  Right r -> return 

1. actionIO :: IO a -> IO a

IO aのアクションを引数にとり、結果もIO aとして返す関数です。引数のactionを別スレッドで実行し、その結果を取得します。

2. mv <- newEmptyMVar :: IO (MVar (Either SomeException a))

新しい空のMVarを作成します。MVarはスレッド間で値のやり取りができる同期変数です。

型は MVar (Either SomeException a) としています。Either SomeException aは、「例外が起きたか」あるいは「正常に値が得られたか」を表すために使います。

3. _tid <- forkIO $ do ...

forkIOで新しい軽量スレッドを作り、その中でactionを実行します。

forkIOはスレッドIDを返しますが、このコードでは使わないので_tidとして無視しています。

4. result <- try action

tryは、例外が発生する可能性があるIOアクションを安全に実行し、成功時はRight a　例外発生時はLeft SomeExceptionの形で結果を返します。

5. putMVar mv result

mv（空のMVar）に結果を格納します。これでメインスレッドはこの結果を待つことができます。

6. result <- takeMVar mv

メインスレッドで、mvに格納されるまで待ちます。forkIOの中の処理が終わりputMVarが呼ばれるまでブロックされます。

Haskell入門 P285 MVarによるスレッド間の通信

 ChatGPTもlevel5になって、さらにバージョンアップした感じです。

本を読んでも、なかなか理解しにくかったところも、ChatGPTにコードを解説してもらうとすぐに理解できたので、質問者のレベルに合わせて説明できる能力に驚いています。

import Control.Concurrent main :: IO () main = do m <- newEmptyMVar -- スレッド生成 forkIO $ do tid <- myThreadId putStrLn $ show tid ++ ": doing ... heavy ... task ..." threadDelay 2000000 putMVar m () takeMVar m putStrLn "Done"

・m <- newEmptyMVar newEmptyMVarで空のMVarを作成  これはスレッド間の通知用の「信号」として使う予定

 ・forkIOで新しい軽量スレッドを作成。

  この新しいスレッドの中で、myThreadIdでスレッドIDを取得し、コンソールに表示。

  ・putMVar m ()で空のMVarに通知（単なる空のタプル () を入れているだけ）を送る。

  ・メインスレッドはtakeMVar mで、MVarに値が入るのを待つ（ブロックされる）。

  子スレッドが2秒後にputMVarで通知すると、この待機が解除される。       

  ・メインスレッドは、子スレッドが終わったことをMVar経由で待機している。

  　子スレッドは、重たい処理の後にMVarに通知し、メインスレッドに処理完了を知らせる。

 ※　putMVar m ()　は、普通は　MVar aにaを入れる（例えばMVar IntにIntを入れるように）。今は()を入れているが、これはCでいえばVoid　scalaでいえば、Unitみたいなもの。

今年から市民農園再開

 しばらくやめていた市民農園に再挑戦で、今年は小玉スイカの空中栽培も試してみた。植え付け時は、炭疽病を心配し、乗り越えたかと思えば、今度はウリハムシ、そして受粉がなかなかうまくいかないとか、いろいろありましたが、今のところ、それほど雨に悩まされることなく病気の症状もおさまっているようです。このまま梅雨明けしてくれるといいのですが。

　

　虫や病気の心配も少なくネットもいらず、片付けも楽、意外と手間がかからず、コンスタントに収穫できるのがつるなしインゲンです。

　

　※小玉スイカは、受粉日のタグをつけて３５～４０日後に収穫したところ、ちょうどよい甘さになりました。2025/7/25

ロープの結び方

 畑作業でもよく使うので、男結び等について　図にまとめてみました。（トラックロープの結び方は南京結びともいうようです。）　他にも、巻き結び、もやい結び、結束結び、自在結び、ひとえつぎ結び等、覚えておくと便利なようです。

GASではJSON.stringfyをつかったほうがいいようです

 畑の収穫記録をGASで管理（収穫の個数を記録しその都度、合計の確認）しようかと、ChatGPTにコード頼んでみたけど、なかなか一筋縄ではいかない。AIにより、だいぶコーディングは楽になっているが、やはり、ある程度やりとりしながら、人間側が修正してあげないと動かなかった。

　最初、ChatGPTはサーバ（GAS）からのレスポンスデータを単純にオブジェクトで渡すコードを提示してくれたけれど、それではうまくいかず、やはり、JSON.stringfyを使わないとだめだった。

//***********************html.index************************** <!DOCTYPE html> <html> <head> <base target="_top"> <style> body { font-family: sans-serif; margin: 20px; } label, select, input, button { margin: 5px; } div.result-entry { margin-top: 10px; } </style> </head> <body> <h2>畑の収穫記録</h2> <label>野菜：</label> <select id="vege"></select> <label>個数：</label> <input type="number" id="count" min="1" value="1" /> <br> <label>メモ：</label> <ttextarea id="memo" name="memo" rows="5" cols="40"></ttextarea>　←ttextareaをtextareaに変更必要 <button onclick="submitData()">登録</button> <div id="result"></div> <h3 id="totalSum">合計金額: -- 円</h3> <br /> <a href="https://docs.google.com/spreadsheets/d/シートID/edit?gid=0#gid=0">Sheet</a> <script> let vegeData = {}; function loadVegetables() { google.script.run.withSuccessHandler(function(data) { vegeData = data; const select = document.getElementById("vege"); for (let key in data) { const opt = document.createElement("option"); opt.value = key; opt.text = key; select.appendChild(opt); } }).getVegetables(); } function submitData() { const name = document.getElementById("vege").value; const count = parseInt(document.getElementById("count").value); const memo = document.getElementById("memo").value; console.log("name:", name, "count:", count); if (!name || !count || count < 1) { alert("野菜と個数を正しく入力してください。"); return; } google.script.run.withSuccessHandler(displayResult).addRecord({ name: name, count: count,memo: memo }); } function displayResult(res) { let response = JSON.parse(res); const r = response.record; const div = document.getElementById("result"); const entry = document.createElement("div"); entry.className = "result-entry"; entry.innerHTML = `<strong>${new Date(r.date).toLocaleString()}</strong> - ${r.name} (${r.count}個 × ${r.unitPrice}円) = <strong>${r.total}円</strong><br>MEMO:<BR>${r.memo.replace(/\r?\n/g, "<br>")}`; //entry.innerHTML = `<strong>date</strong> - name 1個 × 100円) = <strong>200円</strong>`; div.appendChild(entry); document.getElementById("totalSum").innerText = `合計金額: ${response.totalSum} 円`; } loadVegetables(); </script> //*************コード.js**************** const SPREADSHEET_ID = 'シートID'; const SHEET_NAME = 'Records'; // シート名（1枚目なら "Sheet1" のままでもOK） // 野菜マスタ（名前と単価） const vegetablePrices = { "トマト": 100, "ナス": 80, "キュウリ": 50, "ピーマン": 60, "ゴーヤ": 60, "インゲン": 5, "スイカ": 300, "ミニトマト": 10, "サツマイモ": 130, "サトイモ": 60, "シソ": 5, "エダマメ": 10, }; function doGet() { return HtmlService.createHtmlOutputFromFile('index'); } function getVegetables() { return vegetablePrices; } function addRecord(data) { const ss = SpreadsheetApp.openById(SPREADSHEET_ID); // const ss = SpreadsheetApp.getActiveSpreadsheet(); const sheet = ss.getSheetByName(SHEET_NAME); if (!sheet) { Logger.log('シート名「' + SHEET_NAME + '」は存在しません'); } else { Logger.log('シート名「' + SHEET_NAME + '」が見つかりました'); } const name = data.name; const count = Number(data.count); const unitPrice = vegetablePrices[name] || 0; const total = unitPrice * count; const date = new Date(); const memo = data.memo sheet.appendRow([date, name, count, unitPrice, total,memo]); const sum = getTotalSum(); // 合計金額取得 // return { // record: { date: date, name: name, count: count, unitPrice: unitPrice, total: total },totalSum: sum // }; return JSON.stringify({record: { date: date, name: name, count: count, unitPrice: unitPrice, total: total ,memo : memo},totalSum: sum }); } function getTotalSum() { const ss = SpreadsheetApp.openById(SPREADSHEET_ID); const sheet = ss.getSheetByName(SHEET_NAME); const data = sheet.getRange(2, 5, sheet.getLastRow() - 1).getValues(); // 合計金額列 return data.reduce((sum, row) => sum + (Number(row[0]) || 0), 0); }

※　MEMO欄を追加しました。2025/6/27

ガロア理論入門（アルティン） 問１１－３（２）

P117　ｐ素数　Φp^n(x)=Φp(x^(p^(n-1)))が既約であることを示す問題の途中の変形がしばらくわからず悩む。

Φp(x^(p-1)+(pでわりきれる項）＋１）＝{x^(p^(n-1))＋（ｐでわりきれる項)}^(p-1)＋（ｐで割り切れる項）＋ｐとなる理由

∵前問で①Φp(x+1)=((x+1)^p-1)/((x+1)-1)=x^(p-1)+Σk=1~(p-2)　pCk x^(p-k-1)+p が言えていたので、これを使うとよいことにきづく。今の場合、X＝x^(p-1)+(pでわりきれる項）　としてこれを①のxをXで置き換えるとうまくいくようです。

　前問をつかっているということに、きづかなかったためしばらく悩みました。よく読むと問題にも（１）と同様にして解く　と書いてあるのを見逃していました。

アルティンのガロア理論入門 P106

 途中の式変形で、すこし手こずる。x^(q^n)-α^(q^n)-(x-α)を(x-α）で割ってから、x=αを代入した式がq^n*α^(q^n-1)-1となることを示したい。ChatGPTにすぐ頼ってしまったが、いまいちすっきりしない。

　与式をf(x)とすると　　f(x)=(x-α)h(x)とみなし　h(x)=f(x)/(x-α)だから、h(x)=f'(x)とみなせるからという説明だった。たしかに、x→αでは、解析的には微分だが、、、、(自分には高度すぎる？）。

　と、少し間をおいてあらためて考えると 単純に式の割り算をすると、

Σ i=0~q^(n-1)     α^i*x^(q^n-i-1) 　-1  となることに気づく。これにx=αを入れると、結論が言えるようだ。自分としては、こちらのほうが納得できる。

モナドの活用

 Haskell入門　を久しぶりに読み直してみた。P168にMaybeモナドについて少し復習してみた。

getItemWithMonad menu category name =do
  subMenu <- lookup category menu
  price <- lookup name subMenu
  return (category,name,price)

途中、Nothingを記述しなくても自動的に、該当しなければ、最後はNothingになる。うまくできていると思う。
これを、手続き型言語で、実現しようとすると条件分岐に頼らざるを得ないけど、その必要もない。
このへんが、関数型言語のモナドの強みなのかもしれない。

追記＞試しに、ChatGPTで、ELMのMaybeを使うコードに変換してみた。ELMはモナドをサポートしていないため、少しコード量が増えてしまうようだ。

type alias Menu = Dict String (Dict String Float)

getItemWithMonad : Menu -> String -> String -> Result String (String, String, Float)

getItemWithMonad menu category name =

    case Dict.get category menu of

        Just subMenu ->

            case Dict.get name subMenu of

                Just price -> 

                    Ok (category, name, price)

                Nothing -> 

                    Err "Item not found"

        Nothing -> 

            Err "Category not found"

1960年代からの国債残高の増加率をグラフにしてみた。

 

　国債の増え方が話題になっているようなので、実際のところどうなのか、公式データを加工して処理してみました。この計算の仕方が、実際の増え方を表しているかどうか議論のあるところかもしれませんが、ある程度の参考にはなりそうです。

　縦軸は前年比の増加率（％）です。ちなみに、1873年　0.234億円　2024年 11053645億円ということのようなので　この期間の１年あたりの平均増加率を計算すると (11053645/0.234)^(1/(2024-1873))=1.124　　　ということで、ほぼ12%程度です。

　１９８５年あたりから１０％切るようになっていますね。それ以来ほとんど、(1998年以外は)平均に届いてないようです。

追加：ちなみに、近年のものですがアメリカも調べてみました。日本のように、５％切ることは少ないような感じです。

ルベーグ積分 理論と計算手法 P199

 補題9.13(2)でまた、つまづいてしまった。仕方なく、だめもとでChatGPTに頼ってみたら、きちんと回答してくれた。AIの力も凄いものだと驚きました。ここ何か月間の間にパワーアップした？

　質問は　「ルベーグファトウの定理を使い、∫A  max k≦n fk μ ≦　ν(A)  から ∫ sup n∈N  fn  μ ≦ ν(A)をいえますか？」としました。 回答に少し補足を入れてまとめてみた。

∵）　gm=max k≦n fk  （これは増加列　①）として  　定理を適用すると

∫A  lim inf n→∞  gn  μ ≦ lim inf n→∞　∫A gn μ

左辺は  ∫A sup n∈N fn μ　　②                       ↓ここで①を使う

また　sup n∈N inf k≧n gn  = lim n→∞ inf gn=lim n→∞ gn  =sup n∈N fn   これが②の理由

∫A gn  μ　≦　ν(A)  で n→∞　ならば　　lim inf n→∞　∫A gn μ≦　ν(A)

ゆえに　結論　　∫A  sup n∈N fn　μ　≦　ν(A)

定理に必要な優関数がないので、質問したら、優関数はf1(x)という回答。専任の家庭教師がついているような感覚になる。

Σsinkx/k の求め方で苦戦

 ルベーグ積分　理論と計算手法　P183　例8.9(1)で、

∞
Σsinkx/k=(π-x)/2  (2π>x>0)になる理由がわからず、苦戦。

log(1-z)を微分し　-1/(1-z) = Σz^n　なので

積分して　　log(1-z)=-∫Σz^n dz =-Σ∫z^n dz  = - Σ z^(n+1)/(n+z) 

 = - Σ z^n/n  (Σが n=0からとなっていたのをn=1からとすることで変形）

これを使うと

Im(log(1-e^ix))=-ΣIm(e^ixk)/k   = -Σ sin kx /k

これは arg(1-e^ix)=-(π-x)/2　(0<x<2π)　でもある

∵）log(re^ix)=logr+log(e^ix)=logr+ix

∵) 1-e^ix=(1-cosx)-isinx      r=√((1-cosx)^2+sin^2x =2sin(x/2)

 -sinx / 2sin(x/2)=sinΘ　なら　Θ=-(π-x)/2になる。

∵） 2sin(x/2)sin((π-x)/2) = sinx  このへんは地道に三角関数の計算を確認すると

　　確かにそうなる。それにしても計算が大変だった。

フーリエ級数使うともう少し楽に計算する方法もありそうなので、そちらも試してみたい。

追記(2/22)：その後、ディリクレージョルダンの定理(P182)を使うと、計算できることが確認できた。

f(x)=-x/(2π)+1/2*sgn(x)　として bk=1/kとできるので、これを定理に適用するといいようだ。最初うまくいかなかったのは、ちょっとした計算ミスのためだった。だいぶ遠回りしてしまった。

ついでに、(2)も解いていみた。

x∈(-2π,2π)を　x'=x/2∈(-π,π)とすると　　2Σsin2kx'/2k=Σsin2kx'/k=-x'+π/2*sgnx'

（１）より 2(-x/2+π/2*sgnx)=2Σsinkx/k=2( Σsink2x/2k   + Σsin(2k-1)x/(2k-1) )

=-x+π/2*sgnx  + 2*(求めたい式）となるが、これを整理すると

　求めたい式＝ Σsin(2k-1)x/(2k-1)=π/4*sgnxとなる。

PC用CW発振器（ツインT型）作成

 peanutでは、PCでCW交信ができるようになっているが、そのための発振器を作ってみた。最初、２SC1815と２SA1015を組み合わせた簡易的なものを試したが、周波数がうまく変えられなかったので、ツインT型を試したらうまくいった。入力はUSBへの変換アダプタを使うことにしている。

以前作成したPICによるキーヤーのコレクタ部分に上記回路のアースを接続することで、うまく動作させることができた。

追記：送信練習用に、以前作ったモールスデコーダにもつなげるようにしてみた。ただ、音量が不足していたので、こちらのサイトを参考させていただき、一石のアンプを追加した。マイクを通さず、デコーダにつなぐと、雑音の影響がなくなり、ほぼ１００％の認識率になるようです。送信練習にはとても役立ちます。

JMoocに少し挑戦してみた

 　無料の大学講座JMoocに興味を持ち、少し勉強してみた。修了証もらうまで行く人が１割ということらしい（無料ということとも影響している？）。単元テストは計算力を必要とされる問題が多く時間がかかった。

　抵抗２つ、コンデンサ２つを並列や直列組み合わせた回路で、抵抗値が流れる電流に影響しなくなる条件を求めよという問題や、交流回路の複素計算など、ちょっとしたミスがあるとなかなか解けなかったりする。久しぶりに、繁分数の式を変数に置き換えたり、〇.〇×10^△の形にして、少しでも計算が楽にならないか考えたり、LTSPiceなどPCの便利な計算に慣れてしまった昨今、逆に脳にはいい刺激になるかもしれないと思った。後半の三相交流の話になってくると、電力なども含めて考えると複雑になってきた。

　電気回路に続いて、電子回路も受講、電気回路が物理に近い内容で計算中心だったが、電子回路のほうほ工学的内容だった。後半は集積回路に組み込むために容量の大きなコンデンサを使わない回路の工夫について説明があった。MosFETなどＨＦリニアアンプの製作にもいろいろと役立つ情報があった。とりあえず、２つの講座ともなんとか修了できた。

中足骨骨頭痛

 　以前から、歩くと靴の中に小石があるような痛みがあり、でも確かめると何もないという症状ががあり気になっていたが、よく調べると中足骨骨頭痛という症状らしい。足のアーチが弱くなるのが原因らしい。歩き方も踵に重心が来るように歩くといいらしい（足を前に出そうとするのでなく、上にあげてそのまま真下に落とすという感覚）。この症状が出ているときは、ウオーキングもほどほどにしたほうがいいようだ。

USB電力不足

 　以前から気になっていたけれど、デスクトップPCのバスパワーＵＳＢハブが電力不足のためか、マウス以外つなげない状態。試しに、ケーブルの途中に三又状態にして、余ったＵＳＢ充電アダプタとUSBプラグを使って５Ｖを追加できるようにしてみたらうまくいった（若干コネクタ部分の接触が気になる感じはあったが、ＰＣからの経路すべてに接点復活材をスプレーしたらだいぶ改善された）。

　本来であれば、セルフパワーのＵＳＢハブを購入すればいいのだろうけど、数千円はするので、余り物でなんとかできたので、少し節約はできたかもしれません。（というか、これ以上、５Ｖ電源アダプタは増やしたくなかったというのもありますが）

ChatGPTは計算が苦手？

 ルベーグ積分理論と計算手法P159の計算をChatGPTに聞いてみたが、書籍の答えと一致しない。

∫(0,+∞) (y/(y^x+1) - y/(y+1)^2) λ(dy)　が確かlog2と答えた。

正しくは、たぶん

[　log(y^2+1) /2 -  (  y/(y+1)  -  ∫1/(y+1)λ(dy) )　] (0,∞) 　かと思う。

                                ↑部分積分

上記で計算すると確かに１になるので。

ChatGPTも、人間と同じようにまだ間違うこともあるようだ。

ChatGPTはLLMなので、どちらかというと帰納的推論？なのかもしれない。対して、wolframなどは、演繹的推論らしいけれど。。

それにしても、AIで、プログラミングもそうですが、いろんな独学もだいぶやりやすくなったと思う。

PIC12F1822(CPS)の実装

 ブレッドボードでの実験はなんとかうまくいきそうなので、実装してみた。これからケースに収める予定。静電容量計測のケーブルもコネクタで取り外しできるようにしてみた。

　前回、arduinoで灯油残量センサを作ったときは、誘導雷で壊れたこともあるので、灯油タンクまでの配線が長くなるので、サージアブソーバのようなものもつけないとだめかもしれない。

追記：CPSを測定しているが、灯油タンクに、導線２本入れて試しているものの、なぜか、測定値が安定しない。原因はまだ不明。おそらく、タンクまでの配線の容量が大きく、また、温度等でRC発信周波数が安定しないためかと思われる。

PIC12F1822でCPSの実験（AQM1602Aを使用)

 　静電容量の変化をCPSという機能で確認できるらしいので、実験してみた。以前、灯油タンクの残量検知を超音波センサとarduinoで試したがうまくいかなかったので、静電容量を使ってできないか、そのうち試してみたいという目的もあります。

・カウントのオーバーフローするとマイナス表示になるようなので、delay関数の値を調整する必要があった。

・RA3を入力で使えるようにしたかったので、#pragma config MCLRE = OFF  #pragma config LVP = OFF とするとよいという情報がネット上にあった。（LVPの必要性はよくわからない？が）

・RA5のLED出力とRA3のスイッチ入力は、とくに機能は実装していないけれど、今後の何らかの機能が必要になったときのために、コードで反応を確認してみた。

・少しわかりにくかったのは、秋月電子のLCD（AQM1602A）のコントラストがコードで設定するようになっていたこと。以下の(1)は72の２の部分が4bitで　(2)は0101の4bitで5で　0100が4ですが、その下位2bitのみ関係しているので、00→01→10→11 で54~57の範囲になります。

　　LCD_cmd(0x72);  //Contrast set                 下位4bits...(1)
    LCD_cmd(0x54);  //Power/ICON/Contrast Control  下位2bits...(2)  
　  (2)と(1)あわせて　2^6=64 stepの範囲から指定するという意味だった。（(2)のほうが上位）   ※5Vだと上記ぐらいの値だけれど、3.6v(ニッケル水素充電池3本）だと、(1)0x73 (2)0x55ぐらいが必要だった。

// CONFIG1 #pragma config FOSC = INTOSC // Oscillator Selection (INTOSC oscillator: I/O function on CLKIN pin) #pragma config WDTE = ON // Watchdog Timer Enable (WDT enabled) #pragma config PWRTE = OFF // Power-up Timer Enable (PWRT disabled) #pragma config MCLRE = OFF // MCLR Pin Function Select (MCLR/VPP pin function is digital input) #pragma config CP = OFF // Flash Program Memory Code Protection (Program memory code protection is disabled) #pragma config CPD = OFF // Data Memory Code Protection (Data memory code protection is disabled) #pragma config BOREN = ON // Brown-out Reset Enable (Brown-out Reset enabled) #pragma config CLKOUTEN = OFF // Clock Out Enable (CLKOUT function is disabled. I/O or oscillator function on the CLKOUT pin) #pragma config IESO = ON // Internal/External Switchover (Internal/External Switchover mode is enabled) #pragma config FCMEN = ON // Fail-Safe Clock Monitor Enable (Fail-Safe Clock Monitor is enabled) // CONFIG2 #pragma config WRT = OFF // Flash Memory Self-Write Protection (Write protection off) #pragma config PLLEN = ON // PLL Enable (4x PLL enabled) #pragma config STVREN = ON // Stack Overflow/Underflow Reset Enable (Stack Overflow or Underflow will cause a Reset) #pragma config BORV = LO // Brown-out Reset Voltage Selection (Brown-out Reset Voltage (Vbor), low trip point selected.) #pragma config LVP = OFF // Low-Voltage Programming Enable (Low-voltage programming enabled) ****off for use RA3 #include <xc.h> #include <stdio.h> #include <stdlib.h> #include <string.h> // クロック周波数指定 //-------------------------------------------------------------- #define _XTAL_FREQ 32000000 #define LCD_addr 0x7C // プロトタイプ宣言 //-------------------------------------------------------------- void I2C_init(void); void I2C_start(void); void I2C_stop(void); void I2C_write(unsigned char dat); void LCD_cmd(unsigned char cmd); void LCD_char(unsigned char dat); void LCD_init(void); void LCD_clear(void); void LCD_home(void); void LCD_cursor(unsigned x,unsigned y); /*　　 　　　　　 　 12F1822 * ?????? * VDD ?| 1 8 |? VSS * RA5 ?| 2 7 |? AN0/RA0 * CPS**AN3/RA4 ?| 3 6 |? AN1/RA1/SCL → LCD(SCL) * RA3 ?| 4 5 |? AN2/RA2/SDA → LCD(SDA) * ?????? */ void main(void) { char s[8] ; unsigned cap ; OSCCON = 0b01110010 ; // 内部クロックは8ＭＨｚとする // OSCCON = 0b01110000; // 内部クロック周波数：8MHz ANSELA = 0b00010000 ; // アナログはAN3(RA4)を使用し、残りをすべてデジタルI/Oに割当 >>>Capacity TRISA = 0b00011110 ; // AN3(RA4/CPS3) 入力その他のピンは出力に割当てる(RA3は入力) RA5>>LED SCL[6Pin]、SDA[5Pin]を入力ピンに設定 PORTA = 0b00000000 ; // 出力ピンの初期化(全てLOWにする) // 容量検知モジュール(ＣＰＳＭ)の設定 CPSCON0 = 0b00001000 ; // オシレータは中範囲(中速の発信周波数)で利用する CPSCON1 = 0b00000011 ; // CPS3から入力する // タイマー１の設定 T1CON = 0b11000001 ; // 容量検知オシレータでTIMER1をｶｳﾝﾄする、ﾌﾟﾘｽｹｰﾗｶｳﾝﾄ値 1:1 TMR1H = 0 ; // タイマー1の初期化 TMR1L = 0 ; PEIE = 1 ; // 周辺装置割り込みを許可する GIE = 1 ; // 全割り込み処理を許可する CPSON = 1 ; // 容量検知モジュール開始 //---------------------------------------------------------- // シリアル通信（I2C）初期設定 //---------------------------------------------------------- SSP1STAT = 0b10000000; // 標準モード(100kHz) SSP1CON1 = 0b00101000; // マスター（制御する側）に設定 SSP1ADD = 0b01001111; // 通信速度 = Fosc/(4*Clock)-1 = 32MHz/(4*100kHz)-1 = 79（10進数） // ディスプレイの初期化 LCD_init(); RA5=1; //LED On LCD_cmd(0x80); // １列目に表示 printf("cap count:"); // ２列目に表示 LCD_cmd(0xC0); printf("Initializing.."); while (1) { LCD_cmd(0xC0); printf("%10d",cap); if(RA3 == 0){ RA5=1; }else{ RA5=0; } CPSON = 0 ; // 容量検知モジュール停止 cap =(unsigned) (TMR1H*256) + TMR1L ; // カウント値を読み込む TMR1H = 0 ; // タイマー1の初期化 TMR1L = 0 ; CPSON = 1 ; // 容量検知モジュール開始 // RA5=1; __delay_ms(10) ; } return; } void I2C_start() { SEN = 1; while(SEN); } void I2C_stop() { SSP1IF = 0; PEN = 1; while(PEN); SSP1IF = 0; } void I2C_write(unsigned char dat) { SSP1IF = 0; SSP1BUF = dat; while(!SSP1IF); } void LCD_init() { __delay_ms(40); //40ms wait LCD_cmd(0x38); //8bit,2line LCD_cmd(0x39); //IS=1 : extention mode set LCD_cmd(0x14); //Internal OSC Frequency LCD_cmd(0x72); //Contrast set Lower4bits...(1) LCD_cmd(0x54); //Power/ICON/Contrast Control Lower2bits...(2) (2)(1)=64bit step LCD_cmd(0x6C); //Follower control __delay_ms(200);//200ms wait LCD_cmd(0x38); //IS=0 : extention mode cancel LCD_cmd(0x0C); //Display ON LCD_cmd(0x01); //Clear Display __delay_ms(2); //wait more than 1.08ms } void LCD_cmd(unsigned char cmd) { I2C_start(); I2C_write(LCD_addr); I2C_write(0x00); // 0x00（コマンドの送信を示すbit） I2C_write(cmd); I2C_stop(); } void putch(unsigned char text) { I2C_start(); I2C_write(LCD_addr); I2C_write(0x40); // 0x40（データの送信を示すbit） I2C_write(text); I2C_stop(); }

デスクトップPCをraspi経由で電源On

 PCの電源Onは、USB、内部タイマー、キーボード等々いろいろあるけれど、スリープ状態にするため、夜間勝手にアップデートなどでOnなるのも気になるので、完全にraspiで操作できるようにしてみた。

　PCの電源は、導通でOnなので、例によってトランジスタ2sc1815を使った。raspiのGPIOは出力が3.3Vで、前回ブルーレイな場合と同じ回路（raspiのGPIOからトランジスタ経由でPCスイッチへ）にしてみたらうまくいった。最初、マザボピンの分岐コネクタに手持ちのピンでつないだが、接触不良起こしやすいようだったので、はんだ付けにする。PCの余分な穴にDC電源用のソケットをグルーガンで固定して、raspiとの接続ケーブルを取り外しできるようにした。（raspi側にも同様にソケットをつける。）

極限の計算のコツ

ルベーグ積分理論と計算手法P152　あたりで、ちょっとした極限の計算が分からない。最近は、どうにも解決できそうにないときChatGPTに聞くことにしている。

　1<α<3   lim x→0   (sinyx-yx/(1+x^2))/αｘ^α　が、さらっと０になることが書いてあるが、理由がわからなかった。

　こういうときは、いろいろ展開を使うといいらしい。

　　　sin yx = sin0 +yx*cos0 -(yx)^2*sin0/2! -(yx)^3*cos0/3!.....

        =yx-(yx)^3/6   ①

       1/(1+x^2)=1+(-x^2)+(-x^2)^2+(-x^2)^3+.....

        なので  yx/(1+x^2)=yx(1-x^2+x^4...)=yx-yx^3+yx^5.....  ②

　　　与式=(①-②)/αx^α=(y-y^3/6)x^3... /αx^α だが

　　　　　α<3より  3-α>0　で x→0なら　　確かに　x^(3-α)　→　0がいえるようだ。（最初、ChatGPTも途中の計算間違っていたので、再度、確認したら正しい説明をしてくれた。やはり、ChatGPTにとっても少し難しくなるとミスもしやすくなるんだろうか？）

　学生時代にこういった勉強も多少はやったはずだけど、ほとんど記憶に残っていない、やはり使わないと忘れてしまうようです。

raspiで秋月のSSR操作

 raspiにSSRを組み合わせてタイムスイッチつくってみた。

秋月電子のSSRキット(ゼロクロス、25A)を使った。100Vなので絶縁には細心の注意が必要。たまたま、先日、分解廃棄したDVDレコーダの中からヒートシンクを取り出していたので、早速活用。

フォトカプラを使っているようで、入力で15mmA消費とあったので、raspiのGPIOでも許容範囲であり、そのままつなげている。

ChatGPTに助けてもらい、以下のようなスクリプトを使ってうまく動作させることができた。(rapiでは、OSの中にすでに以下のようなスクリプトが使える環境がある）

*****ssr_control.sh**********

#!/bin/bash
GPIO_PIN=3  # GPIO3
if [ ! -d /sys/class/gpio/gpio$GPIO_PIN ]; then
    echo "$GPIO_PIN" > /sys/class/gpio/export
    echo "out" > /sys/class/gpio/gpio$GPIO_PIN/direction

fi
if [ "$1" == "on" ]; then
    echo "1" > /sys/class/gpio/gpio$GPIO_PIN/value
elif [ "$1" == "off" ]; then
    echo "0" > /sys/class/gpio/gpio$GPIO_PIN/value
else
    echo "Usage: $0 {on|off}"
    exit 1
fi

cronを設定すれば、タイムスイッチとして使える

30 5 * * * cd /home/pi && ./ssr_control.sh on

30 6 * * * cd /home/pi && ./ssr_control.sh off

PIC16F628AでUART for Dfplayer（備忘録）

古い型のPICはDfplayerとのUART通信の資料が少なく苦労した。
arduino系と違ってPICはよりハードに近いため、通信のタイミングなどより細かい調整が必要だとわかった。外部発振子が必要だという情報もあったが、内部発振でも可能なような気もしたので、少し頑張ってみた。

確認したこと：各ポートの入力、出力の設定（TRISA,TRISB)、 内蔵発振４MHｚが使えること（#define _XTAL_FREQ 4000000と PCON   = 0b00001000）、UART関連設定（TXSTA,RCSTA）　Config系（FOSC = INTOSCCLKで内蔵発振を指定）　SPBRG=25（４MHｚと9600Bps、非同期、ハイスピードなどの条件から計算できることが、データシートに書かれている）
ここまでは、自力でなんとかできたが、問題は、UARTの送信関数

最初は
void dfply(char cmd, char parameter) {
    while (TXIF == 0);
    TXREG = 0x7E;
　　...........
としたが、これだと、データが完全に送信しないうちに次を送ろうとしてだめらしい。ChatGPTから、以下の方法を教えてもらい、試したらうまくいった。
void dfply(char cmd, char parameter) {
     while (!TXIF); 
    TXREG = 0x7E;  
    while (!TRMT);
　　....    
   

　以下のようなコードでフォルダ、ファイル番号をスイッチ長押しでカウントして取得し、Mp3を指定して再生することはうまくできた。確認のため、フォルダやファイル番号をモールス信号をLEDで表示するようにした。 #define _XTAL_FREQ 4000000 #pragma config FOSC = INTOSCCLK // Oscillator Selection bits (INTOSC oscillator: CLKOUT function on RA6/OSC2/CLKOUT pin, I/O function on RA7/OSC1/CLKIN) #pragma config WDTE = OFF #pragma config PWRTE = OFF #pragma config MCLRE = OFF #pragma config BOREN = ON #pragma config LVP = ON #pragma config CPD = OFF #pragma config CP = OFF #include <xc.h> #include <stdio.h> #include <stdlib.h> #include <string.h> void dfply(char, int); void dfply_(char, int,int) ; void convertToMorse(int,char * ) ; void playMorse(char* ) ; void dashu(); void dot(); void play(int ,int); int dfply_qry(char, int, int ); int flg=0; int flg2=0; static int cnum=0; //current file number static int cfnum=0; //current folder number 0:mp3 int main(int argc, char** argv) { TRISA = 0b00011000; // RA3,4 input Ok TRISB = 0b00000010 ; // RB1(RX)はINPUT　RB2(TX)とその他は全てOUTPUT PORTA = 0b00000000; PCON = 0b00001000 ;//4MHz 内部クロックは４ＭＨｚとする CMCON = 0b00000111 ; // コンパレータは使用しない(RA0-RA4はデジタルピンで使用) VRCON = 0b00000000 ; // RA2はデジタルピンで使用する TXSTA = 0b00100100; // 高速ボーレート、送信有効 RCSTA = 0b10010000; // 受信有効、シリアルポート有効 SPBRG=25; //クロック数4Mhzなら：25、8Mhz：51、16:Mhz：103、32Mhz:207 __delay_ms(2000); dfply(0x06, 0x14); // vol 20 __delay_ms(1000); while (1) { //RA2 LED if(cnum==0 && cfnum==0 ){ //最初のみ点滅 RA2=1; __delay_ms(2); RA2=0; __delay_ms(1000); } while (RA3==1 && RA4==0 ){ //長押し　フォルダカウント cfnum++; dot(); flg=1; __delay_ms(200); } while (RA3 == 0 && RA4==1){ //長押し　ファイルカウント cnum++; dot(); flg2=1; __delay_ms(200); } if(flg){ cnum=0; flg=0; __delay_ms(500); char morseCode[15]; convertToMorse(cfnum,morseCode); playMorse(morseCode); } if(flg2) { __delay_ms(200); char morseCode[15]; convertToMorse(cnum,morseCode); playMorse(morseCode); if(cfnum==0){ dfply(0x03,cnum); dfply(0x0d,0); }else{ play(cfnum,cnum); } flg2=0; } __delay_ms(300); cnum=0; //cfnum=0; } return (EXIT_SUCCESS); } void play(int cfnum_,int cnum_){ dfply_(0x0f, cnum_, cfnum_); // 初期化再生 dfply(0x0d, 0); // 再生コマンド } void dfply(char cmd, int parameter){ dfply_(cmd,parameter,0); } void dfply_(char cmd, int parameter_dec,int folder_dec) { char parameter = (char)parameter_dec; // 10進数を16進数に変換 char folder = (char)folder_dec; while (!TXIF); // TXREGが空になるのを待つ TXREG = 0x7E; // 送信開始デリミタ while (!TRMT); // データが完全に送信されるのを待つ while (!TXIF); TXREG = 0xFF; while (!TRMT); while (!TXIF); TXREG = 0x06; while (!TRMT); while (!TXIF); TXREG = cmd; while (!TRMT); while (!TXIF); TXREG = 0x00; while (!TRMT); while (!TXIF); TXREG = folder; while (!TRMT); while (!TXIF); TXREG = parameter; while (!TRMT); while (!TXIF); TXREG = 0xEF; // 送信終了デリミタ while (!TRMT); } void dot() { RA2=1; __delay_ms(100); RA2=0; __delay_ms(100); } void dash() { RA2=1; __delay_ms(300); RA2=0; __delay_ms(100); } void playMorse(char* morseCode) { int i = 0; // ループカウンタを初期化 while (morseCode[i] != '\0') { // 終端文字である '\0' をチェック if (morseCode[i] == '.') { dot(); // 点を表す関数を呼び出し } else if (morseCode[i] == '-') { dash(); // 線を表す関数を呼び出し } else if (morseCode[i] == ' ') { __delay_ms(300); // スペースの場合は遅延 } i++; // 次の文字へ進む } } void convertToMorse(int num, char* result) { // Morse code for numbers 0-9 char* morseNumbers[] = { "-----", // 0 ".----", // 1 "..---", // 2 "...--", // 3 "....-", // 4 ".....", // 5 "-....", // 6 "--...", // 7 "---..", // 8 "----." // 9 }; char temp[20] = ""; // 一時的な結果を保存する配列 result[0] = '\0'; // 結果を初期化 // 処理対象の数字が 0 の場合は特別扱い if (num == 0) { strcpy(result, morseNumbers[0]); return; } while (num > 0) { int digit = num % 10; // 現在の桁を取得 strcpy(temp, morseNumbers[digit]); // 桁のモールスコードを取得 strcat(temp, " "); // 桁ごとにスペースを追加 strcat(temp, result); // 既存の結果に連結 strcpy(result, temp); // 結果を更新 num /= 10; // 次の桁へ } }