Keynote書類上で2つのテキストアイテムを選択し、左を比較元、右を比較先として行単位で差分を計算し、変更や追加が行われた行を赤く着色するAppleScriptです。
ほとんどの部分をChatGPTに書かせていますが、相当にやりとりしてダメ出ししないと書いてくれません。ほかにも、2D Bin Packing（任意の矩形図形xn個を指定エリアに詰め込む演算）のプログラムなどもAppleScriptで実装し直しておきたいところです。
▲Keynote書類上で2つのテキストアイテムを選択。座標値から左右を判定し、左側を比較元、右側を比較先として処理する
▲変更や新規追加のあった行を赤く着色する
こういうScriptを整備していないと、作業の負荷を下げられなくて大変です。
| AppleScript名：Keynote書類上の選択中の2つのテキストアイテムで、左を比較元、右を比較先として行単位の差分を比較先に赤くマーク.scptd |
| — – Created by: Takaaki Naganoya – Created on: 2025/11/21 — – Copyright © 2025 Piyomaru Software, All Rights Reserved — use AppleScript version "2.8" use framework "Foundation" use scripting additions — Keynote 側の処理：選択順で source / target を決め、target 側の差分行を赤くする tell application "Keynote" tell front document set selItems to selection if (count of selItems) is not 2 then display dialog "2つのテキストボックスを選択してください。（選択順が重要です）" buttons {"OK"} default button 1 return end if set sourceTI to item 1 of selItems — 基準 set targetTI to item 2 of selItems — 変更を反映する対象 if (class of sourceTI) is not text item or (class of targetTI) is not text item then display dialog "選択されたオブジェクトがテキストボックスではありません。" buttons {"OK"} default button 1 return end if –X座標値が小さい（左に存在する）ものを比較元とする set {sPosX, sPosY} to position of sourceTI set {tPosX, tPosY} to position of targetTI if tPosX < sPosX then copy {sourceTI, targetTI} to {targetTI, sourceTI} set sourceText to (object text of sourceTI) as string set targetText to (object text of targetTI) as string end tell end tell set sourceLines to paragraphs of sourceText set targetLines to paragraphs of targetText — LCS を計算して target 側で「保持すべき行」のインデックスを決める set pairs to computeLCS(sourceLines, targetLines) set keepIdx to {} repeat with p in pairs set end of keepIdx to item 2 of p — pair is {i, j} -> keep j (target index) end repeat — target の全テキストを一旦黒に戻す tell application "Keynote" tell front document tell object text of targetTI set its color to {0, 0, 0} end tell end tell end tell — keepIdx に含まれない target の行を赤色にする repeat with idx from 1 to (count targetLines) if keepIdx does not contain idx then set thisLine to item idx of targetLines set startPos to offsetOfLine(idx, targetText) set endPos to startPos + (length of thisLine) if endPos ≥ startPos then tell application "Keynote" tell front document tell object text of targetTI set color of characters startPos thru endPos to {65535, 0, 0} end tell end tell end tell end if end if end repeat — LCS（最長共通部分列）を AppleScript のリストで実装（行単位） — 戻り値: {{i1, j1}, {i2, j2}, …} という形式のペアリスト（1-based indices） on computeLCS(listA, listB) set lenA to count listA set lenB to count listB — DP テーブル初期化： (lenA+1) 行 × (lenB+1) 列、全て 0 set dp to {} repeat with r from 0 to lenA set row to {} repeat with c from 0 to lenB set end of row to 0 end repeat set end of dp to row end repeat — DP 計算（注意：dp の行は 0..lenA を 1..(lenA+1) 順で保持） repeat with i from 1 to lenA repeat with j from 1 to lenB set row_im1 to item i of dp — dp[i-1] set row_i to item (i + 1) of dp — dp[i] if (item i of listA) is equal to (item j of listB) then — dp[i][j] = dp[i-1][j-1] + 1 set prevVal to item j of row_im1 — dp[i-1][j-1] set newVal to prevVal + 1 set item (j + 1) of row_i to newVal — store into dp[i][j] — 更新した row_i を dp に戻す set item (i + 1) of dp to row_i else — dp[i][j] = max( dp[i-1][j], dp[i][j-1] ) set valUp to item (j + 1) of row_im1 — dp[i-1][j] set valLeft to item j of row_i — dp[i][j-1] if valUp ≥ valLeft then set item (j + 1) of row_i to valUp else set item (j + 1) of row_i to valLeft end if set item (i + 1) of dp to row_i end if end repeat end repeat — LCS を復元（後ろ向きに辿る） set i to lenA set j to lenB set lcsPairs to {} repeat while (i > 0 and j > 0) if (item i of listA) is equal to (item j of listB) then — 一致ペアを先頭に追加（{{i, j}} & lcsPairs） set lcsPairs to ({{i, j}} & lcsPairs) set i to i – 1 set j to j – 1 else — dp[i-1][j] と dp[i][j-1] を比較して移動方向を決める set valUp to item (j + 1) of item i of dp — dp[i-1][j] set valLeft to item j of item (i + 1) of dp — dp[i][j-1] if valUp ≥ valLeft then set i to i – 1 else set j to j – 1 end if end if end repeat return lcsPairs end computeLCS — 行の開始オフセット（文字単位、1-based） on offsetOfLine(n, fullText) if n ≤ 1 then return 1 set paras to paragraphs of fullText set pos to 1 repeat with idx from 1 to (n – 1) set pos to pos + (length of (item idx of paras)) + 1 — 改行分 +1 end repeat return pos end offsetOfLine |
