本ページには広告が含まれています。
目次
- 1 ProgID
- 2 ProgIDからメンバーを取得
- 3 COMオブジェクト一覧
- 4 プログラム実行例
- 4.1 UWSC.INIよりUWSC本体のウィンドウの幅と高さを取得
- 4.2 「プログラム」の右クリックメニューの動作項目を取得
- 4.3 デスクトップを開く
- 4.4 右クリックメニュー取得
- 4.5 表の最終データの下のセルを選択
- 4.6 ワークブックの数と名前を取得
- 4.7 指定したフォルダ内の拡張子とファイルの種類を返す
- 4.8 オフライン作業取得
- 4.9 指定期間のメールを日毎に集計（Outlook）
- 4.10 タスクバーにある時計の秒を非表示にする
- 4.11 予定データをExcelから読み込み追加する(Outlook)
- 4.12 指定フォルダ内の拡張子をすべて小文字にする
- 4.13 UWSC.INIのDefaultFontを変更する
- 4.14 メール本文からURLを取得（Outook）
- 4.15 レジストリからGoogle Chromeの実行ファイルのパスを取得
- 4.16 レジストリからInternet Explorerの実行ファイルのパスを取得
- 4.17 レジストリからFirefoxの実行ファイルのパスを取得
- 4.18 レジストリからMicrosoft Edgeの実行ファイルのパスを取得
- 4.19 すべてのフォルダの項目と件数を取得する
- 4.20 過去7日間に受信した迷惑メールの受信日時とメールアドレスを取得
- 4.21 未読メールの本文からURLを抽出
- 4.22 HTMLメールを送信（Outlook）
- 4.23
- 4.24 ビットマップ画像を補色に変換（24ビット）
- 4.25 ファイルを開いているプロセスを調べる
- 4.26 コロナのグラフ
- 4.27 ファイルの最終アクセス日時を取得（FSO）
- 4.28 ファイルの最終更新日時を取得（FSO）
- 4.29 8.3形式のパスを取得します
- 4.30 8.3形式のファイル名を取得します
- 4.31 指定したファイルがショートカットかを取得
- 4.32 Twitterをアプリモードで起動（Chrome）
- 4.33 Twitterをアプリモード・ユーザーエージェントをスマホにして起動（Chrome）
- 4.34 Internet ExplorerからMicrosoft Edgeにリダイレクトされるのを無効化
- 4.35 既定フォルダの最新のメールを取得
- 4.36 特殊フォルダに含まれるファイルの数を取得
- 4.37 Cドライブの空き容量を割合で取得
- 4.38 デスクトップのアイコン名に影を付ける
- 4.39 デスクトップのアイコン名に影を付けない
- 4.40 コトバンクで指定した熟語の読みを調べる
- 4.41 週最初の曜日を取得
- 4.42 レジストリから現在設定されているタイムゾーンを取得
- 4.43 ゴールドプラザで最新の金の価格を取得
- 4.44 UWSCのショートカットをスタートアップに作成
- 4.45 古いキャッシュファイルを削除する
COMオブジェクトを生成します。
- 構文
- Object = CREATEOLEOBJ( COMオブジェクト名 )
- 引数
- COMオブジェクト名 （String）必須
- COMオブジェクト名
- 戻り値
COMオブジェクト
COMからメソッド使用時に引数に値取得(OUT引数)がある場合は、引数の変数の前にVarを付ける
ProgID
ProgIDとは、COM/ActiveXオブジェクトを識別するために使用されるクラス識別子（CLSID）のことです。InternetExplorer.Application、Excel.Applicationなどの文字列がProgIDです。
CREATEOLEOBJ関数の引数にはこのProgIDを指定します。
ProgIDはプログラム名.コンポーネント.バージョンの形式で記述されます。バージョンは非必須の項目で省略することもできます。
例えばProgIDがInternetExplorer.Applicationの場合、InternetExplorerがプログラム名、Applicationがコンポーネントでバージョンはありません。
Excel.Application.15はExcelがプログラム名、Applicationがコンポーネント、15がバージョンとなります。
Excelのバージョンについてはhttps://ja.wikipedia.org/wiki/Microsoft_Excelのバージョン履歴の項目を参照。
Excel2010(ver14)とExcel2013(ver15)が共存している環境のとき、バージョンに15を指定することでExcel2013のCOMオブジェクトを生成することができます。存在しないバージョンを指定した場合エラーになります。
DIM Excel = CREATEOLEOBJ("Excel.Application.15")ProgIDからメンバーを取得
ProgIDからメンバーを調べるには以下のプログラムを実行します。
DIM progID = "メンバーを調べたいprogID"
PRINT POWERSHELL("$obj = New-Object -ComObject " + progID + " ; Get-Member -InputObject $obj")InternetExplorer.Applicationの場合、以下のように指定します。
DIM progID = "InternetExplorer.Application"
PRINT POWERSHELL("$obj = New-Object -ComObject " + progID + " ; Get-Member -InputObject $obj")結果
COMオブジェクト一覧
以下はよく使うCOMオブジェクトの一覧です。
| オブジェクト名 | ProgID | 参照設定名 |
|---|---|---|
| InternetExplorer オブジェクト | InternetExplorer.Application | Microsoft Internet Controls |
| Shell オブジェクト | Shell.Application | Microsoft Shell Controls And Automation |
| CDO オブジェクト | CDO.Message | Microsoft CDO for Windows 2000 Library |
| FileSystemObject オブジェクト | Scripting.FileSystemObject | Microsoft Scripting Runtime |
| WshShell オブジェクト | WScript.Shell | Windows Script Host Object Model |
| Excel オブジェクト | Excel.Application | Microsoft Excel 14.0 Object Library |
| Word オブジェクト | Word.Application | Microsoft Word 14.0 Object Library |
| Outlook オブジェクト | Outlook.Application | Microsoft Outlook 14.0 Object Library |
| Selenium オブジェクト | Selenium.WebDriver | Selenium Type Library |
引数に指定できるProgIDの一部は以下のコマンドで取得することができます。
PRINT POWERSHELL("Get-WmiObject Win32_ProgIDSpecification | select ProgID | sort ProgID | % {$_.ProgID.Trim()}")結果
これらのCOMオブジェクト名がすべて利用できるわけではなく、CREATEOLEOBJ関数の引数に指定しオブジェクトを生成できたものには◯、できなかったものには✕をつけています。
結果
プログラム実行例
UWSC.INIよりUWSC本体のウィンドウの幅と高さを取得
UWSC起動時のウィンドウの座標を幅,高さの形式で取得します。
MainSizeキーは初期では定義されていないので、値を取得できないこともあります。
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
DIM path = WshShell.ExpandEnvironmentStrings("%AppData%\UWSC\UWSC.INI")
PRINT READINI("SET", "MainSize", path)
//////////////////////////////////////////////////
// 【引数】
// section : セクション
// key : キー（Delete関数は省略可）
// value : 値
// path : INIファイルのパス
// default : セクションとキーが存在しなかった場合に返す値
// 【戻り値】
//
//////////////////////////////////////////////////
MODULE INI
DEF_DLL GetPrivateProfileStringW(wstring,wstring,wstring,var pwchar,dword,wstring):dword:kernel32
DEF_DLL WritePrivateProfileStringW(wstring,wstring,wstring,wstring):bool:kernel32
FUNCTION Read(section = NULL, key = NULL, path = NULL, default = EMPTY)
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
IFB path = NULL THEN
path = FSO.GetAbsolutePathName(FSO.GetBaseName(GET_UWSC_NAME) + ".INI")
ELSE
path = FSO.GetAbsolutePathName(path)
ENDIF
DIM n = 1024
DIM buffer = FORMAT(CHR(0), n)
IFB GetPrivateProfileStringW(section, key, default, buffer, n, path) = 0 THEN
RESULT = default
ELSE
RESULT = SLICE(SPLIT(buffer, CHR(0), TRUE))
IF section <> NULL AND key <> NULL THEN RESULT = RESULT[0]
ENDIF
FEND
FUNCTION Write(section, key, value, path = NULL)
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
IFB path = NULL THEN
path = FSO.GetAbsolutePathName(FSO.GetBaseName(GET_UWSC_NAME) + ".INI")
ELSE
path = FSO.GetAbsolutePathName(path)
ENDIF
RESULT = WritePrivateProfileStringW(section, key, value, path)
FEND
PROCEDURE Delete(section, key = NULL, path = NULL)
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
IFB path = NULL THEN
path = FSO.GetAbsolutePathName(FSO.GetBaseName(GET_UWSC_NAME) + ".INI")
ELSE
path = FSO.GetAbsolutePathName(path)
ENDIF
PRINT WritePrivateProfileStringW(section, key, NULL, path)
FEND
FUNCTION escape(value)
DIM esc = ";#=:"
FOR i = 1 TO LENGTH(esc)
DIM s = COPY(esc, i, 1)
value = REPLACE(value, s, "\" + s)
NEXT
RESULT = value
FEND
FUNCTION unescape(value)
DIM esc = ";#=:"
FOR i = 1 TO LENGTH(esc)
DIM s = COPY(esc, i, 1)
value = REPLACE(value, "\" + s, s)
NEXT
RESULT = value
FEND
ENDMODULE結果
220,61使用関数
「プログラム」の右クリックメニューの動作項目を取得
CONST ssfPROGRAMS = 2
DIM Shell = CREATEOLEOBJ("Shell.Application")
DIM Folder2 = Shell.NameSpace(ssfPROGRAMS)
DIM FolderItem = Folder2.Self
DIM FolderItemVerbs = FolderItem.Verbs
FOR FolderItemVerb IN FolderItemVerbs
PRINT FolderItemVerb.Name
NEXT結果
開く(&O)
クイック アクセスにピン留めする
コピー(&C)
以前のバージョンの復元(&V)
切り取り(&T)
コピー(&C)
ショートカットの作成(&S)
削除(&D)
名前の変更(&M)
プロパティ(&R)使用関数
デスクトップを開く
CONST ssfDESKTOP = 0
DIM Shell = CREATEOLEOBJ("Shell.Application")
DIM Folder2 = Shell.NameSpace(ssfDESKTOP)
DIM FolderItem = Folder2.Self
DIM FolderItemVerbs = FolderItem.Verbs()
FOR FolderItemVerb IN FolderItemVerbs
IF POS("&O", FolderItemVerb.Name) <> 0 THEN FolderItemVerb.DoIt()
NEXT使用関数
右クリックメニュー取得
CONST ssfDESKTOP = 0
DIM Shell = CREATEOLEOBJ("Shell.Application")
DIM Folder = Shell.NameSpace(ssfDESKTOP)
DIM FolderItem = Folder.ParseName("log.txt")
DIM FolderItemVerbs = FolderItem.Verbs
FOR FolderItemVerb IN FolderItemVerbs
PRINT FolderItemVerb.Name
NEXT結果
開く(&O)
印刷(&P)
編集(&E)
ALZipで圧縮(&L)
管理者権限で圧縮(&Y)
"log.zip" で圧縮(&Q)
コピー(&C)
削除(&D)
共有
以前のバージョンの復元(&V)
切り取り(&T)
コピー(&C)
ショートカットの作成(&S)
削除(&D)
名前の変更(&M)
プロパティ(&R)使用関数
表の最終データの下のセルを選択
[download "/example/620/東京月別平均気温（2000-2019年）.xlsx"]CONST xlDown = -4121
DIM Excel = CREATEOLEOBJ("Excel.Application")
Excel.Visible = TRUE
Excel.Workbooks.Open("C:\Users\Owner\Downloads\東京月別平均気温（2000-2019年）.xlsx")
Excel.Range("B4").End(xlDown).Offset(1).Select使用関数
ワークブックの数と名前を取得
DIM Excel = CREATEOLEOBJ("Excel.Application")
Excel.Visible = TRUE
FOR i = 1 TO 3
Excel.Workbooks.Add()
NEXT
DIM Workbooks = Excel.Application.Workbooks
PRINT "ブック数：" + Excel.Workbooks.Count
PRINT "-----"
FOR Workbook IN Workbooks
PRINT "ブック名：" + Workbook.Name
NEXT
SLEEP(3.00)
Excel.Application.Quit結果
ブック数：3
-----
ブック名：Book1
ブック名：Book2
ブック名：Book3使用関数
指定したフォルダ内の拡張子とファイルの種類を返す
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM folderspec = "D:\Desktop\"
DIM Files = FSO.GetFolder(folderspec).Files
FOR File IN Files
PRINT FSO.GetExtensionName(File.Name) + "：" + File.Type
NEXT使用関数
オフライン作業取得
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
TRY
// Ver11以上
DIM version = WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\svcVersion")
EXCEPT
// Ver10以下
version = WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\Version")
ENDTRY
IFB VAL(TOKEN(".", version)) <= 10 THEN
// Ver10以下
DIM IE = CREATEOLEOBJ("InternetExplorer.Application")
IE.Visible = TRUE
IFB IE.Offilne = TRUE THEN
PRINT "オフライン作業中です"
ELSE
PRINT "オフライン作業中ではありません"
ENDIF
IE.Quit
ELSE
// Ver11以上
PRINT "オフライン作業は利用できません"
ENDIF結果
オフライン作業は利用できません使用関数
指定期間のメールを日毎に集計（Outlook）
CONST olFolderIndex = 6
DIM Outlook = CREATEOLEOBJ("Outlook.Application")
DIM NameSpace = Outlook.GetNameSpace("MAPI")
DIM Folder = NameSpace.GetDefaultFolder(olFolderIndex)
DIM Items = Folder.Items
Items = Items.Restrict("[ReceivedTime] >= '2020/12/01' AND [ReceivedTime] < '2020/12/31'")
HASHTBL dates = HASH_SORT
FOR MailItem IN Items
DIM datetime = MailItem.ReceivedTime
GETTIME(0, datetime)
DIM date = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
dates[date] = dates[date] + 1
NEXT
FOR i = 0 TO LENGTH(dates) - 1
PRINT dates[i, HASH_KEY] + "<#TAB>" + dates[i, HASH_VAL]
NEXT結果
2020/12/05 78
2020/12/06 60
2020/12/07 72
2020/12/08 82
2020/12/09 75
2020/12/10 91
2020/12/11 82
2020/12/12 77
2020/12/13 63
2020/12/14 71
2020/12/15 104
2020/12/16 84
2020/12/17 80
2020/12/18 93
2020/12/19 78
2020/12/20 66
2020/12/21 67
2020/12/22 75
2020/12/23 82
2020/12/24 73
2020/12/25 87
2020/12/26 73
2020/12/27 56
2020/12/28 65
2020/12/29 69
2020/12/30 44
2020/12/31 1使用関数
タスクバーにある時計の秒を非表示にする
PC再起動後に適用されます。
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
DIM name = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ShowSecondsInSystemClock"
DIM value = 0
DIM type = "REG_DWORD"
WshShell.RegWrite(name, value, type)
//DOSCMD("shutdown /r /t 0")使用関数
予定データをExcelから読み込み追加する(Outlook)
[download "/example/625/予定一覧.xlsx"]CONST xlUp = -4162
CONST olAppointmentItem = 1
HASHTBL reminders
reminders["なし"] = -1; reminders["0分"] = 0; reminders["5分"] = 5
reminders["10分"] = 10; reminders["15分"] = 15; reminders["30分"] = 30
reminders["1時間"] = 60; reminders["2時間"] = 120; reminders["3時間"] = 180
reminders["4時間"] = 240; reminders["5時間"] = 300; reminders["6時間"] = 360
reminders["7時間"] = 420; reminders["8時間"] = 480; reminders["9時間"] = 540
reminders["10時間"] = 600; reminders["11時間"] = 660; reminders["0.5日"] = 720
reminders["18時間"] = 1080; reminders["1日"] = 1440; reminders["2日"] = 2880
reminders["3日"] = 4320; reminders["4日"] = 5760; reminders["1週"] = 10080
reminders["2週"] = 20160
DIM Excel = CREATEOLEOBJ("Excel.Application")
Excel.Visible = TRUE
DIM Workbook = Excel.Workbooks.Open("D:\Desktop\予定一覧.xlsx")
DIM MaxRow = Excel.Cells(Excel.Rows.Count, 1).End(xlUp).Row
DIM Outlook = CREATEOLEOBJ("Outlook.Application")
DIM AppointmentItem = Outlook.CreateItem(olAppointmentItem)
FOR row = 2 TO MaxRow
PRINT row
WITH AppointmentItem
.Subject = Excel.Cells(row, 2).Value // 件名
.Location = Excel.Cells(row, 3).Value // 場所
.Start = Excel.Cells(row, 4).Value // 開始時刻
.End = Excel.Cells(row, 5).Value // 終了時刻
IF Excel.Cells(row, 6).Value = "○" THEN .AllDayEvent = TRUE // 終日
IFB reminders[Excel.Cells(row, 7).Value] <> -1 THEN
.ReminderSet = TRUE
.ReminderMinutesBeforeStart = reminders[Excel.Cells(row, 7).Value] // リマインダー
ELSE
.ReminderSet = FALSE
ENDIF
.BusyStatus = 1 // 公開方法
.Body = Excel.Cells(row, 8).Value // 本文
.Save
ENDWITH
NEXT
MSGBOX((MaxRow - 1) + "件の予定を登録しました。")
Outlook.Quit
Excel.Quit使用関数
指定フォルダ内の拡張子をすべて小文字にする
CONST ssfDESKTOP = 0
DIM Shell = CREATEOLEOBJ("Shell.Application")
DIM folderspec = Shell.NameSpace(ssfDESKTOP).Self.Path
DIM Folder = Shell.NameSpace(folderspec + "\test\")
DIM FolderItems = Folder.Items
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
FOR FolderItem IN FolderItems
DIM path = FolderItem.Path
WITH FSO
DIM filename1 = .GetParentFolderName(path) + "\" + .GetBaseName(path) + "." + .GetExtensionName(path)
DIM filename2 = .GetBaseName(path) + "." + STRCONV(.GetExtensionName(path), SC_LOWERCASE)
ENDWITH
DOSCMD("RENAME <#DBL>" + filename1 + "<#DBL> <#DBL>" + filename2 + "<#DBL>")
NEXT使用関数
UWSC.INIのDefaultFontを変更する
CONST ssfFONTS = 20
DIM Shell = CREATEOLEOBJ("Shell.Application")
DIM Folder = Shell.NameSpace(ssfFONTS)
DIM FolderItems = Folder.Items
DIM array[-1]
FOR FolderItem IN FolderItems
arrayPush(array, FolderItem.Name)
NEXT
QSORT(array, QSRT_UNICODEA)
SHIFTARRAY(array, 1)
array[0] = "(なし)"
DIM filename = "C:\Users\" + BETWEENSTR(DOSCMD("SET"), "USERNAME=", "<#CR>") + "\AppData\Roaming\UWSC\UWSC.INI"
DIM str = SPLIT(READINI("SET", "DefaultFont", filename), ",")[0]
DIM font = SLCTBOX(SLCT_CMB OR SLCT_STR, 0, "フォントを選択してください。（現在：" + str + "）", array)
IF font = "(なし)" THEN font = ""
IF font <> -1 THEN WRITEINI("SET", "DefaultFont", font + ",", filename)
//////////////////////////////////////////////////
// 【引数】
// array : 要素を追加する配列（参照引数）
// values : 追加する要素をvalue1から指定
// 【戻り値】
// 処理後の配列の要素の数
//////////////////////////////////////////////////
FUNCTION arrayPush(var array[], value1 = EMPTY, value2 = EMPTY, value3 = EMPTY, value4 = EMPTY, value5 = EMPTY, value6 = EMPTY, value7 = EMPTY, value8 = EMPTY, value9 = EMPTY, value10 = EMPTY, value11 = EMPTY, value12 = EMPTY, value13 = EMPTY, value14 = EMPTY, value15 = EMPTY, value16 = EMPTY)
DIM i = 1
WHILE EVAL("value" + i) <> EMPTY
DIM res = RESIZE(array, UBound(array) + 1)
array[res] = EVAL("value" + i)
i = i + 1
WEND
RESULT = LENGTH(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// section : セクション
// key : キー（Delete関数は省略可）
// value : 値
// path : INIファイルのパス
// default : セクションとキーが存在しなかった場合に返す値
// 【戻り値】
//
//////////////////////////////////////////////////
MODULE INI
DEF_DLL GetPrivateProfileStringW(wstring,wstring,wstring,var pwchar,dword,wstring):dword:kernel32
DEF_DLL WritePrivateProfileStringW(wstring,wstring,wstring,wstring):bool:kernel32
FUNCTION Read(section = NULL, key = NULL, path = NULL, default = EMPTY)
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
IFB path = NULL THEN
path = FSO.GetAbsolutePathName(FSO.GetBaseName(GET_UWSC_NAME) + ".INI")
ELSE
path = FSO.GetAbsolutePathName(path)
ENDIF
DIM n = 1024
DIM buffer = FORMAT(CHR(0), n)
IFB GetPrivateProfileStringW(section, key, default, buffer, n, path) = 0 THEN
RESULT = default
ELSE
RESULT = SLICE(SPLIT(buffer, CHR(0), TRUE))
IF section <> NULL AND key <> NULL THEN RESULT = RESULT[0]
ENDIF
FEND
FUNCTION Write(section, key, value, path = NULL)
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
IFB path = NULL THEN
path = FSO.GetAbsolutePathName(FSO.GetBaseName(GET_UWSC_NAME) + ".INI")
ELSE
path = FSO.GetAbsolutePathName(path)
ENDIF
RESULT = WritePrivateProfileStringW(section, key, value, path)
FEND
PROCEDURE Delete(section, key = NULL, path = NULL)
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
IFB path = NULL THEN
path = FSO.GetAbsolutePathName(FSO.GetBaseName(GET_UWSC_NAME) + ".INI")
ELSE
path = FSO.GetAbsolutePathName(path)
ENDIF
PRINT WritePrivateProfileStringW(section, key, NULL, path)
FEND
FUNCTION escape(value)
DIM esc = ";#=:"
FOR i = 1 TO LENGTH(esc)
DIM s = COPY(esc, i, 1)
value = REPLACE(value, s, "\" + s)
NEXT
RESULT = value
FEND
FUNCTION unescape(value)
DIM esc = ";#=:"
FOR i = 1 TO LENGTH(esc)
DIM s = COPY(esc, i, 1)
value = REPLACE(value, "\" + s, s)
NEXT
RESULT = value
FEND
ENDMODULE
//////////////////////////////////////////////////
// 【引数】
// inputs : 繰り返す文字列
// multiplier : inputsを繰り返す回数
// 【戻り値】
// inputsをmultiplier回を繰り返した文字列を返します
//////////////////////////////////////////////////
FUNCTION strRepeat(inputs, multiplier)
DIM res = ""
FOR n = 1 TO multiplier
res = res + inputs
NEXT
RESULT = res
FEND
//////////////////////////////////////////////////
// 【引数】
// arrayname : 上限値を求める配列の名前
// dimension : 返す次元を示す整数
// 【戻り値】
// 配列の上限値
//////////////////////////////////////////////////
FUNCTION UBound(arrayname[], dimension = 1)
RESULT = EVAL("RESIZE(arrayname" + strRepeat("[0]", dimension - 1) + ")")
FEND使用関数
メール本文からURLを取得（Outook）
メールの本文から正規表現でURL部分のみを取得します。
DIM Outlook = CREATEOLEOBJ("Outlook.Application")
DIM NameSpace = Outlook.GetNameSpace("MAPI")
DIM Folder = NameSpace.Folders("info@example.com").Folders("受信トレイ")
//DIM Folder = NameSpace.GetDefaultFolder(olFolderIndex)
// 昨日のメールを取得
GETTIME(-1)
DIM datetime = G_TIME_YY4 + G_TIME_MM2 + G_TIME_DD2 + "_" + G_TIME_HH2 + G_TIME_NN2
// 今日の日付
DIM date1 = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
// 明日の日付
DIM date2 = dateAdd("d", 1, date1)
// 処理するメールの条件＝受信日時が今日のメール ※[ReceivedTime] = [受信日時]
DIM Items = Folder.Items.Restrict("[ReceivedTime] >= '" + date1 + " 0:00 AM' AND [ReceivedTime] < '" + date2 + " 0:00 AM'")
// 「受信日時」でソート
Items.Sort("受信日時")
FOR Index = 1 TO Items.Count
WITH Items.Item(Index)
DIM Matches = reExecute(.Body, "https?://([\w-]+\.)+[\w-]+(/[\w-./?%&=]*)?")
FOR Match IN Matches
PRINT Match.Value
NEXT
ENDWITH
NEXT
//////////////////////////////////////////////////
// 【引数】
// interval : 加算する時間間隔を表す文字列式（yyyy：年、m：月、d：日、ww：週、h：時、n：分、s：秒）
// num : dateに加算する値。未来は正、過去は負で指定
// date : 時間間隔を加算する日付
// 【戻り値】
// 日時（date）に、指定した単位（interval）の時間（num）を加算して返します
//////////////////////////////////////////////////
FUNCTION dateAdd(interval, num, date)
DIM year, month, day, d
GETTIME(0, date)
DIM time = G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2
SELECT interval
CASE "yyyy"
d = (G_TIME_YY + num) + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
IF time <> "00:00:00" THEN d = d + " " + time
CASE "m"
IFB num > 0 THEN
year = G_TIME_YY + INT((G_TIME_MM + num) / 12)
month = REPLACE(FORMAT(((G_TIME_MM + num) MOD 12), 2), " ", "0")
ELSE
year = G_TIME_YY + CEIL((G_TIME_MM + num) / 12 - 1)
month = REPLACE(FORMAT(G_TIME_MM - (ABS(num) MOD 12), 2), " ", "0")
ENDIF
IF month = "00" THEN month = 12
day = G_TIME_DD2
d = "" + year + month + day
IFB !isDate(d) THEN
d = year + "/" + month + "/" + "01"
d = getEndOfMonth(d)
ELSE
d = year + "/" + month + "/" + day
ENDIF
IF time <> "00:00:00" THEN d = d + " " + time
CASE "d"
t = GETTIME(num, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "ww"
t = GETTIME(num * 7, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "h"
t = GETTIME(num / 24, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "n"
t = GETTIME(num / 1440, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "s"
t = GETTIME(num / 86400, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）
// m : 第一引数の指定日からプラスマイナスm月とする
// 【戻り値】
// dateからm月後の月末の日付
//////////////////////////////////////////////////
FUNCTION getEndOfMonth(date, m = 0)
date = dateAdd("m", m + 1, date)
GETTIME(0, date)
GETTIME(-G_TIME_DD, date)
RESULT = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
FEND
//////////////////////////////////////////////////
// 【引数】
// expr : 評価する式
// truepart : 評価した式がTrueのときに返す値
// falsepart : 評価した式がFalseのときに返す値
// 【戻り値】
// truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき
//////////////////////////////////////////////////
FUNCTION IIF(expr, truepart, falsepart)
IFB EVAL(expr) THEN
RESULT = truepart
ELSE
RESULT = falsepart
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 存在するかを調べる日付文字列。YYYYMMDD or YYYY/MM/DD or YYYY-MM-DDのいずれかの形式。
// 【戻り値】
// TRUE : 日付として認識できる、FALSE : 日付として認識できない
//////////////////////////////////////////////////
FUNCTION isDate(date)
TRY
GETTIME(0, date)
RESULT = TRUE
EXCEPT
RESULT = FALSE
ENDTRY
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 正規表現による検索の対象となる文字列
// Pattern : 正規表現で使用するパターンを設定
// IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse
// Global : 文字列全体を検索する場合はTrue、しない場合はFalse
// 【戻り値】
// 正規表現で検索した結果をMatchesコレクションとして返します。
//////////////////////////////////////////////////
FUNCTION reExecute(str, Pattern, IgnoreCase = TRUE, Global = TRUE)
DIM re = CREATEOLEOBJ("VBScript.RegExp")
re.Pattern = Pattern
re.IgnoreCase = IgnoreCase
re.Global = Global
RESULT = re.Execute(str)
FEND使用関数
レジストリからGoogle Chromeの実行ファイルのパスを取得
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
PRINT WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\chrome.exe\")結果
C:\Program Files (x86)\Google\Chrome\Application\chrome.exe使用関数
レジストリからInternet Explorerの実行ファイルのパスを取得
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
PRINT WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\IEXPLORE.EXE\")結果
C:\Program Files\Internet Explorer\IEXPLORE.EXE使用関数
レジストリからFirefoxの実行ファイルのパスを取得
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
PRINT WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\firefox.exe\")結果
C:\Program Files\Mozilla Firefox\firefox.exe使用関数
レジストリからMicrosoft Edgeの実行ファイルのパスを取得
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
PRINT WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\msedge.exe\")結果
C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe使用関数
すべてのフォルダの項目と件数を取得する
DIM Outlook = CREATEOLEOBJ("Outlook.Application")
DIM NameSpace = Outlook.GetNameSpace("MAPI")
DIM Folders = NameSpace.Folders
FOR Folder IN Folders
PRINT "■" + Folder.Name
Folders2 = NameSpace.Folders(Folder.Name).Folders
FOR Folder2 IN Folders2
PRINT "・" + Folder2.Name + "：" + Folder2.Items.Count + "件"
NEXT
PRINT
NEXT結果
■Android_旧
・受信トレイ：7698件
・削除済みアイテム：8件
・送信済みアイテム：0件
・迷惑メール：0件
・送信トレイ：0件
・連絡先候補：0件
・ニュース フィード：0件
・予定表：1件
・連絡先：0件
・履歴：0件
・メモ：0件
・タスク：0件
・下書き：0件
・RSS フィード：0件
・スレッド アクション設定：0件
・クイック操作設定：0件
■Yahoo!_旧
・削除済みアイテム：1件
・受信トレイ：323518件
・送信トレイ：0件
・送信済みアイテム：1件
・予定表：34件
・連絡先：620件
・履歴：0件
・メモ：0件
・タスク：0件
・下書き：1件
・RSS フィード：0件
・スレッド アクション設定：0件
・クイック操作設定：0件
・迷惑メール：44025件
・連絡先候補：0件
・ニュース フィード：0件
■Android_新
・受信トレイ：10902件
・削除済みアイテム：0件
・送信済みアイテム：0件
・迷惑メール：0件
■Yahoo!_新
・削除済みアイテム：1件
・受信トレイ：410292件
・送信トレイ：0件
・送信済みアイテム：1件
・予定表：34件
・連絡先：620件
・履歴：0件
・メモ：0件
・タスク：0件
・下書き：1件
・RSS フィード：0件
・スレッド アクション設定：0件
・クイック操作設定：0件
・迷惑メール：51607件
・連絡先候補：0件
・ニュース フィード：0件使用関数
過去7日間に受信した迷惑メールの受信日時とメールアドレスを取得
DIM Outlook = CREATEOLEOBJ("Outlook.Application")
DIM NameSpace = Outlook.GetNameSpace("MAPI")
DIM Folders = NameSpace.Folders("Yahoo!_新").Folders("迷惑メール")
DIM startDate = dateAdd("d", -7, today())
DIM endDate = dateAdd("d", -1, today())
DIM Items = Folders.Items.Restrict("[ReceivedTime] >= '" + startDate + "' AND [ReceivedTime] < '" + endDate + "'")
DIM count = Items.Count
Items.Sort("受信日時")
FOR Index = 1 TO count
WITH Items.Item(Index)
PRINT .ReceivedTime + "<#TAB>" + .SenderEmailAddress
ENDWITH
NEXT
//////////////////////////////////////////////////
// 【引数】
// interval : 加算する時間間隔を表す文字列式（yyyy：年、m：月、d：日、ww：週、h：時、n：分、s：秒）
// num : dateに加算する値。未来は正、過去は負で指定
// date : 時間間隔を加算する日付
// 【戻り値】
// 日時（date）に、指定した単位（interval）の時間（num）を加算して返します
//////////////////////////////////////////////////
FUNCTION dateAdd(interval, num, date)
DIM year, month, day, d
GETTIME(0, date)
DIM time = G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2
SELECT interval
CASE "yyyy"
d = (G_TIME_YY + num) + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
IF time <> "00:00:00" THEN d = d + " " + time
CASE "m"
IFB num > 0 THEN
year = G_TIME_YY + INT((G_TIME_MM + num) / 12)
month = REPLACE(FORMAT(((G_TIME_MM + num) MOD 12), 2), " ", "0")
ELSE
year = G_TIME_YY + CEIL((G_TIME_MM + num) / 12 - 1)
month = REPLACE(FORMAT(G_TIME_MM - (ABS(num) MOD 12), 2), " ", "0")
ENDIF
IF month = "00" THEN month = 12
day = G_TIME_DD2
d = "" + year + month + day
IFB !isDate(d) THEN
d = year + "/" + month + "/" + "01"
d = getEndOfMonth(d)
ELSE
d = year + "/" + month + "/" + day
ENDIF
IF time <> "00:00:00" THEN d = d + " " + time
CASE "d"
t = GETTIME(num, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "ww"
t = GETTIME(num * 7, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "h"
t = GETTIME(num / 24, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "n"
t = GETTIME(num / 1440, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "s"
t = GETTIME(num / 86400, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）
// m : 第一引数の指定日からプラスマイナスm月とする
// 【戻り値】
// dateからm月後の月末の日付
//////////////////////////////////////////////////
FUNCTION getEndOfMonth(date, m = 0)
date = dateAdd("m", m + 1, date)
GETTIME(0, date)
GETTIME(-G_TIME_DD, date)
RESULT = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
FEND
//////////////////////////////////////////////////
// 【引数】
// expr : 評価する式
// truepart : 評価した式がTrueのときに返す値
// falsepart : 評価した式がFalseのときに返す値
// 【戻り値】
// truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき
//////////////////////////////////////////////////
FUNCTION IIF(expr, truepart, falsepart)
IFB EVAL(expr) THEN
RESULT = truepart
ELSE
RESULT = falsepart
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 存在するかを調べる日付文字列。YYYYMMDD or YYYY/MM/DD or YYYY-MM-DDのいずれかの形式。
// 【戻り値】
// TRUE : 日付として認識できる、FALSE : 日付として認識できない
//////////////////////////////////////////////////
FUNCTION isDate(date)
TRY
GETTIME(0, date)
RESULT = TRUE
EXCEPT
RESULT = FALSE
ENDTRY
FEND
//////////////////////////////////////////////////
// 【引数】
//
// 【戻り値】
// 今日の日付
//////////////////////////////////////////////////
FUNCTION today()
GETTIME()
RESULT = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
FEND使用関数
未読メールの本文からURLを抽出
DIM Outlook = CREATEOLEOBJ("Outlook.Application")
DIM NameSpace = Outlook.GetNameSpace("MAPI")
DIM Folder = NameSpace.Folders("Android_新").Folders("受信トレイ")
DIM Items = Folder.Items.Restrict("[UnRead] = TRUE")
Items.Sort("受信日時", TRUE)
// クリックするURLを格納した配列（部分一致）
DIM urls[] = "://example.com"
DIM driver = CREATEOLEOBJ("Selenium.WebDriver")
WebDriverDownload.Chrome()
// ログイン情報を保存
CONST PROFILE_PATH = "C:\Users\" + BETWEENSTR(DOSCMD("SET"), "USERNAME=", "<#CR>") + "\AppData\Local\Google\Chrome\User Data\Default"
driver.AddArgument("user-data-dir=" + PROFILE_PATH)
driver.Start("chrome")
DIM count = Items.Count
FOR Index = count TO 1 STEP -1
WITH Items.Item(Index)
FUKIDASI(Index + "<#TAB>" + .SenderEmailAddress + "<#TAB>" + .ReceivedTime)
DIM Matches = reExecute(.Body, "https?://([\w-]+\.)+[\w-]+(/[\w-./?%&=]*)?")
// メール本文のURLをループ
FOR Match IN Matches
// クリックするURLをチェック
FOR i = 0 TO UBound(urls)
IF POS(urls[i], Match.Value) = 0 THEN CONTINUE
driver.Get(Match.Value) // リンクを開く
NEXT
NEXT
SLEEP(1.000)
ENDWITH
NEXT
//////////////////////////////////////////////////
// 【引数】
// num : 単位換算する数値
// before : 変換前の単位
// after : 変換後の単位
// 【戻り値】
// 指定した単位に変換した数値
//////////////////////////////////////////////////
FUNCTION convert(num, before, after)
HASHTBL unit
// 重量
unit["g,sg"] = "num * 6.85217658567918 * POWER(10, -5)"
unit["g,lbm"] = "num * 2.20462262184878 * POWER(10, -3)"
unit["g,u"] = "num * 6.02217 * POWER(10, +23)"
unit["g,ozm"] = "num * 3.52739619495804 * POWER(10, -2)"
unit["sg,g"] = "num * 1.45939029372064 * POWER(10, +4)"
unit["sg,lbm"] = "num * 3.21740485564304 * POWER(10, +1)"
unit["sg,u"] = "num * 8.78869644513561 * POWER(10, +27)"
unit["sg,ozm"] = "num * 5.14784776902887 * POWER(10, +2)"
unit["lbm,g"] = "num * 4.5359237 * POWER(10, +2)"
unit["lbm,sg"] = "num * 3.10809501715673 * POWER(10, -2)"
unit["lbm,u"] = "num * 2.7316103628429 * POWER(10, +26)"
unit["lbm,ozm"] = "num * 1.6 * POWER(10, +1)"
unit["u,g"] = "num * 1.66053100460465 * POWER(10, -24)"
unit["u,sg"] = "num * 1.13782516695463 * POWER(10, -28)"
unit["u,lbm"] = "num * 3.66084421703269 * POWER(10, -27)"
unit["u,ozm"] = "num * 5.8573507472523 * POWER(10, -26)"
unit["ozm,g"] = "num * 2.8349523125 * POWER(10, +1)"
unit["ozm,sg"] = "num * 1.94255938572295 * POWER(10, -3)"
unit["ozm,lbm"] = "num * 6.25 * POWER(10, -2)"
unit["ozm,u"] = "num * 1.70725647677681 * POWER(10, +25)"
// 距離
unit["m,mi"] = "num * 6.21371192237334 * POWER(10, -4)"
unit["m,Nmi"] = "num * 5.39956803455724 * POWER(10, -4)"
unit["m,in"] = "num * 3.93700787401575 * POWER(10, +1)"
unit["m,ft"] = "num * 3.28083989501312 * POWER(10, +0)"
unit["m,yd"] = "num * 1.09361329833771 * POWER(10, +0)"
unit["m,ang"] = "num * 1 * POWER(10, +10)"
unit["m,pica"] = "num * 2.36220472440945 * POWER(10, +2)"
unit["mi,m"] = "num * 1.609344 * POWER(10, +3)"
unit["mi,Nmi"] = "num * 8.68976241900648 * POWER(10, -1)"
unit["mi,in"] = "num * 6.336 * POWER(10, +4)"
unit["mi,ft"] = "num * 5.28 * POWER(10, +3)"
unit["mi,yd"] = "num * 1.76 * POWER(10, +3)"
unit["mi,ang"] = "num * 1.609344 * POWER(10, +13)"
unit["mi,pica"] = "num * 3.8016 * POWER(10, +5)"
unit["Nmi,m"] = "num * 1.852 * POWER(10, +3)"
unit["Nmi,mi"] = "num * 1.15077944802354 * POWER(10, +0)"
unit["Nmi,in"] = "num * 7.29133858267717 * POWER(10, +4)"
unit["Nmi,ft"] = "num * 6.0761154855643 * POWER(10, +3)"
unit["Nmi,yd"] = "num * 2.02537182852143 * POWER(10, +3)"
unit["Nmi,ang"] = "num * 1.852 * POWER(10, +13)"
unit["Nmi,pica"] = "num * 4.3748031496063 * POWER(10, +5)"
unit["in,m"] = "num * 2.54 * POWER(10, -2)"
unit["in,mi"] = "num * 1.57828282828283 * POWER(10, -5)"
unit["in,Nmi"] = "num * 1.37149028077754 * POWER(10, -5)"
unit["in,ft"] = "num * 8.33333333333333 * POWER(10, -2)"
unit["in,yd"] = "num * 2.77777777777778 * POWER(10, -2)"
unit["in,ang"] = "num * 2.54 * POWER(10, +8)"
unit["in,pica"] = "num * 6 * POWER(10, +0)"
unit["ft,m"] = "num * 3.048 * POWER(10, -1)"
unit["ft,mi"] = "num * 1.89393939393939 * POWER(10, -4)"
unit["ft,Nmi"] = "num * 1.64578833693305 * POWER(10, -4)"
unit["ft,in"] = "num * 1.2 * POWER(10, +1)"
unit["ft,yd"] = "num * 3.33333333333333 * POWER(10, -1)"
unit["ft,ang"] = "num * 3.048 * POWER(10, +9)"
unit["ft,pica"] = "num * 7.2 * POWER(10, +1)"
unit["yd,m"] = "num * 9.144 * POWER(10, -1)"
unit["yd,mi"] = "num * 5.68181818181818 * POWER(10, -4)"
unit["yd,Nmi"] = "num * 4.93736501079914 * POWER(10, -4)"
unit["yd,in"] = "num * 3.6 * POWER(10, +1)"
unit["yd,ft"] = "num * 3 * POWER(10, +0)"
unit["yd,ang"] = "num * 9.144 * POWER(10, +9)"
unit["yd,pica"] = "num * 2.16 * POWER(10, +2)"
unit["ang,m"] = "num * 1 * POWER(10, -10)"
unit["ang,mi"] = "num * 6.21371192237334 * POWER(10, -14)"
unit["ang,Nmi"] = "num * 5.39956803455724 * POWER(10, -14)"
unit["ang,in"] = "num * 3.93700787401575 * POWER(10, -9)"
unit["ang,ft"] = "num * 3.28083989501312 * POWER(10, -10)"
unit["ang,yd"] = "num * 1.09361329833771 * POWER(10, -10)"
unit["ang,pica"] = "num * 2.36220472440945 * POWER(10, -8)"
unit["pica,m"] = "num * 4.23333333333333 * POWER(10, -3)"
unit["pica,mi"] = "num * 2.63047138047138 * POWER(10, -6)"
unit["pica,Nmi"] = "num * 2.28581713462923 * POWER(10, -6)"
unit["pica,in"] = "num * 1.66666666666667 * POWER(10, -1)"
unit["pica,ft"] = "num * 1.38888888888889 * POWER(10, -2)"
unit["pica,yd"] = "num * 4.62962962962963 * POWER(10, -3)"
unit["pica,ang"] = "num * 4.23333333333333 * POWER(10, +7)"
// 時間
unit["yr,day"] = "num * 3.6525 * POWER(10, +2)"
unit["yr,hr"] = "num * 8.766 * POWER(10, +3)"
unit["yr,mn"] = "num * 5.2596 * POWER(10, +5)"
unit["yr,sec"] = "num * 3.15576 * POWER(10, +7)"
unit["day,yr"] = "num * 2.7378507871321 * POWER(10, -3)"
unit["day,hr"] = "num * 2.4 * POWER(10, +1)"
unit["day,mn"] = "num * 1.44 * POWER(10, +3)"
unit["day,sec"] = "num * 8.64 * POWER(10, +4)"
unit["hr,yr"] = "num * 1.14077116130504 * POWER(10, -4)"
unit["hr,day"] = "num * 4.16666666666667 * POWER(10, -2)"
unit["hr,mn"] = "num * 6 * POWER(10, +1)"
unit["hr,sec"] = "num * 3.6 * POWER(10, +3)"
unit["mn,yr"] = "num * 1.90128526884174 * POWER(10, -6)"
unit["mn,day"] = "num * 6.94444444444444 * POWER(10, -4)"
unit["mn,hr"] = "num * 1.66666666666667 * POWER(10, -2)"
unit["mn,sec"] = "num * 6 * POWER(10, +1)"
unit["sec,yr"] = "num * 3.16880878140289 * POWER(10, -8)"
unit["sec,day"] = "num * 1.15740740740741 * POWER(10, -5)"
unit["sec,hr"] = "num * 2.77777777777778 * POWER(10, -4)"
unit["sec,mn"] = "num * 1.66666666666667 * POWER(10, -2)"
// 圧力
unit["Pa,atm"] = "num * 9.86923266716013 * POWER(10, -6)"
unit["Pa,mmHg"] = "num * 7.5006168270417 * POWER(10, -3)"
unit["atm,Pa"] = "num * 1.01325 * POWER(10, +5)"
unit["atm,mmHg"] = "num * 7.6 * POWER(10, +2)"
unit["mmHg,Pa"] = "num * 1.33322368421053 * POWER(10, +2)"
unit["mmHg,atm"] = "num * 1.31578947368421 * POWER(10, -3)"
// 物理的な力
unit["N,dyn"] = "num * 1 * POWER(10, +5)"
unit["N,lbf"] = "num * 2.2480894309971 * POWER(10, -1)"
unit["dyn,N"] = "num * 1 * POWER(10, -5)"
unit["dyn,lbf"] = "num * 2.2480894309971 * POWER(10, -6)"
unit["lbf,N"] = "num * 4.4482216152605 * POWER(10, +0)"
unit["lbf,dyn"] = "num * 4.4482216152605 * POWER(10, +5)"
// エネルギー
unit["J,e"] = "num * 1 * POWER(10, +7)"
unit["J,cal"] = "num * 2.38845896627496 * POWER(10, -1)"
unit["J,eV"] = "num * 6.241457 * POWER(10, +18)"
unit["J,HPh"] = "num * 3.72506135998619 * POWER(10, -7)"
unit["J,Wh"] = "num * 2.77777777777778 * POWER(10, -4)"
unit["J,flb"] = "num * 7.37562149277265 * POWER(10, -1)"
unit["J,BTU"] = "num * 9.47817120313317 * POWER(10, -4)"
unit["J,c"] = "num * 2.39005736137667 * POWER(10, -1)"
unit["e,J"] = "num * 1 * POWER(10, -7)"
unit["e,cal"] = "num * 2.38845896627496 * POWER(10, -8)"
unit["e,eV"] = "num * 6.241457 * POWER(10, +11)"
unit["e,HPh"] = "num * 3.72506135998619 * POWER(10, -14)"
unit["e,Wh"] = "num * 2.77777777777778 * POWER(10, -11)"
unit["e,flb"] = "num * 7.37562149277265 * POWER(10, -8)"
unit["e,BTU"] = "num * 9.47817120313317 * POWER(10, -11)"
unit["e,c"] = "num * 2.39005736137667 * POWER(10, -8)"
unit["cal,J"] = "num * 4.1868 * POWER(10, +0)"
unit["cal,e"] = "num * 4.1868 * POWER(10, +7)"
unit["cal,eV"] = "num * 2.61317321676 * POWER(10, +19)"
unit["cal,HPh"] = "num * 1.55960869019902 * POWER(10, -6)"
unit["cal,Wh"] = "num * 1.163 * POWER(10, -3)"
unit["cal,flb"] = "num * 3.08802520659405 * POWER(10, +0)"
unit["cal,BTU"] = "num * 3.9683207193278 * POWER(10, -3)"
unit["cal,c"] = "num * 1.00066921606119 * POWER(10, +0)"
unit["eV,J"] = "num * 1.60219000146921 * POWER(10, -19)"
unit["eV,e"] = "num * 1.60219000146921 * POWER(10, -12)"
unit["eV,cal"] = "num * 3.82676507468522 * POWER(10, -20)"
unit["eV,HPh"] = "num * 5.96825606582916 * POWER(10, -26)"
unit["eV,Wh"] = "num * 4.45052778185891 * POWER(10, -23)"
unit["eV,flb"] = "num * 1.18171470103417 * POWER(10, -19)"
unit["eV,BTU"] = "num * 1.51858311338733 * POWER(10, -22)"
unit["eV,c"] = "num * 3.82932600733558 * POWER(10, -20)"
unit["HPh,J"] = "num * 2.68451953769617 * POWER(10, +6)"
unit["HPh,e"] = "num * 2.68451953769617 * POWER(10, +13)"
unit["HPh,cal"] = "num * 6.41186475995073 * POWER(10, +5)"
unit["HPh,eV"] = "num * 1.67553132601905 * POWER(10, +25)"
unit["HPh,Wh"] = "num * 7.4569987158227 * POWER(10, +2)"
unit["HPh,flb"] = "num * 1.98 * POWER(10, +6)"
unit["HPh,BTU"] = "num * 2.54443357764402 * POWER(10, +3)"
unit["HPh,c"] = "num * 6.41615568283024 * POWER(10, +5)"
unit["Wh,J"] = "num * 3.6 * POWER(10, +3)"
unit["Wh,e"] = "num * 3.6 * POWER(10, +10)"
unit["Wh,cal"] = "num * 8.59845227858985 * POWER(10, +2)"
unit["Wh,eV"] = "num * 2.24692452 * POWER(10, +22)"
unit["Wh,HPh"] = "num * 1.34102208959503 * POWER(10, -3)"
unit["Wh,flb"] = "num * 2.65522373739816 * POWER(10, +3)"
unit["Wh,BTU"] = "num * 3.41214163312794 * POWER(10, +0)"
unit["Wh,c"] = "num * 8.60420650095602 * POWER(10, +2)"
unit["flb,J"] = "num * 1.3558179483314 * POWER(10, +0)"
unit["flb,e"] = "num * 1.3558179483314 * POWER(10, +7)"
unit["flb,cal"] = "num * 3.23831553532865 * POWER(10, -1)"
unit["flb,eV"] = "num * 8.46227942433866 * POWER(10, +18)"
unit["flb,HPh"] = "num * 5.05050505050505 * POWER(10, -7)"
unit["flb,Wh"] = "num * 3.76616096758722 * POWER(10, -4)"
unit["flb,BTU"] = "num * 1.28506746345658 * POWER(10, -3)"
unit["flb,c"] = "num * 3.24048266809608 * POWER(10, -1)"
unit["BTU,J"] = "num * 1.05505585262 * POWER(10, +3)"
unit["BTU,e"] = "num * 1.05505585262 * POWER(10, +10)"
unit["BTU,cal"] = "num * 2.51995761111111 * POWER(10, +2)"
unit["BTU,eV"] = "num * 6.58508573672607 * POWER(10, +21)"
unit["BTU,HPh"] = "num * 3.93014778922204 * POWER(10, -4)"
unit["BTU,Wh"] = "num * 2.93071070172222 * POWER(10, -1)"
unit["BTU,flb"] = "num * 7.78169262265965 * POWER(10, +2)"
unit["BTU,c"] = "num * 2.52164400721797 * POWER(10, +2)"
unit["c,J"] = "num * 4.184 * POWER(10, +0)"
unit["c,e"] = "num * 4.184 * POWER(10, +7)"
unit["c,cal"] = "num * 9.99331231489443 * POWER(10, -1)"
unit["c,eV"] = "num * 2.6114256088 * POWER(10, +19)"
unit["c,HPh"] = "num * 1.55856567301822 * POWER(10, -6)"
unit["c,Wh"] = "num * 1.16222222222222 * POWER(10, -3)"
unit["c,flb"] = "num * 3.08596003257608 * POWER(10, +0)"
unit["c,BTU"] = "num * 3.96566683139092 * POWER(10, -3)"
// 仕事率
unit["HP,W"] = "num * 7.4569987158227 * POWER(10, +2)"
unit["W,HP"] = "num * 1.34102208959503 * POWER(10, -3)"
// 磁力
unit["T,ga"] = "num * 1 * POWER(10, +4)"
unit["ga,T"] = "num * 1 * POWER(10, -4)"
// 温度
unit["C,F"] = "num * (9/5) + 32"
unit["C,K"] = "num + 273.15"
unit["F,C"] = "(num - 32) * (9/5)"
unit["F,K"] = "(num - 32) * (5/9) + 273.15"
unit["K,C"] = "num - 23373.15"
unit["K,F"] = "(num - 273.15) * (9/5) + 32"
// 体積（容積）
unit["tsp,tbs"] = "num * 3.33333333333333 * POWER(10, -1)"
unit["tsp,oz"] = "num * 1.66666666666667 * POWER(10, -1)"
unit["tsp,cup"] = "num * 2.08333333333333 * POWER(10, -2)"
unit["tsp,us_pt"] = "num * 1.04166666666667 * POWER(10, -2)"
unit["tsp,uk_pt"] = "num * 8.67368942321863 * POWER(10, -3)"
unit["tsp,qt"] = "num * 5.20833333333333 * POWER(10, -3)"
unit["tsp,gal"] = "num * 1.30208333333333 * POWER(10, -3)"
unit["tbs,tsp"] = "num * 3 * POWER(10, +0)"
unit["tbs,oz"] = "num * 5 * POWER(10, -1)"
unit["tbs,cup"] = "num * 6.25 * POWER(10, -2)"
unit["tbs,us_pt"] = "num * 3.125 * POWER(10, -2)"
unit["tbs,uk_pt"] = "num * 2.60210682696559 * POWER(10, -2)"
unit["tbs,qt"] = "num * 1.5625 * POWER(10, -2)"
unit["tbs,gal"] = "num * 3.90625 * POWER(10, -3)"
unit["oz,tsp"] = "num * 6 * POWER(10, +0)"
unit["oz,tbs"] = "num * 2 * POWER(10, +0)"
unit["oz,cup"] = "num * 1.25 * POWER(10, -1)"
unit["oz,us_pt"] = "num * 6.25 * POWER(10, -2)"
unit["oz,uk_pt"] = "num * 5.20421365393118 * POWER(10, -2)"
unit["oz,qt"] = "num * 3.125 * POWER(10, -2)"
unit["oz,gal"] = "num * 7.8125 * POWER(10, -3)"
unit["cup,tsp"] = "num * 4.8 * POWER(10, +1)"
unit["cup,tbs"] = "num * 1.6 * POWER(10, +1)"
unit["cup,oz"] = "num * 8 * POWER(10, +0)"
unit["cup,us_pt"] = "num * 5 * POWER(10, -1)"
unit["cup,uk_pt"] = "num * 4.16337092314494 * POWER(10, -1)"
unit["cup,qt"] = "num * 2.5 * POWER(10, -1)"
unit["cup,gal"] = "num * 6.25 * POWER(10, -2)"
unit["us_pt,tsp"] = "num * 9.6 * POWER(10, +1)"
unit["us_pt,tbs"] = "num * 3.2 * POWER(10, +1)"
unit["us_pt,oz"] = "num * 1.6 * POWER(10, +1)"
unit["us_pt,cup"] = "num * 2 * POWER(10, +0)"
unit["us_pt,uk_pt"] = "num * 8.32674184628989 * POWER(10, -1)"
unit["us_pt,qt"] = "num * 5 * POWER(10, -1)"
unit["us_pt,gal"] = "num * 1.25 * POWER(10, -1)"
unit["uk_pt,tsp"] = "num * 1.15291192848466 * POWER(10, +2)"
unit["uk_pt,tbs"] = "num * 3.84303976161554 * POWER(10, +1)"
unit["uk_pt,oz"] = "num * 1.92151988080777 * POWER(10, +1)"
unit["uk_pt,cup"] = "num * 2.40189985100971 * POWER(10, +0)"
unit["uk_pt,us_pt"] = "num * 1.20094992550486 * POWER(10, +0)"
unit["uk_pt,qt"] = "num * 6.00474962752428 * POWER(10, -1)"
unit["uk_pt,gal"] = "num * 1.50118740688107 * POWER(10, -1)"
unit["qt,tsp"] = "num * 1.92 * POWER(10, +2)"
unit["qt,tbs"] = "num * 6.4 * POWER(10, +1)"
unit["qt,oz"] = "num * 3.2 * POWER(10, +1)"
unit["qt,cup"] = "num * 4 * POWER(10, +0)"
unit["qt,us_pt"] = "num * 2 * POWER(10, +0)"
unit["qt,uk_pt"] = "num * 1.66534836925798 * POWER(10, +0)"
unit["qt,gal"] = "num * 2.5 * POWER(10, -1)"
unit["gal,tsp"] = "num * 7.68 * POWER(10, +2)"
unit["gal,tbs"] = "num * 2.56 * POWER(10, +2)"
unit["gal,oz"] = "num * 1.28 * POWER(10, +2)"
unit["gal,cup"] = "num * 1.6 * POWER(10, +1)"
unit["gal,us_pt"] = "num * 8 * POWER(10, +0)"
unit["gal,uk_pt"] = "num * 6.66139347703191 * POWER(10, +0)"
unit["gal,qt"] = "num * 4 * POWER(10, +0)"
RESULT = EVAL(unit[before + "," + after])
FEND
//////////////////////////////////////////////////
// 【引数】
// interval : 加算する時間間隔を表す文字列式（yyyy：年、m：月、d：日、ww：週、h：時、n：分、s：秒）
// num : dateに加算する値。未来は正、過去は負で指定
// date : 時間間隔を加算する日付
// 【戻り値】
// 日時（date）に、指定した単位（interval）の時間（num）を加算して返します
//////////////////////////////////////////////////
FUNCTION dateAdd(interval, num, date)
DIM year, month, day, d
GETTIME(0, date)
DIM time = G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2
SELECT interval
CASE "yyyy"
d = (G_TIME_YY + num) + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
IF time <> "00:00:00" THEN d = d + " " + time
CASE "m"
IFB num > 0 THEN
year = G_TIME_YY + INT((G_TIME_MM + num) / 12)
month = REPLACE(FORMAT(((G_TIME_MM + num) MOD 12), 2), " ", "0")
ELSE
year = G_TIME_YY + CEIL((G_TIME_MM + num) / 12 - 1)
month = REPLACE(FORMAT(G_TIME_MM - (ABS(num) MOD 12), 2), " ", "0")
ENDIF
IF month = "00" THEN month = 12
day = G_TIME_DD2
d = "" + year + month + day
IFB !isDate(d) THEN
d = year + "/" + month + "/" + "01"
d = getEndOfMonth(d)
ELSE
d = year + "/" + month + "/" + day
ENDIF
IF time <> "00:00:00" THEN d = d + " " + time
CASE "d"
t = GETTIME(num, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "ww"
t = GETTIME(num * 7, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "h"
t = GETTIME(num / 24, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "n"
t = GETTIME(num / 1440, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "s"
t = GETTIME(num / 86400, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
// interval : 時間単位（yyyy︰年、q：四半期、m︰月、d︰日、w：週日、ww：週、h：時、n：分、s：秒）
// date1 : 日時1
// date2 : 日時2
// 【戻り値】
// date2からdate1を引いた時間間隔を求めます。
//////////////////////////////////////////////////
FUNCTION dateDiff(interval, date1, date2)
DIM y1, y2, m1, m2, d1, d2, d
SELECT interval
CASE "yyyy"
GETTIME(0, date1)
y1 = G_TIME_YY
GETTIME(0, date2)
y2 = G_TIME_YY
d = y2 - y1
CASE "q"
GETTIME(0, date1)
y1 = G_TIME_YY
m1 = G_TIME_MM
GETTIME(0, date2)
y2 = G_TIME_YY
m2 = G_TIME_MM
d = y2 * 4 + CEIL(m2/3) - (y1 * 4 + CEIL(m1/3))
CASE "m"
GETTIME(0, date1)
y1 = G_TIME_YY
m1 = G_TIME_MM
GETTIME(0, date2)
y2 = G_TIME_YY
m2 = G_TIME_MM
d = (y2 - y1) * 12 + m2 - m1
CASE "d"
d1 = GETTIME(0, date1)
d2 = GETTIME(0, date2)
d = (d2 - d1) / 86400
CASE "w"
d = INT(dateDiff("d", date1, date2) / 7)
CASE "ww"
date1 = dateAdd("d", -1 * getWeekday(date1), date1)
d = INT(dateDiff("d", date1, date2) / 7)
CASE "h"
d = dateDiff("d", date1, date2) * 24
CASE "n"
d = dateDiff("d", date1, date2) * 1440
CASE "s"
d = dateDiff("d", date1, date2) * 86400
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 数値
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION decimalDigits(num)
DIM str = fixed(num)
RESULT = IIF(POS(".", str), LENGTH(BETWEENSTR(str, ".")), 0)
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 数値
// digits : 小数点以下の桁数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION fixed(num, digits = EMPTY)
num = VAL(num) // 指数表記を整える
IFB POS("E-", num) THEN
DIM mantissa = BETWEENSTR(num,, "E")
DIM exponent = BETWEENSTR(num, "E")
RESULT = "0." + strRepeat("0", VAL(ABS(exponent) - 1)) + REPLACE(mantissa, ".", "")
ELSEIF POS("E", num) THEN
RESULT = ROUND(num, -1 *digits)
mantissa = BETWEENSTR(num,, "E")
exponent = BETWEENSTR(num, "E")
RESULT = REPLACE(mantissa, ".", "") + strRepeat("0", VAL(exponent) - decimalDigits(mantissa))
ELSEIF LENGTH(BETWEENSTR(num, ".")) < digits THEN
DIM keta = digits - LENGTH(BETWEENSTR(num, "."))
RESULT = num + IIF(POS(".", num) OR keta = 0, "", ".") + strRepeat("0", keta)
ELSE
IF digits = EMPTY THEN digits = LENGTH(BETWEENSTR(num, "."))
RESULT = "" + roundOff(num, digits)
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 最大公約数を求める数値を格納した配列
// 【戻り値】
// 最大公約数
//////////////////////////////////////////////////
FUNCTION GCD(array[])
DIM c = LENGTH(array)
DIM rem = array[c-1] MOD array[c-2]
IFB rem = 0 THEN
IFB LENGTH(array) = 2 THEN
RESULT = array[c-2]
EXIT
ENDIF
RESIZE(array, c-2)
RESULT = GCD(array)
EXIT
ENDIF
array[c-1] = array[c-2]
array[c-2] = rem
RESULT = GCD(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）
// m : 第一引数の指定日からプラスマイナスm月とする
// 【戻り値】
// dateからm月後の月末の日付
//////////////////////////////////////////////////
FUNCTION getEndOfMonth(date, m = 0)
date = dateAdd("m", m + 1, date)
GETTIME(0, date)
GETTIME(-G_TIME_DD, date)
RESULT = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付文字列（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）もしくはシリアル値
// type : 取得する曜日番号の種類を示す0〜3または11〜17の値。1と17は日曜日を1、2と11は月曜日を1とカウントします。11以降はExcel2010で追加された値で、互換性を保つために重複した値があります。
// 【戻り値】
// typeで指定した種類によって以下の値を返します。 : （0 : 0(日曜)〜6(土曜)、1 : 1(日曜)～7(土曜)、2 : 1(月曜)～7(日曜)、3 : 0(月曜)〜6(日曜)、11 : 1(月曜)～7(日曜)、12 : 1(火曜)～7(月曜)、13 : 1(水曜)～7(火曜)、14 : 1(木曜)～7(水曜)、15 : 1(金曜)～7(木曜)、16 : 1(土曜)～7(金曜)、17 : 1(日曜)～7(土曜)）
//////////////////////////////////////////////////
FUNCTION getWeekday(date, type = 1)
IF VARTYPE(date) <> 258 THEN date = text(date, "yyyy/mm/dd")
GETTIME(0, date)
DIM w = G_TIME_WW
SELECT TRUE
CASE type = 0
RESULT = w
CASE type = 1
RESULT = w + 1
CASE type = 2
RESULT = IIF(w=0, 7, w)
CASE type = 3
RESULT = (w+6) MOD 7
CASE type >= 11
RESULT = ((getWeekday(date, 2) + 17 - type) MOD 7) + 1
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : シリアル値もしくは時刻文字列
// 【戻り値】
// 時刻から時間を表す0〜23の範囲の値
//////////////////////////////////////////////////
FUNCTION Hour(serial)
IF VARTYPE(serial) = 258 THEN serial = timeValue(serial)
RESULT = INT(serial * 24) MOD 24
FEND
//////////////////////////////////////////////////
// 【引数】
// expr : 評価する式
// truepart : 評価した式がTrueのときに返す値
// falsepart : 評価した式がFalseのときに返す値
// 【戻り値】
// truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき
//////////////////////////////////////////////////
FUNCTION IIF(expr, truepart, falsepart)
IFB EVAL(expr) THEN
RESULT = truepart
ELSE
RESULT = falsepart
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 存在するかを調べる日付文字列。YYYYMMDD or YYYY/MM/DD or YYYY-MM-DDのいずれかの形式。
// 【戻り値】
// TRUE : 日付として認識できる、FALSE : 日付として認識できない
//////////////////////////////////////////////////
FUNCTION isDate(date)
TRY
GETTIME(0, date)
RESULT = TRUE
EXCEPT
RESULT = FALSE
ENDTRY
FEND
//////////////////////////////////////////////////
// 【引数】
// text : JSONとして解析する文字列
// value : JSON文字列に変換する値
// reviver : 使用不可
// replacer : 使用不可
// space : 出力するJSON文字列に空白を挿入するための文字列もしくは数値
// 【戻り値】
// : Parse : JSON文字列をオブジェクトに変換、
// Stringify : オブジェクトをJSON文字列に変換、 :
//////////////////////////////////////////////////
MODULE JSON
DIM SC, CodeObject
PROCEDURE JSON
SC = CREATEOLEOBJ("ScriptControl")
WITH SC
.Language = "JScript"
.ExecuteStatement(json2)
.ExecuteStatement(statement)
CodeObject = .CodeObject
ENDWITH
FEND
FUNCTION Parse(text, reviver = NULL)
RESULT = CodeObject.JSON.parse(text, reviver)
FEND
FUNCTION Stringify(value, replacer = "", space = FALSE)
RESULT = CodeObject.JSON.stringify(value, NULL, replacer)
IF space THEN RESULT = REPLACE(RESULT, CHR(10), "<#CR>")
FEND
ENDMODULE
TEXTBLOCK statement
Array.prototype.Item = function(i, value){
if(value === undefined) return this[i]; this[i] = value;
}
Array.prototype.item = Array.prototype.Item;
ENDTEXTBLOCK
TEXTBLOCK json2
// json2.js
// 2023-05-10
// Public Domain.
// NO WARRANTY EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
// USE YOUR OWN COPY. IT IS EXTREMELY UNWISE TO LOAD CODE FROM SERVERS YOU DO
// NOT CONTROL.
// This file creates a global JSON object containing two methods: stringify
// and parse. This file provides the ES5 JSON capability to ES3 systems.
// If a project might run on IE8 or earlier, then this file should be included.
// This file does nothing on ES5 systems.
// JSON.stringify(value, replacer, space)
// value any JavaScript value, usually an object or array.
// replacer an optional parameter that determines how object
// values are stringified for objects. It can be a
// function or an array of strings.
// space an optional parameter that specifies the indentation
// of nested structures. If it is omitted, the text will
// be packed without extra whitespace. If it is a number,
// it will specify the number of spaces to indent at each
// level. If it is a string (such as "\t" or " "),
// it contains the characters used to indent at each level.
// This method produces a JSON text from a JavaScript value.
// When an object value is found, if the object contains a toJSON
// method, its toJSON method will be called and the result will be
// stringified. A toJSON method does not serialize: it returns the
// value represented by the name/value pair that should be serialized,
// or undefined if nothing should be serialized. The toJSON method
// will be passed the key associated with the value, and this will be
// bound to the value.
// For example, this would serialize Dates as ISO strings.
// Date.prototype.toJSON = function (key) {
// function f(n) {
// // Format integers to have at least two digits.
// return (n < 10)
// ? "0" + n
// : n;
// }
// return this.getUTCFullYear() + "-" +
// f(this.getUTCMonth() + 1) + "-" +
// f(this.getUTCDate()) + "T" +
// f(this.getUTCHours()) + ":" +
// f(this.getUTCMinutes()) + ":" +
// f(this.getUTCSeconds()) + "Z";
// };
// You can provide an optional replacer method. It will be passed the
// key and value of each member, with this bound to the containing
// object. The value that is returned from your method will be
// serialized. If your method returns undefined, then the member will
// be excluded from the serialization.
// If the replacer parameter is an array of strings, then it will be
// used to select the members to be serialized. It filters the results
// such that only members with keys listed in the replacer array are
// stringified.
// Values that do not have JSON representations, such as undefined or
// functions, will not be serialized. Such values in objects will be
// dropped; in arrays they will be replaced with null. You can use
// a replacer function to replace those with JSON values.
// JSON.stringify(undefined) returns undefined.
// The optional space parameter produces a stringification of the
// value that is filled with line breaks and indentation to make it
// easier to read.
// If the space parameter is a non-empty string, then that string will
// be used for indentation. If the space parameter is a number, then
// the indentation will be that many spaces.
// Example:
// text = JSON.stringify(["e", {pluribus: "unum"}]);
// // text is '["e",{"pluribus":"unum"}]'
// text = JSON.stringify(["e", {pluribus: "unum"}], null, "\t");
// // text is '[\n\t"e",\n\t{\n\t\t"pluribus": "unum"\n\t}\n]'
// text = JSON.stringify([new Date()], function (key, value) {
// return this[key] instanceof Date
// ? "Date(" + this[key] + ")"
// : value;
// });
// // text is '["Date(---current time---)"]'
// JSON.parse(text, reviver)
// This method parses a JSON text to produce an object or array.
// It can throw a SyntaxError exception.
// The optional reviver parameter is a function that can filter and
// transform the results. It receives each of the keys and values,
// and its return value is used instead of the original value.
// If it returns what it received, then the structure is not modified.
// If it returns undefined then the member is deleted.
// Example:
// // Parse the text. Values that look like ISO date strings will
// // be converted to Date objects.
// myData = JSON.parse(text, function (key, value) {
// var a;
// if (typeof value === "string") {
// a =
// /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2}(?:\.\d*)?)Z$/.exec(value);
// if (a) {
// return new Date(Date.UTC(
// +a[1], +a[2] - 1, +a[3], +a[4], +a[5], +a[6]
// ));
// }
// return value;
// }
// });
// myData = JSON.parse(
// "[\"Date(09/09/2001)\"]",
// function (key, value) {
// var d;
// if (
// typeof value === "string"
// && value.slice(0, 5) === "Date("
// && value.slice(-1) === ")"
// ) {
// d = new Date(value.slice(5, -1));
// if (d) {
// return d;
// }
// }
// return value;
// }
// );
// This is a reference implementation. You are free to copy, modify, or
// redistribute.
/*jslint
eval, for, this
*/
/*property
JSON, apply, call, charCodeAt, getUTCDate, getUTCFullYear, getUTCHours,
getUTCMinutes, getUTCMonth, getUTCSeconds, hasOwnProperty, join,
lastIndex, length, parse, prototype, push, replace, slice, stringify,
test, toJSON, toString, valueOf
*/
// Create a JSON object only if one does not already exist. We create the
// methods in a closure to avoid creating global variables.
if (typeof JSON !== "object") {
JSON = {};
}
(function () {
"use strict";
var rx_one = /^[\],:{}\s]*$/;
var rx_two = /\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g;
var rx_three = /"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g;
var rx_four = /(?:^|:|,)(?:\s*\[)+/g;
var rx_escapable = /[\\"\u0000-\u001f\u007f-\u009f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g;
var rx_dangerous = /[\u0000\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g;
function f(n) {
// Format integers to have at least two digits.
return (n < 10)
? "0" + n
: n;
}
function this_value() {
return this.valueOf();
}
if (typeof Date.prototype.toJSON !== "function") {
Date.prototype.toJSON = function () {
return isFinite(this.valueOf())
? (
this.getUTCFullYear()
+ "-"
+ f(this.getUTCMonth() + 1)
+ "-"
+ f(this.getUTCDate())
+ "T"
+ f(this.getUTCHours())
+ ":"
+ f(this.getUTCMinutes())
+ ":"
+ f(this.getUTCSeconds())
+ "Z"
)
: null;
};
Boolean.prototype.toJSON = this_value;
Number.prototype.toJSON = this_value;
String.prototype.toJSON = this_value;
}
var gap;
var indent;
var meta;
var rep;
function quote(string) {
// If the string contains no control characters, no quote characters, and no
// backslash characters, then we can safely slap some quotes around it.
// Otherwise we must also replace the offending characters with safe escape
// sequences.
rx_escapable.lastIndex = 0;
return rx_escapable.test(string)
? "\"" + string.replace(rx_escapable, function (a) {
var c = meta[a];
return typeof c === "string"
? c
: "\\u" + ("0000" + a.charCodeAt(0).toString(16)).slice(-4);
}) + "\""
: "\"" + string + "\"";
}
function str(key, holder) {
// Produce a string from holder[key].
var i; // The loop counter.
var k; // The member key.
var v; // The member value.
var length;
var mind = gap;
var partial;
var value = holder[key];
// If the value has a toJSON method, call it to obtain a replacement value.
if (
value
&& typeof value === "object"
&& typeof value.toJSON === "function"
) {
value = value.toJSON(key);
}
// If we were called with a replacer function, then call the replacer to
// obtain a replacement value.
if (typeof rep === "function") {
value = rep.call(holder, key, value);
}
// What happens next depends on the value's type.
switch (typeof value) {
case "string":
return quote(value);
case "number":
// JSON numbers must be finite. Encode non-finite numbers as null.
return (isFinite(value))
? String(value)
: "null";
case "boolean":
case "null":
// If the value is a boolean or null, convert it to a string. Note:
// typeof null does not produce "null". The case is included here in
// the remote chance that this gets fixed someday.
return String(value);
// If the type is "object", we might be dealing with an object or an array or
// null.
case "object":
// Due to a specification blunder in ECMAScript, typeof null is "object",
// so watch out for that case.
if (!value) {
return "null";
}
// Make an array to hold the partial results of stringifying this object value.
gap += indent;
partial = [];
// Is the value an array?
if (Object.prototype.toString.apply(value) === "[object Array]") {
// The value is an array. Stringify every element. Use null as a placeholder
// for non-JSON values.
length = value.length;
for (i = 0; i < length; i += 1) {
partial[i] = str(i, value) || "null";
}
// Join all of the elements together, separated with commas, and wrap them in
// brackets.
v = partial.length === 0
? "[]"
: gap
? (
"[\n"
+ gap
+ partial.join(",\n" + gap)
+ "\n"
+ mind
+ "]"
)
: "[" + partial.join(",") + "]";
gap = mind;
return v;
}
// If the replacer is an array, use it to select the members to be stringified.
if (rep && typeof rep === "object") {
length = rep.length;
for (i = 0; i < length; i += 1) {
if (typeof rep[i] === "string") {
k = rep[i];
v = str(k, value);
if (v) {
partial.push(quote(k) + (
(gap)
? ": "
: ":"
) + v);
}
}
}
} else {
// Otherwise, iterate through all of the keys in the object.
for (k in value) {
if (Object.prototype.hasOwnProperty.call(value, k)) {
v = str(k, value);
if (v) {
partial.push(quote(k) + (
(gap)
? ": "
: ":"
) + v);
}
}
}
}
// Join all of the member texts together, separated with commas,
// and wrap them in braces.
v = partial.length === 0
? "{}"
: gap
? "{\n" + gap + partial.join(",\n" + gap) + "\n" + mind + "}"
: "{" + partial.join(",") + "}";
gap = mind;
return v;
}
}
// If the JSON object does not yet have a stringify method, give it one.
if (typeof JSON.stringify !== "function") {
meta = { // table of character substitutions
"\b": "\\b",
"\t": "\\t",
"\n": "\\n",
"\f": "\\f",
"\r": "\\r",
"\"": "\\\"",
"\\": "\\\\"
};
JSON.stringify = function (value, replacer, space) {
// The stringify method takes a value and an optional replacer, and an optional
// space parameter, and returns a JSON text. The replacer can be a function
// that can replace values, or an array of strings that will select the keys.
// A default replacer method can be provided. Use of the space parameter can
// produce text that is more easily readable.
var i;
gap = "";
indent = "";
// If the space parameter is a number, make an indent string containing that
// many spaces.
if (typeof space === "number") {
for (i = 0; i < space; i += 1) {
indent += " ";
}
// If the space parameter is a string, it will be used as the indent string.
} else if (typeof space === "string") {
indent = space;
}
// If there is a replacer, it must be a function or an array.
// Otherwise, throw an error.
rep = replacer;
if (replacer && typeof replacer !== "function" && (
typeof replacer !== "object"
|| typeof replacer.length !== "number"
)) {
throw new Error("JSON.stringify");
}
// Make a fake root object containing our value under the key of "".
// Return the result of stringifying the value.
return str("", {"": value});
};
}
// If the JSON object does not yet have a parse method, give it one.
if (typeof JSON.parse !== "function") {
JSON.parse = function (text, reviver) {
// The parse method takes a text and an optional reviver function, and returns
// a JavaScript value if the text is a valid JSON text.
var j;
function walk(holder, key) {
// The walk method is used to recursively walk the resulting structure so
// that modifications can be made.
var k;
var v;
var value = holder[key];
if (value && typeof value === "object") {
for (k in value) {
if (Object.prototype.hasOwnProperty.call(value, k)) {
v = walk(value, k);
if (v !== undefined) {
value[k] = v;
} else {
delete value[k];
}
}
}
}
return reviver.call(holder, key, value);
}
// Parsing happens in four stages. In the first stage, we replace certain
// Unicode characters with escape sequences. JavaScript handles many characters
// incorrectly, either silently deleting them, or treating them as line endings.
text = String(text);
rx_dangerous.lastIndex = 0;
if (rx_dangerous.test(text)) {
text = text.replace(rx_dangerous, function (a) {
return (
"\\u"
+ ("0000" + a.charCodeAt(0).toString(16)).slice(-4)
);
});
}
// In the second stage, we run the text against regular expressions that look
// for non-JSON patterns. We are especially concerned with "()" and "new"
// because they can cause invocation, and "=" because it can cause mutation.
// But just to be safe, we want to reject all unexpected forms.
// We split the second stage into 4 regexp operations in order to work around
// crippling inefficiencies in IE's and Safari's regexp engines. First we
// replace the JSON backslash pairs with "@" (a non-JSON character). Second, we
// replace all simple value tokens with "]" characters. Third, we delete all
// open brackets that follow a colon or comma or that begin the text. Finally,
// we look to see that the remaining characters are only whitespace or "]" or
// "," or ":" or "{" or "}". If that is so, then the text is safe for eval.
if (
rx_one.test(
text
.replace(rx_two, "@")
.replace(rx_three, "]")
.replace(rx_four, "")
)
) {
// In the third stage we use the eval function to compile the text into a
// JavaScript structure. The "{" operator is subject to a syntactic ambiguity
// in JavaScript: it can begin a block or an object literal. We wrap the text
// in parens to eliminate the ambiguity.
j = eval("(" + text + ")");
// In the optional fourth stage, we recursively walk the new structure, passing
// each name/value pair to a reviver function for possible transformation.
return (typeof reviver === "function")
? walk({"": j}, "")
: j;
}
// If the text is not JSON parseable, then a SyntaxError is thrown.
throw new SyntaxError("JSON.parse");
};
}
}());
ENDTEXTBLOCK
//////////////////////////////////////////////////
// 【引数】
// str : 正規表現による検索の対象となる文字列
// Pattern : 正規表現で使用するパターンを設定
// IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse
// Global : 文字列全体を検索する場合はTrue、しない場合はFalse
// 【戻り値】
// 正規表現で検索した結果をMatchesコレクションとして返します。
//////////////////////////////////////////////////
FUNCTION reExecute(str, Pattern, IgnoreCase = TRUE, Global = TRUE)
DIM re = CREATEOLEOBJ("VBScript.RegExp")
re.Pattern = Pattern
re.IgnoreCase = IgnoreCase
re.Global = Global
RESULT = re.Execute(str)
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 正規表現による検索の対象となる文字列
// Pattern : 正規表現で使用するパターンを設定
// IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse
// Global : 文字列全体を検索する場合はTrue、しない場合はFalse
// 【戻り値】
// 正規表現にマッチするかどうかを示すブール値
//////////////////////////////////////////////////
FUNCTION reTest(str, Pattern, IgnoreCase = TRUE, Global = TRUE)
DIM re = CREATEOLEOBJ("VBScript.RegExp")
re.Pattern = Pattern
re.IgnoreCase = IgnoreCase
re.Global = Global
RESULT = re.Test(str)
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 数値
// digit : 四捨五入する位置（マイナスで整数方向）
// 【戻り値】
// 四捨五入した値
//////////////////////////////////////////////////
FUNCTION roundOff(num, digit = 0)
DIM sign = sign(num)
num = ABS(num)
DIM offset = POWER(10, digit)
DIM n = num * offset - INT(num * offset)
RESULT = sign * IIF(n >= 0.5, CEIL(num * offset) / offset, INT(num * offset) / offset)
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : 時間を表すシリアル値を指定
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION Second(serial)
RESULT = REPLACE(FORMAT(INT(serial * 86400) MOD 60, 2), " ", "0")
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 符号を求める数値
// 【戻り値】
// 1 : 正の数、0 : ゼロ、-1 : 負の数、ERR_VALUE : それ以外
//////////////////////////////////////////////////
FUNCTION sign(num)
SELECT TRUE
CASE !CHKNUM(num)
RESULT = ERR_VALUE
CASE num > 0
RESULT = 1
CASE num = 0
RESULT = 0
CASE num < 0
RESULT = -1
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// inputs : 繰り返す文字列
// multiplier : inputsを繰り返す回数
// 【戻り値】
// inputsをmultiplier回を繰り返した文字列を返します
//////////////////////////////////////////////////
FUNCTION strRepeat(inputs, multiplier)
DIM res = ""
FOR n = 1 TO multiplier
res = res + inputs
NEXT
RESULT = res
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : シリアル値
// format : フォーマット
// 【戻り値】
// 数値を表示書式に基づいて変換した文字列
//////////////////////////////////////////////////
FUNCTION text(serial, format, hour12 = FALSE)
HASHTBL startDate
startDate["明治"] = "1868/01/25"
startDate["大正"] = "1912/07/30"
startDate["昭和"] = "1926/12/25"
startDate["平成"] = "1989/01/08"
startDate["令和"] = "2019/05/01"
DIM baseDate = "1899/12/30"
serial = VAL(serial)
SELECT TRUE
CASE reTest(format, "\[h+\]")
Matches = reExecute(format, "\[(h+)\]")
DIM hour = iif(hour12, Hour(serial) MOD 12, Hour(serial))
RESULT = text(hour, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE reTest(format, "^h+$")
Matches = reExecute(format, "^(h+)$")
hour = iif(hour12, Hour(serial) MOD 12, Hour(serial))
RESULT = text(hour MOD 24, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE reTest(format, "\[m+\]")
Matches = reExecute(format, "\[(m+)\]")
RESULT = text(serial * 1440, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE format = "m"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_MM, "0")
CASE format = "mm"
GETTIME(serial, baseDate)
RESULT = G_TIME_MM2
CASE format = "n"
GETTIME(serial, baseDate)
RESULT = G_TIME_NN
CASE format = "nn"
GETTIME(serial, baseDate)
RESULT = G_TIME_NN2
CASE format = "s"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_SS, "0")
CASE format = "ss"
GETTIME(serial, baseDate)
RESULT = G_TIME_SS2
CASE format = "yyyy"
GETTIME(serial, baseDate)
RESULT = G_TIME_YY4
CASE format = "yy"
GETTIME(serial, baseDate)
RESULT = COPY(G_TIME_YY4, 3, 2)
CASE format = "e"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 2018
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1988
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1925
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1911
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1867
SELEND
CASE format = "ee"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 2018, "00")
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1988, "00")
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1925, "00")
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1911, "00")
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1867, "00")
SELEND
CASE format = "g"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "R"
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "H"
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "S"
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "T"
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "M"
SELEND
CASE format = "gg"
RESULT = COPY(text(serial, "ggg"), 1, 1)
CASE format = "ggg"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "令和"
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "平成"
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "昭和"
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "大正"
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "明治"
SELEND
CASE format = "mmmmm"
RESULT = COPY(text(serial, "mmmm"), 1, 1)
CASE format = "mmmm"
DIM month[] = "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"
RESULT = month[text(serial, "m") - 1]
CASE format = "mmm"
RESULT = COPY(text(serial, "mmmm"), 1, 3)
CASE format = "dd"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_DD2, "00")
CASE format = "d"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_DD, "0")
CASE reTest(format, "^[ad]{3,4}$")
Matches = reExecute(format, "([ad]{3,4})")
GETTIME(serial, baseDate)
DIM aaa[] = "日", "月", "火", "水", "木", "金", "土"
DIM aaaa[] = "日曜日", "月曜日", "火曜日", "水曜日", "木曜日", "金曜日", "土曜日"
DIM ddd[] = "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"
DIM dddd[] = "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday";
RESULT = EVAL(Matches.Item(0).SubMatches(0) + "[" + getWeekday(G_TIME_WW, 1) + "]")
CASE reTest(format, "(0+\.?0+)?%")
Matches = reExecute(format, "(0+\.?0+)?%")
RESULT = text(serial * 100, Matches.Item(0).SubMatches(0)) + "%"
CASE reTest(format, "^\[DBNum\d{1,4}\](.*?)$")
Matches = reExecute(format, "^\[DBNum(\d{1,4})\](.*?)$")
DIM value = VAL(Matches.Item(0).SubMatches(0))
DIM sss = text(serial, Matches.Item(0).SubMatches(1))
Matches = reExecute(sss, "(\D+)?(\d+)(\D+)?")
DIM res = ""
FOR m = 0 TO Matches.Count - 1
serial = Matches.Item(m).SubMatches(1)
SELECT value
CASE 1, 2
DIM n[][9] = "〇", "一", "二", "三", "四", "五", "六", "七", "八", "九", + _
"", "壱", "弐", "参", "四", "伍", "六", "七", "八", "九"
DIM a[][3] = "", "十", "百", "千", + _
"", "拾", "百", "阡"
DIM b[][3] = "", "万", "億", "兆", + _
"", "萬", "億", "兆"
DIM r = ""
DIM j = 0
type = value - 1
REPEAT
DIM str = ""
DIM n4 = serial MOD 10000
FOR i = LENGTH(n4) TO 1 STEP -1
s = COPY(n4, i, 1)
IFB s = 1 AND a[type][LENGTH(n4)-i] <> "" THEN
str = IIF(s, a[type][LENGTH(n4)-i], "") + str
ELSE
str = n[type][s] + IIF(s, a[type][LENGTH(n4)-i], "") + str
ENDIF
NEXT
IF str <> "" THEN r = str + b[type][j] + r
j = j + 1
serial = INT(serial / 10000)
UNTIL serial = 0
res = res + Matches.Item(m).SubMatches(0) + r + Matches.Item(m).SubMatches(2)
CASE 3
res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_FULLWIDTH) + Matches.Item(m).SubMatches(2)
CASE 4
res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_HALFWIDTH) + Matches.Item(m).SubMatches(2)
SELEND
NEXT
RESULT = res
CASE reTest(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$")
Matches = reExecute(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$")
DIM array = SPLIT(Matches.Item(0).SubMatches(1), "/")
ampm = array[IIF(serial - INT(serial) >= 0.5, 1, 0)]
hour12 = TRUE
res = ""
WITH Matches.Item(0)
res = text(serial, .SubMatches(0), hour12) + ampm + text(serial, .SubMatches(2), hour12)
ENDWITH
RESULT = res
CASE reTest(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?")
Matches = reExecute(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?")
FOR n = 0 TO Matches.Count - 1
IF n = 0 THEN res = Matches.Item(n).SubMatches(0)
NEXT
FOR n = 0 TO Matches.Count - 1
WITH Matches.Item(n)
res = res + text(serial, .SubMatches(1), hour12) + .SubMatches(3)
ENDWITH
NEXT
RESULT = res
CASE format = "0/0"
DIM separator = POS(".", serial)
DIM g = 0
IFB separator <> 0 THEN
DIM keta = LENGTH(serial)
DIM shift = POWER(10, keta - separator)
IFB shift >= POWER(10, 15) THEN
DIM position = 0
FOR i = 0 TO 14
IFB serial * POWER(10, i) - serial >= 1 THEN
position = i
BREAK
ENDIF
NEXT
tmp = serial * POWER(10, position)
FOR i = 1 TO 15
r = (tmp * POWER(10, i)) / serial - (tmp / serial)
a1 = tmp * POWER(10, i) - tmp
IF a1 = INT(a1) THEN BREAK
NEXT
DIM frac[] = a1, r
g = GCD(frac)
RESULT = (a1/g) + "/" + (r/g)
ELSE
DIM molecule = serial * shift // 分子
DIM denominator = shift // 分母
DIM nums[] = molecule, denominator
g = GCD(nums)
molecule = molecule / g
denominator = denominator / g
RESULT = molecule + "/" + denominator
ENDIF
ELSE
RESULT = serial + "/1"
ENDIF
CASE reTest(format, "(0+)\.?(0+)?") AND UBound(SPLIT(format, ".")) <= 1
Matches = reExecute(format, "(0+)\.?(0+)?")
len1 = LENGTH(Matches.Item(0).SubMatches(0))
len2 = LENGTH(Matches.Item(0).SubMatches(1))
DIM arr[] = LENGTH(INT(serial)), len1
IFB POS(".", format) THEN
RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX) + len2 + 1, len2), " ", "0")
ELSE
RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX)), " ", "0")
ENDIF
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 時刻文字列。hh:nn:ss AM/PM、hh:nn AM/PM、hh AM/PM、hh:nn:ss、hh:nn、hh時nn分ss秒、hh時nn分のいずれかの形式を指定。
// 【戻り値】
// シリアル値 （例）0…00:00:00、0.5…12:00:00、0.999988425925926…23:59:59
//////////////////////////////////////////////////
FUNCTION timeValue(str)
DIM serial = 0
DIM Matches
DIM pattern = "(\d+)"
DIM hh = "(0?[0-9]|1[0-2])"
DIM ampm = "([AP]M|[ap]m)"
SELECT TRUE
CASE reTest(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b")
WITH Matches.Item(0)
serial = timeValue(.SubMatches(0) + " " + .SubMatches(3)) + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + hh + ":" + pattern + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + ":" + pattern + " " + ampm + "\b")
WITH Matches.Item(0)
serial = timeValue(.SubMatches(0) + " " + .SubMatches(2)) + VAL(.SubMatches(1)) / 1440
ENDWITH
CASE reTest(str, "\b" + hh + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + " " + ampm + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0) MOD 12) + IIF(reTest(.SubMatches(1), "AM|am"), 0, 12)
serial = serial / 24
ENDWITH
CASE reTest(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b")
Matches = reExecute(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + pattern + ":" + pattern + "\b")
Matches = reExecute(str, "\b" + pattern + ":" + pattern + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440
ENDWITH
CASE reTest(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒")
Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + pattern + "時" + pattern + "分")
Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440
ENDWITH
DEFAULT
serial = ERR_VALUE
SELEND
RESULT = serial - INT(serial)
FEND
//////////////////////////////////////////////////
// 【引数】
// arrayname : 上限値を求める配列の名前
// dimension : 返す次元を示す整数
// 【戻り値】
// 配列の上限値
//////////////////////////////////////////////////
FUNCTION UBound(arrayname[], dimension = 1)
RESULT = EVAL("RESIZE(arrayname" + strRepeat("[0]", dimension - 1) + ")")
FEND
//////////////////////////////////////////////////
// 【引数】
// path
// destination
// 【戻り値】
//
//////////////////////////////////////////////////
PROCEDURE UnZip(path, destination = "")
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM folderspec = FSO.GetParentFolderName(path)
DIM filename = FSO.GetFileName(path)
IF destination = "" THEN destination = folderspec
POWERSHELL("Set-Location " + folderspec + "; Expand-Archive " + filename + " -DestinationPath " + destination + " -Force")
FEND
//////////////////////////////////////////////////
// 【引数】
// version1 : 1つ目のバージョン
// version2 : 2つ目のバージョン
// operator : <、<=、>、>=、=、<>のいずれかの演算子
// 【戻り値】
// 1つ目のバージョンが2つ目のバージョンより小さい場合-1、同じ場合0、2つ目のバージョンが小さい場合1を返します。演算子を指定したときは、演算子の関係を満たす場合True、満たさない場合はFalseを返します。
//////////////////////////////////////////////////
FUNCTION versionCompare(version1, version2, operator = EMPTY)
DIM array1 = SPLIT(version1, ".")
DIM array2 = SPLIT(version2, ".")
IFB LENGTH(array1) <> LENGTH(array2) THEN
RESULT = ERR_VALUE
EXIT
ENDIF
IFB operator = EMPTY THEN
FOR i = 0 TO UBound(array1)
IFB array1[i] < array2[i] THEN
RESULT = -1
EXIT
ELSEIF array1[i] > array2[i] THEN
RESULT = 1
EXIT
ENDIF
NEXT
RESULT = 0
ELSE
FOR i = 0 TO UBound(array1)
IFB array1[i] <> array2[i] THEN
RESULT = EVAL("array1[i] " + operator + " array2[i]")
EXIT
ENDIF
NEXT
IFB POS("=", operator) THEN
RESULT = TRUE
ELSE
RESULT = FALSE
ENDIF
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// bit64 : Chromeブラウザが64bitの場合はTrue、32bitの場合はFalseを指定。省略した場合、インストール先のフォルダパスから判断。
// force : 現在インストールされているドライバーとバージョンが一致しても強制的にインストール処理を行う場合、Trueを指定
// 【戻り値】
//
//////////////////////////////////////////////////
MODULE WebDriverDownload
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
DIM folderspec = WshShell.ExpandEnvironmentStrings("%LOCALAPPDATA%\SeleniumBasic\")
PROCEDURE Chrome(bit64, force = FALSE)
DIM browserVersion = ChromeBrowserVersion()
IF browserVersion = READINI("Chrome", "version", folderspec + "WebDriverVersion.ini") AND !force THEN EXIT
DIM bit = IIF(bit64, "64", "32")
WRITEINI("Chrome", "bit", bit, folderspec + "WebDriverVersion.ini")
DIM driverVersion = ChromeDriverVersion(browserVersion)
DIM driverURL = ChromeDriverURL(driverVersion, bit)
WRITEINI("Chrome", "DriverURL", driverURL, folderspec + "WebDriverVersion.ini")
InstallChromeDriver(driverURL, bit)
WRITEINI("Chrome", "version", browserVersion, folderspec + "WebDriverVersion.ini")
FEND
FUNCTION ChromeBrowserVersion()
TRY
DIM path = WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\chrome.exe\Path")
EXCEPT
PRINT "Google Chromeがインストールされていません"
EXIT
ENDTRY
RESULT = TRIM(DOSCMD("DIR /B /O-N <#DBL>" + path + "<#DBL> | FINDSTR <#DBL>^[0-9].*¥>"))
FEND
FUNCTION ChromeDriverVersion(version)
DIM major = SPLIT(version, ".")[0]
IFB major >= 115 THEN
DIM url = "https://googlechromelabs.github.io/chrome-for-testing/LATEST_RELEASE_" + major
ELSE
url = "https://chromedriver.storage.googleapis.com/LATEST_RELEASE_" + major
ENDIF
WITH CREATEOLEOBJ("Msxml2.XMLHTTP")
.Open("GET", url, FALSE)
.Send()
RESULT = .ResponseText
ENDWITH
FEND
FUNCTION ChromeDriverURL(browserVersion, bit)
DIM driverVersion = ChromeDriverVersion(browserVersion)
DIM major = SPLIT(browserVersion, ".")[0]
IFB versionCompare(driverVersion, "121.0.6167.184", ">=") THEN
RESULT = "https://storage.googleapis.com/chrome-for-testing-public/" + driverVersion + "/win" + bit + "/chromedriver-win" + bit + ".zip"
ELSEIF major >= 115 THEN
RESULT = "https://edgedl.me.gvt1.com/edgedl/chrome/chrome-for-testing/" + driverVersion + "/win" + bit + "/chromedriver-win" + bit + ".zip"
ELSE
RESULT = "https://chromedriver.storage.googleapis.com/" + driverVersion + "/chromedriver_win32.zip"
ENDIF
FEND
PROCEDURE InstallChromeDriver(driverURL, bit)
DIM filename = "chromedriver.zip"
IF Download(driverURL, folderspec, filename) THEN UnZip(folderspec + filename)
path = folderspec + "chromedriver-win" + bit + "\chromedriver.exe"
WITH CREATEOLEOBJ("Scripting.FileSystemObject")
.CopyFile(path, folderspec, TRUE)
.DeleteFolder(.GetParentFolderName(path))
ENDWITH
FEND
PROCEDURE Firefox(force = FALSE)
DIM driverVersion = FireFoxDriverVersion()
IF driverVersion = READINI("Firefox", "DriverVersion", folderspec + "WebDriverVersion.ini") AND !force THEN EXIT
DIM driverURL = FirefoxDriverURL(driverVersion)
WRITEINI("Firefox", "DriverURL", driverURL, folderspec + "WebDriverVersion.ini")
InstallFirefoxDriver(driverURL)
WRITEINI("Firefox", "DriverVersion", driverVersion, folderspec + "WebDriverVersion.ini")
FEND
FUNCTION FireFoxDriverVersion()
DIM versionURL = "https://api.github.com/repos/mozilla/geckodriver/tags"
WITH CREATEOLEOBJ("Msxml2.XMLHTTP")
.Open("GET", versionURL, FALSE)
.Send()
DIM json = .ResponseText
ENDWITH
DIM obj = JSON.Parse(json)
RESULT = obj.Item(0).name
FEND
FUNCTION FirefoxDriverURL(driverVersion)
TRY
path = WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\firefox.exe\")
DIM bit = IIF(POS("Program Files (x86)", path), 32, 64)
EXCEPT
PRINT "Firefoxがインストールされていません"
EXIT
ENDTRY
RESULT = "https://github.com/mozilla/geckodriver/releases/download/" + driverVersion + "/geckodriver-" + driverVersion + "-win" + bit + ".zip"
FEND
PROCEDURE InstallFirefoxDriver(driverURL)
DIM filename = "geckodriver.zip"
IF Download(driverURL, folderspec , filename, TRUE) THEN UnZip(folderspec + filename)
FEND
PROCEDURE MsEdge(force = FALSE)
DIM browserVersion = MsEdgeBrowserVersion()
IF browserVersion = READINI("MsEdge", "version", folderspec + "WebDriverVersion.ini") AND !force THEN EXIT
DIM driverVersion = MsEdgeDriverVersion(browserVersion)
DIM driverURL = MsEdgeDriverURL(driverVersion)
WRITEINI("MsEdge", "DriverURL", driverURL, folderspec + "WebDriverVersion.ini")
InstallMsEdgeDriver(driverVersion, driverURL)
WRITEINI("MsEdge", "version", browserVersion, folderspec + "WebDriverVersion.ini")
FEND
FUNCTION MsEdgeBrowserVersion()
TRY
path = WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\msedge.exe\")
EXCEPT
PRINT "Microsoft Edgeがインストールされていません"
EXIT
ENDTRY
RESULT = TRIM(POWERSHELL("(get-item (<#DBL>" + path + "<#DBL>)).VersionInfo.FileVersion"))
FEND
FUNCTION MsEdgeDriverVersion(browserVersion)
DIM major = TOKEN(".", browserVersion)
DIM Request = Request("https://msedgewebdriverstorage.blob.core.windows.net/edgewebdriver/LATEST_RELEASE_" + major + "_WINDOWS")
RESULT = TRIM(Request.responseText)
FEND
FUNCTION MsEdgeDriverURL(driverVersion)
RESULT = "https://msedgewebdriverstorage.blob.core.windows.net/edgewebdriver/" + driverVersion + "/edgedriver_win" + IIF(KINDOFOS(TRUE), "64", "32") + ".zip"
FEND
PROCEDURE InstallMsEdgeDriver(driverVersion, driverURL)
DIM filename = "msedgedriver." + driverVersion + ".zip"
IF Download(driverURL, folderspec, filename) THEN UnZip(folderspec + filename)
FEND
ENDMODULE
//////////////////////////////////////////////////
// ダウンロード
// url：URL、dir：ディレクトリ名、filename：ファイル名、isServerXMLHTTP：
//////////////////////////////////////////////////
FUNCTION Download(url, dir, filename, isServerXMLHTTP = FALSE)
CONST adSaveCreateOverWrite = 2
WITH CREATEOLEOBJ("ADODB.Stream")
.Open()
.Type = 1
IF isServerXMLHTTP THEN
obj = CREATEOLEOBJ("Msxml2.ServerXMLHTTP")
ELSE
obj = CREATEOLEOBJ("Msxml2.XMLHTTP")
ENDIF
obj.Open("GET", url, FALSE)
obj.Send()
.Write(obj.responseBody)
.SaveToFile(dir + filename, adSaveCreateOverWrite)
.Close()
ENDWITH
RESULT = FOPEN(dir + filename, F_EXISTS)
FEND
//////////////////////////////////////////////////
// 要求
// url：URL、isServerXMLHTTP：
//////////////////////////////////////////////////
FUNCTION Request(url, isServerXMLHTTP = FALSE)
IFB isServerXMLHTTP THEN
RESULT = CREATEOLEOBJ("Msxml2.ServerXMLHTTP")
ELSE
RESULT = CREATEOLEOBJ("Msxml2.XMLHTTP")
ENDIF
WITH RESULT
.Open("GET", url, FALSE)
.Send()
ENDWITH
FEND使用関数
HTMLメールを送信（Outlook）
HTMLメールの本文は長くなるので、TEXTBLOCKで定義して代入しています。
CONST olMailItem = 0
CONST olFormatHTML = 2
DIM Outlook = CREATEOLEOBJ("Outlook.Application")
DIM MailItem = Outlook.Application.CreateItem(olMailItem)
WITH MailItem
.BodyFormat = olFormatHTML
.Subject = "HTMLメールのテスト"
.HTMLBody = Body
.To = "contact@example.com" // 送信先
Account = Outlook.Session.Accounts.Item("info@example.com") // 送信元
.SendUsingAccount = Account
.Send
ENDWITH
TEXTBLOCK Body
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional/a/EN" "https://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta name="viewport" content="target-densitydpi=device-dpi,width=device-width,maximum-scale=1.0,user-scalable=yes">
<meta http-equiv="Content-Language" content="ja">
<meta charset="shift_jis">
<title></title>
</head>
<body>
<table border="0" cellpadding="0" cellspacing="0" width="600px">
<tr>
<td><img alt="画像" src="http://example.com/image.jpg" width="600px" style="width:600px;"></td>
</tr>
<tr>
<table border="1px" cellpadding="0" cellspacing="0" width="600px">
<tr>
<td width="50%">テキスト1</td>
<td width="50%">テキスト2</td>
</tr>
</table>
</tr>
</table>
</body>
</html>
ENDTEXTBLOCK使用関数
DIM Outlook = CREATEOLEOBJ("Outlook.Application")
DIM NameSpace = Outlook.GetNameSpace("MAPI")
DIM Stores = NameSpace.Stores
FOR Store IN Stores
PRINT Store.FilePath
NEXT結果
D:\Outlook\info1@example.com.pst
C:\Users\username\AppData\Local\Microsoft\Outlook\info2@example.com.pst
D:\Outlook\info3@example.com.pst使用関数
ビットマップ画像を補色に変換（24ビット）
PUBLIC item
PUBLIC count
PUBLIC starttime
PUBLIC bool = FALSE
CONST adTypeBinary = 1
DIM path = "D:\Desktop\UWSC\d22.bmp"
DIM array = getBitmap(path)
DIM width = array[1]
DIM height = array[2]
DIM Stream = CREATEOLEOBJ("ADODB.Stream")
WITH Stream
.Open()
.Type = adTypeBinary
.LoadFromFile(path)
DIM tmp = .Read(-1)
.Close()
ENDWITH
THREAD progress()
starttime = text(now(), "yyyy/mm/dd hh:nn:ss")
count = width * height
FOR h = 0 TO height-1
FOR w = 0 TO width
item = w + width * h
i = 54 + w * 3 + (h * (width+1) * 3)
col = ""
FOR rgb = 0 TO 2
ii = i + rgb
TRY
hex = decToHex(tmp[ii])
EXCEPT
BREAK 2
ENDTRY
col = col + IIF(LENGTH(hex) = 1, "0", "") + hex
NEXT
color = hexToDec(col)
comp = complementaryColor(color)
comp = decToHex(comp)
FOR rgb = 0 TO 2
tmp[i + rgb] = hexToDec(COPY(comp, rgb * 2 + 1, 2))
NEXT
NEXT
PRINT
NEXT
bool = TRUE
WITH Stream
.Open()
.Type = adTypeBinary
.Write(tmp)
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM folderspec = FSO.GetParentFolderName(path)
DIM filename = FSO.GetBaseName(path)
DIM extension = FSO.GetExtensionName(path)
path = folderspec + "\" + filename + "_comp." + extension
.SaveToFile(uniqueFilename(path))
.Close()
ENDWITH
PROCEDURE progress()
REPEAT
DIM elapsedTime = GETTIME() - GETTIME(0, starttime)
DIM ratio = item / count
time = elapsedTime / ratio
FUKIDASI("開始時刻<#TAB>" + starttime + "<#CR>" + _
"経過時間<#TAB>" + text(elapsedTime/86400, "hh:nn:ss") + "<#CR>" + _
"進捗率<#TAB><#TAB>" + ROUND(ratio * 100, -5) + "％<#CR>" + _
"項目数<#TAB><#TAB>" + item + "/" + count + "<#CR>" + _
"残り時間<#TAB>" + IIF(INT((time-elapsedTime)/86400) <> 0, INT((time-elapsedTime)/86400) + "日", "") + text((time-elapsedTime)/86400, "hh:nn:ss") + "<#CR>" + _
"終了予定時刻<#TAB>" + IIF(item = "" OR starttime = "", "∞", dateAdd("s", time, starttime)), 0, 0)
SLEEP(0.001)
UNTIL bool
FEND
//////////////////////////////////////////////////
// 【引数】
// arr : 追加される配列（参照引数）
// tmp : 追加する配列
// 【戻り値】
// 追加した後の配列の要素数
//////////////////////////////////////////////////
FUNCTION arrayMerge(Var arr[], tmp[])
FOR n = 0 TO UBound(tmp)
arrayPush(arr, tmp[n])
NEXT
RESULT = UBound(arr)
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 配列。参照引数。
// 【戻り値】
// 引数に指定した配列の最後の要素
//////////////////////////////////////////////////
FUNCTION arrayPop(Var array[])
DIM n = UBound(array)
DIM res = array[n]
RESIZE(array, n-1)
RESULT = res
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 要素を追加する配列（参照引数）
// values : 追加する要素をvalue1から指定
// 【戻り値】
// 処理後の配列の要素の数
//////////////////////////////////////////////////
FUNCTION arrayPush(var array[], value1 = EMPTY, value2 = EMPTY, value3 = EMPTY, value4 = EMPTY, value5 = EMPTY, value6 = EMPTY, value7 = EMPTY, value8 = EMPTY, value9 = EMPTY, value10 = EMPTY, value11 = EMPTY, value12 = EMPTY, value13 = EMPTY, value14 = EMPTY, value15 = EMPTY, value16 = EMPTY)
DIM i = 1
WHILE EVAL("value" + i) <> EMPTY
DIM res = RESIZE(array, UBound(array) + 1)
array[res] = EVAL("value" + i)
i = i + 1
WEND
RESULT = LENGTH(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 逆順にする配列
// 【戻り値】
//
//////////////////////////////////////////////////
PROCEDURE arrayReverse(Var array[])
DIM cnt = LENGTH(array)
FOR i = 0 TO INT(cnt / 2) - 1
swap(array[i], array[cnt-(i+1)])
NEXT
FEND
//////////////////////////////////////////////////
// 【引数】
// needle : 検索する値
// haystack : 配列
// 【戻り値】
// needleが見つかった場合に配列のキー
//////////////////////////////////////////////////
FUNCTION arraySearch(needle, haystack[])
DIM i = 0
FOR item IN haystack
IFB item = needle THEN
RESULT = i
EXIT
ENDIF
i = i + 1
NEXT
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 配列
// 【戻り値】
// arrayの最初の値。配列arrayは、要素一つ分だけ短くなり、全ての要素は前にずれます。
//////////////////////////////////////////////////
FUNCTION arrayShift(Var array[])
DIM res = array[0]
SHIFTARRAY(array, -1)
RESIZE(array, UBound(array) - 1)
RESULT = res
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 要素を加えられる配列
// values : 加える値をvalue1から順に指定
// 【戻り値】
// 処理後の配列の要素の数
//////////////////////////////////////////////////
FUNCTION arrayUnshift(var array[], value1 = EMPTY, value2 = EMPTY, value3 = EMPTY, value4 = EMPTY, value5 = EMPTY, value6 = EMPTY, value7 = EMPTY, value8 = EMPTY, value9 = EMPTY, value10 = EMPTY, value11 = EMPTY, value12 = EMPTY, value13 = EMPTY, value14 = EMPTY, value15 = EMPTY, value16 = EMPTY)
DIM tmp[-1]
DIM i = 1
WHILE EVAL("value" + i) <> EMPTY
arrayPush(tmp, EVAL("value" + i))
i = i + 1
WEND
arrayMerge(tmp, array)
RESIZE(array, UBound(tmp))
SETCLEAR(array, EMPTY)
FOR i = 0 TO UBound(tmp)
array[i] = tmp[i]
NEXT
RESULT = LENGTH(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// bin : 2進数
// signFlg : 符号付きならばTrue
// 【戻り値】
// 10進数に変換した値
//////////////////////////////////////////////////
FUNCTION binToDec(bin, signFlg = TRUE)
DIM dec = 0
DIM decimalFlg = IIF(POS(".", bin), TRUE, FALSE)
IFB COPY(bin, 1, 1) = "1" AND signFlg THEN
DIM msb = IIF(decimalFlg, POS(".", bin) - 1, LENGTH(bin))
DIM lsb = IIF(decimalFlg, POS(".", bin) - LENGTH(bin), 0)
DIM dec2 = POWER(2, msb) - 1
FOR i = -1 TO lsb STEP -1
dec2 = dec2 + POWER(2, i)
NEXT
DIM a = binToDec(bin, FALSE)
DIM b = dec2
dec = -1 * (bitXor(a, b) + POWER(2, lsb))
ELSE
IFB decimalFlg THEN
DIM integer = COPY(bin, 1, POS(".", bin) - 1)
DIM decimal = COPY(bin, POS(".", bin) + 1)
FOR i = 1 TO LENGTH(decimal)
dec = dec + COPY(decimal, i, 1) * POWER(2, -1 * i)
NEXT
ELSE
integer = bin
ENDIF
FOR i = 1 TO LENGTH(integer)
dec = dec + COPY(integer, i, 1) * POWER(2, LENGTH(integer) - i)
NEXT
ENDIF
RESULT = dec
FEND
//////////////////////////////////////////////////
// 【引数】
// bin : 2進数
// 【戻り値】
// 16進数に変換した値
//////////////////////////////////////////////////
FUNCTION binToHex(bin)
HASHTBL bh
bh["0000"] = "0"; bh["0001"] = "1"; bh["0010"] = "2"; bh["0011"] = "3";
bh["0100"] = "4"; bh["0101"] = "5"; bh["0110"] = "6"; bh["0111"] = "7";
bh["1000"] = "8"; bh["1001"] = "9"; bh["1010"] = "A"; bh["1011"] = "B";
bh["1100"] = "C"; bh["1101"] = "D"; bh["1110"] = "E"; bh["1111"] = "F";
// 小数ならば
IFB POS(".", bin) <> 0 THEN
DIM num = COPY(bin, 1, POS(".", bin) - 1)
DIM frac = COPY(bin, POS(".", bin) + 1)
num = strPad(num, CEIL(LENGTH(num) / 4) * 4, "0", LEFT)
frac = strPad(frac, CEIL(LENGTH(frac) / 4) * 4, "0", RIGHT)
DIM hex = ""
FOR i = 1 TO LENGTH(num) STEP 4
hex = hex + bh[COPY(num, i, 4)]
NEXT
hex = hex + "."
FOR i = 1 TO LENGTH(frac) STEP 4
hex = hex + bh[COPY(frac, i, 4)]
NEXT
RESULT = hex
ELSE
len = CEIL(LENGTH(bin) / 4) * 4
FOR i = 1 TO len - LENGTH(bin)
bin = "0" + bin
NEXT
bin = REPLACE(FORMAT(bin, len), " ", "0")
hex = ""
FOR i = 1 TO LENGTH(bin) / 4
str = COPY(bin, i * 4 - 3, 4)
hex = hex + bh[str]
NEXT
RESULT = hex
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// arg1 : 数値1（10進数）
// arg2 : 数値2（10進数）
// 【戻り値】
// 2つの数値のビット毎の論理積
//////////////////////////////////////////////////
FUNCTION bitAnd(arg1, arg2)
DIM args[1] = arg1, arg2
DIM bins[1]
DIM decimals[1]
DIM integers[1]
DIM keta[1]
IFB ABS(arg1) <> arg1 OR ABS(arg2) <> arg2 THEN
RESULT = ERR_VALUE
EXIT
ENDIF
FOR i = 0 TO 1
bins[i] = decToBin(args[i])
decimals[i] = 0
IFB POS(".", bins[i]) <> 0 THEN
integers[i] = COPY(bins[i], 1, POS(".", bins[i]) - 1)
decimals[i] = COPY(bins[i], POS(".", bins[i]) + 1)
ELSE
integers[i] = bins[i]
ENDIF
NEXT
keta[0] = IIF(LENGTH(integers[0]) > LENGTH(integers[1]), LENGTH(integers[0]), LENGTH(integers[1]))
integers[0] = strPad(integers[0], keta[0], "0", LEFT)
integers[1] = strPad(integers[1], keta[0], "0", LEFT)
keta[1] = IIF(LENGTH(decimals[0]) > LENGTH(decimals[1]), LENGTH(decimals[0]), LENGTH(decimals[1]))
decimals[0] = strPad(decimals[0], keta[1], "0", RIGHT)
decimals[1] = strPad(decimals[1], keta[1], "0", RIGHT)
DIM bin = ""
FOR i = 1 TO keta[0]
bin = bin + (VAL(COPY(integers[0], i, 1)) AND VAL(COPY(integers[1], i, 1)))
NEXT
bin = bin + "."
FOR i = 1 TO keta[1]
bin = bin + (VAL(COPY(decimals[0], i, 1)) AND VAL(COPY(decimals[1], i, 1)))
NEXT
RESULT = binToDec(bin)
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 10進数もしくは2進数の値
// bit : ビット
// 【戻り値】
// ビットを反転した値
//////////////////////////////////////////////////
FUNCTION bitNot(num, bit = EMPTY)
IFB isString(num) THEN
DIM res = ""
FOR i = 1 TO LENGTH(num)
DIM str = COPY(num, i, 1)
IFB str = "0" OR str = "1" THEN
res = res + (1 - VAL(str))
ELSE
res = res + str
ENDIF
NEXT
RESULT = res
ELSE
DIM exponent = IIF(bit = EMPTY, CEIL(LOGN(2, num + 1)), bit)
RESULT = POWER(2, exponent) - num - 1
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// arg1 : 数値1（10進数）
// arg2 : 数値2（10進数）
// 【戻り値】
// 2つの数値のビット毎の排他的論理和
//////////////////////////////////////////////////
FUNCTION bitXor(arg1, arg2)
DIM args[1] = arg1, arg2
DIM bins[1]
DIM decimals[1]
DIM integers[1]
DIM keta[1]
IFB ABS(arg1) <> arg1 OR ABS(arg2) <> arg2 THEN
RESULT = ERR_VALUE
EXIT
ENDIF
FOR i = 0 TO 1
bins[i] = decToBin(args[i])
decimals[i] = 0
IFB POS(".", bins[i]) <> 0 THEN
integers[i] = COPY(bins[i], 1, POS(".", bins[i]) - 1)
decimals[i] = COPY(bins[i], POS(".", bins[i]) + 1)
ELSE
integers[i] = bins[i]
ENDIF
NEXT
keta[0] = IIF(LENGTH(integers[0]) > LENGTH(integers[1]), LENGTH(integers[0]), LENGTH(integers[1]))
integers[0] = strPad(integers[0], keta[0], "0", LEFT)
integers[1] = strPad(integers[1], keta[0], "0", LEFT)
keta[1] = IIF(LENGTH(decimals[0]) > LENGTH(decimals[1]), LENGTH(decimals[0]), LENGTH(decimals[1]))
decimals[0] = strPad(decimals[0], keta[1], "0", RIGHT)
decimals[1] = strPad(decimals[1], keta[1], "0", RIGHT)
DIM bin = ""
FOR i = 1 TO keta[0]
bin = bin + (VAL(COPY(integers[0], i, 1)) XOR VAL(COPY(integers[1], i, 1)))
NEXT
bin = bin + "."
FOR i = 1 TO keta[1]
bin = bin + (VAL(COPY(decimals[0], i, 1)) XOR VAL(COPY(decimals[1], i, 1)))
NEXT
RESULT = binToDec(bin)
FEND
//////////////////////////////////////////////////
// 【引数】
// color : Color値
// flg : #RRGGBB形式で返す場合Trueを指定
// 【戻り値】
// 赤成分、緑成分、青成分を格納した配列、もしくは#RRGGBB形式の文字列
//////////////////////////////////////////////////
FUNCTION colorToRGB(color, flg = FALSE)
DIM array[2]
array[0] = color AND $FF
array[1] = (color AND $FF00) / $100
array[2] = (color AND $FF0000) / $10000
IFB flg THEN
DIM rgb = ""
FOR item IN array
DIM hex = decToHex(item)
rgb = rgb + COPY(hex, LENGTH(hex)-1)
NEXT
RESULT = "#" + rgb
ELSE
RESULT = SLICE(array)
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// color : Color値
// 【戻り値】
// 補色
//////////////////////////////////////////////////
FUNCTION complementaryColor(r, g = EMPTY, b = EMPTY)
IFB COPY(r, 1, 1) = "#" AND g = EMPTY AND b = EMPTY THEN
array = colorToRGB(RGBToColor(r))
num = CALCARRAY(array, CALC_MAX) + CALCARRAY(array, CALC_MIN)
DIM rgb = ""
FOR item IN array
DIM hex = decToHex(num - item)
rgb = rgb + COPY(hex, LENGTH(hex) - 1)
NEXT
RESULT = "#" + rgb
ELSEIF VAL(r) <> ERR_VALUE AND g = EMPTY AND b = EMPTY THEN
array = colorToRGB(r)
num = CALCARRAY(array, CALC_MAX) + CALCARRAY(array, CALC_MIN)
FOR i = 0 TO UBound(array)
array[i] = num - array[i]
NEXT
RESULT = RGBToColor(array[0], array[1], array[2])
ELSEIF VAL(r) <> ERR_VALUE AND VAL(g) <> ERR_VALUE AND VAL(b) <> ERR_VALUE THEN
DIM array[2]
array[0] = r
array[1] = g
array[2] = b
num = CALCARRAY(array, CALC_MAX) + CALCARRAY(array, CALC_MIN)
FOR i = 0 TO UBound(array)
array[i] = num - array[i]
NEXT
RESULT = SLICE(array)
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 単位換算する数値
// before : 変換前の単位
// after : 変換後の単位
// 【戻り値】
// 指定した単位に変換した数値
//////////////////////////////////////////////////
FUNCTION convert(num, before, after)
HASHTBL unit
// 重量
unit["g,sg"] = "num * 6.85217658567918 * POWER(10, -5)"
unit["g,lbm"] = "num * 2.20462262184878 * POWER(10, -3)"
unit["g,u"] = "num * 6.02217 * POWER(10, +23)"
unit["g,ozm"] = "num * 3.52739619495804 * POWER(10, -2)"
unit["sg,g"] = "num * 1.45939029372064 * POWER(10, +4)"
unit["sg,lbm"] = "num * 3.21740485564304 * POWER(10, +1)"
unit["sg,u"] = "num * 8.78869644513561 * POWER(10, +27)"
unit["sg,ozm"] = "num * 5.14784776902887 * POWER(10, +2)"
unit["lbm,g"] = "num * 4.5359237 * POWER(10, +2)"
unit["lbm,sg"] = "num * 3.10809501715673 * POWER(10, -2)"
unit["lbm,u"] = "num * 2.7316103628429 * POWER(10, +26)"
unit["lbm,ozm"] = "num * 1.6 * POWER(10, +1)"
unit["u,g"] = "num * 1.66053100460465 * POWER(10, -24)"
unit["u,sg"] = "num * 1.13782516695463 * POWER(10, -28)"
unit["u,lbm"] = "num * 3.66084421703269 * POWER(10, -27)"
unit["u,ozm"] = "num * 5.8573507472523 * POWER(10, -26)"
unit["ozm,g"] = "num * 2.8349523125 * POWER(10, +1)"
unit["ozm,sg"] = "num * 1.94255938572295 * POWER(10, -3)"
unit["ozm,lbm"] = "num * 6.25 * POWER(10, -2)"
unit["ozm,u"] = "num * 1.70725647677681 * POWER(10, +25)"
// 距離
unit["m,mi"] = "num * 6.21371192237334 * POWER(10, -4)"
unit["m,Nmi"] = "num * 5.39956803455724 * POWER(10, -4)"
unit["m,in"] = "num * 3.93700787401575 * POWER(10, +1)"
unit["m,ft"] = "num * 3.28083989501312 * POWER(10, +0)"
unit["m,yd"] = "num * 1.09361329833771 * POWER(10, +0)"
unit["m,ang"] = "num * 1 * POWER(10, +10)"
unit["m,pica"] = "num * 2.36220472440945 * POWER(10, +2)"
unit["mi,m"] = "num * 1.609344 * POWER(10, +3)"
unit["mi,Nmi"] = "num * 8.68976241900648 * POWER(10, -1)"
unit["mi,in"] = "num * 6.336 * POWER(10, +4)"
unit["mi,ft"] = "num * 5.28 * POWER(10, +3)"
unit["mi,yd"] = "num * 1.76 * POWER(10, +3)"
unit["mi,ang"] = "num * 1.609344 * POWER(10, +13)"
unit["mi,pica"] = "num * 3.8016 * POWER(10, +5)"
unit["Nmi,m"] = "num * 1.852 * POWER(10, +3)"
unit["Nmi,mi"] = "num * 1.15077944802354 * POWER(10, +0)"
unit["Nmi,in"] = "num * 7.29133858267717 * POWER(10, +4)"
unit["Nmi,ft"] = "num * 6.0761154855643 * POWER(10, +3)"
unit["Nmi,yd"] = "num * 2.02537182852143 * POWER(10, +3)"
unit["Nmi,ang"] = "num * 1.852 * POWER(10, +13)"
unit["Nmi,pica"] = "num * 4.3748031496063 * POWER(10, +5)"
unit["in,m"] = "num * 2.54 * POWER(10, -2)"
unit["in,mi"] = "num * 1.57828282828283 * POWER(10, -5)"
unit["in,Nmi"] = "num * 1.37149028077754 * POWER(10, -5)"
unit["in,ft"] = "num * 8.33333333333333 * POWER(10, -2)"
unit["in,yd"] = "num * 2.77777777777778 * POWER(10, -2)"
unit["in,ang"] = "num * 2.54 * POWER(10, +8)"
unit["in,pica"] = "num * 6 * POWER(10, +0)"
unit["ft,m"] = "num * 3.048 * POWER(10, -1)"
unit["ft,mi"] = "num * 1.89393939393939 * POWER(10, -4)"
unit["ft,Nmi"] = "num * 1.64578833693305 * POWER(10, -4)"
unit["ft,in"] = "num * 1.2 * POWER(10, +1)"
unit["ft,yd"] = "num * 3.33333333333333 * POWER(10, -1)"
unit["ft,ang"] = "num * 3.048 * POWER(10, +9)"
unit["ft,pica"] = "num * 7.2 * POWER(10, +1)"
unit["yd,m"] = "num * 9.144 * POWER(10, -1)"
unit["yd,mi"] = "num * 5.68181818181818 * POWER(10, -4)"
unit["yd,Nmi"] = "num * 4.93736501079914 * POWER(10, -4)"
unit["yd,in"] = "num * 3.6 * POWER(10, +1)"
unit["yd,ft"] = "num * 3 * POWER(10, +0)"
unit["yd,ang"] = "num * 9.144 * POWER(10, +9)"
unit["yd,pica"] = "num * 2.16 * POWER(10, +2)"
unit["ang,m"] = "num * 1 * POWER(10, -10)"
unit["ang,mi"] = "num * 6.21371192237334 * POWER(10, -14)"
unit["ang,Nmi"] = "num * 5.39956803455724 * POWER(10, -14)"
unit["ang,in"] = "num * 3.93700787401575 * POWER(10, -9)"
unit["ang,ft"] = "num * 3.28083989501312 * POWER(10, -10)"
unit["ang,yd"] = "num * 1.09361329833771 * POWER(10, -10)"
unit["ang,pica"] = "num * 2.36220472440945 * POWER(10, -8)"
unit["pica,m"] = "num * 4.23333333333333 * POWER(10, -3)"
unit["pica,mi"] = "num * 2.63047138047138 * POWER(10, -6)"
unit["pica,Nmi"] = "num * 2.28581713462923 * POWER(10, -6)"
unit["pica,in"] = "num * 1.66666666666667 * POWER(10, -1)"
unit["pica,ft"] = "num * 1.38888888888889 * POWER(10, -2)"
unit["pica,yd"] = "num * 4.62962962962963 * POWER(10, -3)"
unit["pica,ang"] = "num * 4.23333333333333 * POWER(10, +7)"
// 時間
unit["yr,day"] = "num * 3.6525 * POWER(10, +2)"
unit["yr,hr"] = "num * 8.766 * POWER(10, +3)"
unit["yr,mn"] = "num * 5.2596 * POWER(10, +5)"
unit["yr,sec"] = "num * 3.15576 * POWER(10, +7)"
unit["day,yr"] = "num * 2.7378507871321 * POWER(10, -3)"
unit["day,hr"] = "num * 2.4 * POWER(10, +1)"
unit["day,mn"] = "num * 1.44 * POWER(10, +3)"
unit["day,sec"] = "num * 8.64 * POWER(10, +4)"
unit["hr,yr"] = "num * 1.14077116130504 * POWER(10, -4)"
unit["hr,day"] = "num * 4.16666666666667 * POWER(10, -2)"
unit["hr,mn"] = "num * 6 * POWER(10, +1)"
unit["hr,sec"] = "num * 3.6 * POWER(10, +3)"
unit["mn,yr"] = "num * 1.90128526884174 * POWER(10, -6)"
unit["mn,day"] = "num * 6.94444444444444 * POWER(10, -4)"
unit["mn,hr"] = "num * 1.66666666666667 * POWER(10, -2)"
unit["mn,sec"] = "num * 6 * POWER(10, +1)"
unit["sec,yr"] = "num * 3.16880878140289 * POWER(10, -8)"
unit["sec,day"] = "num * 1.15740740740741 * POWER(10, -5)"
unit["sec,hr"] = "num * 2.77777777777778 * POWER(10, -4)"
unit["sec,mn"] = "num * 1.66666666666667 * POWER(10, -2)"
// 圧力
unit["Pa,atm"] = "num * 9.86923266716013 * POWER(10, -6)"
unit["Pa,mmHg"] = "num * 7.5006168270417 * POWER(10, -3)"
unit["atm,Pa"] = "num * 1.01325 * POWER(10, +5)"
unit["atm,mmHg"] = "num * 7.6 * POWER(10, +2)"
unit["mmHg,Pa"] = "num * 1.33322368421053 * POWER(10, +2)"
unit["mmHg,atm"] = "num * 1.31578947368421 * POWER(10, -3)"
// 物理的な力
unit["N,dyn"] = "num * 1 * POWER(10, +5)"
unit["N,lbf"] = "num * 2.2480894309971 * POWER(10, -1)"
unit["dyn,N"] = "num * 1 * POWER(10, -5)"
unit["dyn,lbf"] = "num * 2.2480894309971 * POWER(10, -6)"
unit["lbf,N"] = "num * 4.4482216152605 * POWER(10, +0)"
unit["lbf,dyn"] = "num * 4.4482216152605 * POWER(10, +5)"
// エネルギー
unit["J,e"] = "num * 1 * POWER(10, +7)"
unit["J,cal"] = "num * 2.38845896627496 * POWER(10, -1)"
unit["J,eV"] = "num * 6.241457 * POWER(10, +18)"
unit["J,HPh"] = "num * 3.72506135998619 * POWER(10, -7)"
unit["J,Wh"] = "num * 2.77777777777778 * POWER(10, -4)"
unit["J,flb"] = "num * 7.37562149277265 * POWER(10, -1)"
unit["J,BTU"] = "num * 9.47817120313317 * POWER(10, -4)"
unit["J,c"] = "num * 2.39005736137667 * POWER(10, -1)"
unit["e,J"] = "num * 1 * POWER(10, -7)"
unit["e,cal"] = "num * 2.38845896627496 * POWER(10, -8)"
unit["e,eV"] = "num * 6.241457 * POWER(10, +11)"
unit["e,HPh"] = "num * 3.72506135998619 * POWER(10, -14)"
unit["e,Wh"] = "num * 2.77777777777778 * POWER(10, -11)"
unit["e,flb"] = "num * 7.37562149277265 * POWER(10, -8)"
unit["e,BTU"] = "num * 9.47817120313317 * POWER(10, -11)"
unit["e,c"] = "num * 2.39005736137667 * POWER(10, -8)"
unit["cal,J"] = "num * 4.1868 * POWER(10, +0)"
unit["cal,e"] = "num * 4.1868 * POWER(10, +7)"
unit["cal,eV"] = "num * 2.61317321676 * POWER(10, +19)"
unit["cal,HPh"] = "num * 1.55960869019902 * POWER(10, -6)"
unit["cal,Wh"] = "num * 1.163 * POWER(10, -3)"
unit["cal,flb"] = "num * 3.08802520659405 * POWER(10, +0)"
unit["cal,BTU"] = "num * 3.9683207193278 * POWER(10, -3)"
unit["cal,c"] = "num * 1.00066921606119 * POWER(10, +0)"
unit["eV,J"] = "num * 1.60219000146921 * POWER(10, -19)"
unit["eV,e"] = "num * 1.60219000146921 * POWER(10, -12)"
unit["eV,cal"] = "num * 3.82676507468522 * POWER(10, -20)"
unit["eV,HPh"] = "num * 5.96825606582916 * POWER(10, -26)"
unit["eV,Wh"] = "num * 4.45052778185891 * POWER(10, -23)"
unit["eV,flb"] = "num * 1.18171470103417 * POWER(10, -19)"
unit["eV,BTU"] = "num * 1.51858311338733 * POWER(10, -22)"
unit["eV,c"] = "num * 3.82932600733558 * POWER(10, -20)"
unit["HPh,J"] = "num * 2.68451953769617 * POWER(10, +6)"
unit["HPh,e"] = "num * 2.68451953769617 * POWER(10, +13)"
unit["HPh,cal"] = "num * 6.41186475995073 * POWER(10, +5)"
unit["HPh,eV"] = "num * 1.67553132601905 * POWER(10, +25)"
unit["HPh,Wh"] = "num * 7.4569987158227 * POWER(10, +2)"
unit["HPh,flb"] = "num * 1.98 * POWER(10, +6)"
unit["HPh,BTU"] = "num * 2.54443357764402 * POWER(10, +3)"
unit["HPh,c"] = "num * 6.41615568283024 * POWER(10, +5)"
unit["Wh,J"] = "num * 3.6 * POWER(10, +3)"
unit["Wh,e"] = "num * 3.6 * POWER(10, +10)"
unit["Wh,cal"] = "num * 8.59845227858985 * POWER(10, +2)"
unit["Wh,eV"] = "num * 2.24692452 * POWER(10, +22)"
unit["Wh,HPh"] = "num * 1.34102208959503 * POWER(10, -3)"
unit["Wh,flb"] = "num * 2.65522373739816 * POWER(10, +3)"
unit["Wh,BTU"] = "num * 3.41214163312794 * POWER(10, +0)"
unit["Wh,c"] = "num * 8.60420650095602 * POWER(10, +2)"
unit["flb,J"] = "num * 1.3558179483314 * POWER(10, +0)"
unit["flb,e"] = "num * 1.3558179483314 * POWER(10, +7)"
unit["flb,cal"] = "num * 3.23831553532865 * POWER(10, -1)"
unit["flb,eV"] = "num * 8.46227942433866 * POWER(10, +18)"
unit["flb,HPh"] = "num * 5.05050505050505 * POWER(10, -7)"
unit["flb,Wh"] = "num * 3.76616096758722 * POWER(10, -4)"
unit["flb,BTU"] = "num * 1.28506746345658 * POWER(10, -3)"
unit["flb,c"] = "num * 3.24048266809608 * POWER(10, -1)"
unit["BTU,J"] = "num * 1.05505585262 * POWER(10, +3)"
unit["BTU,e"] = "num * 1.05505585262 * POWER(10, +10)"
unit["BTU,cal"] = "num * 2.51995761111111 * POWER(10, +2)"
unit["BTU,eV"] = "num * 6.58508573672607 * POWER(10, +21)"
unit["BTU,HPh"] = "num * 3.93014778922204 * POWER(10, -4)"
unit["BTU,Wh"] = "num * 2.93071070172222 * POWER(10, -1)"
unit["BTU,flb"] = "num * 7.78169262265965 * POWER(10, +2)"
unit["BTU,c"] = "num * 2.52164400721797 * POWER(10, +2)"
unit["c,J"] = "num * 4.184 * POWER(10, +0)"
unit["c,e"] = "num * 4.184 * POWER(10, +7)"
unit["c,cal"] = "num * 9.99331231489443 * POWER(10, -1)"
unit["c,eV"] = "num * 2.6114256088 * POWER(10, +19)"
unit["c,HPh"] = "num * 1.55856567301822 * POWER(10, -6)"
unit["c,Wh"] = "num * 1.16222222222222 * POWER(10, -3)"
unit["c,flb"] = "num * 3.08596003257608 * POWER(10, +0)"
unit["c,BTU"] = "num * 3.96566683139092 * POWER(10, -3)"
// 仕事率
unit["HP,W"] = "num * 7.4569987158227 * POWER(10, +2)"
unit["W,HP"] = "num * 1.34102208959503 * POWER(10, -3)"
// 磁力
unit["T,ga"] = "num * 1 * POWER(10, +4)"
unit["ga,T"] = "num * 1 * POWER(10, -4)"
// 温度
unit["C,F"] = "num * (9/5) + 32"
unit["C,K"] = "num + 273.15"
unit["F,C"] = "(num - 32) * (9/5)"
unit["F,K"] = "(num - 32) * (5/9) + 273.15"
unit["K,C"] = "num - 23373.15"
unit["K,F"] = "(num - 273.15) * (9/5) + 32"
// 体積（容積）
unit["tsp,tbs"] = "num * 3.33333333333333 * POWER(10, -1)"
unit["tsp,oz"] = "num * 1.66666666666667 * POWER(10, -1)"
unit["tsp,cup"] = "num * 2.08333333333333 * POWER(10, -2)"
unit["tsp,us_pt"] = "num * 1.04166666666667 * POWER(10, -2)"
unit["tsp,uk_pt"] = "num * 8.67368942321863 * POWER(10, -3)"
unit["tsp,qt"] = "num * 5.20833333333333 * POWER(10, -3)"
unit["tsp,gal"] = "num * 1.30208333333333 * POWER(10, -3)"
unit["tbs,tsp"] = "num * 3 * POWER(10, +0)"
unit["tbs,oz"] = "num * 5 * POWER(10, -1)"
unit["tbs,cup"] = "num * 6.25 * POWER(10, -2)"
unit["tbs,us_pt"] = "num * 3.125 * POWER(10, -2)"
unit["tbs,uk_pt"] = "num * 2.60210682696559 * POWER(10, -2)"
unit["tbs,qt"] = "num * 1.5625 * POWER(10, -2)"
unit["tbs,gal"] = "num * 3.90625 * POWER(10, -3)"
unit["oz,tsp"] = "num * 6 * POWER(10, +0)"
unit["oz,tbs"] = "num * 2 * POWER(10, +0)"
unit["oz,cup"] = "num * 1.25 * POWER(10, -1)"
unit["oz,us_pt"] = "num * 6.25 * POWER(10, -2)"
unit["oz,uk_pt"] = "num * 5.20421365393118 * POWER(10, -2)"
unit["oz,qt"] = "num * 3.125 * POWER(10, -2)"
unit["oz,gal"] = "num * 7.8125 * POWER(10, -3)"
unit["cup,tsp"] = "num * 4.8 * POWER(10, +1)"
unit["cup,tbs"] = "num * 1.6 * POWER(10, +1)"
unit["cup,oz"] = "num * 8 * POWER(10, +0)"
unit["cup,us_pt"] = "num * 5 * POWER(10, -1)"
unit["cup,uk_pt"] = "num * 4.16337092314494 * POWER(10, -1)"
unit["cup,qt"] = "num * 2.5 * POWER(10, -1)"
unit["cup,gal"] = "num * 6.25 * POWER(10, -2)"
unit["us_pt,tsp"] = "num * 9.6 * POWER(10, +1)"
unit["us_pt,tbs"] = "num * 3.2 * POWER(10, +1)"
unit["us_pt,oz"] = "num * 1.6 * POWER(10, +1)"
unit["us_pt,cup"] = "num * 2 * POWER(10, +0)"
unit["us_pt,uk_pt"] = "num * 8.32674184628989 * POWER(10, -1)"
unit["us_pt,qt"] = "num * 5 * POWER(10, -1)"
unit["us_pt,gal"] = "num * 1.25 * POWER(10, -1)"
unit["uk_pt,tsp"] = "num * 1.15291192848466 * POWER(10, +2)"
unit["uk_pt,tbs"] = "num * 3.84303976161554 * POWER(10, +1)"
unit["uk_pt,oz"] = "num * 1.92151988080777 * POWER(10, +1)"
unit["uk_pt,cup"] = "num * 2.40189985100971 * POWER(10, +0)"
unit["uk_pt,us_pt"] = "num * 1.20094992550486 * POWER(10, +0)"
unit["uk_pt,qt"] = "num * 6.00474962752428 * POWER(10, -1)"
unit["uk_pt,gal"] = "num * 1.50118740688107 * POWER(10, -1)"
unit["qt,tsp"] = "num * 1.92 * POWER(10, +2)"
unit["qt,tbs"] = "num * 6.4 * POWER(10, +1)"
unit["qt,oz"] = "num * 3.2 * POWER(10, +1)"
unit["qt,cup"] = "num * 4 * POWER(10, +0)"
unit["qt,us_pt"] = "num * 2 * POWER(10, +0)"
unit["qt,uk_pt"] = "num * 1.66534836925798 * POWER(10, +0)"
unit["qt,gal"] = "num * 2.5 * POWER(10, -1)"
unit["gal,tsp"] = "num * 7.68 * POWER(10, +2)"
unit["gal,tbs"] = "num * 2.56 * POWER(10, +2)"
unit["gal,oz"] = "num * 1.28 * POWER(10, +2)"
unit["gal,cup"] = "num * 1.6 * POWER(10, +1)"
unit["gal,us_pt"] = "num * 8 * POWER(10, +0)"
unit["gal,uk_pt"] = "num * 6.66139347703191 * POWER(10, +0)"
unit["gal,qt"] = "num * 4 * POWER(10, +0)"
RESULT = EVAL(unit[before + "," + after])
FEND
//////////////////////////////////////////////////
// 【引数】
// folderspec : 作成するフォルダのパス
// 【戻り値】
//
//////////////////////////////////////////////////
PROCEDURE CreateFolders(folderspec)
WITH CREATEOLEOBJ("Scripting.FileSystemObject")
folderspec = .GetAbsolutePathName(folderspec)
IF !.DriveExists(.GetDriveName(folderspec)) THEN EXIT
DIM parentPath = .GetParentFolderName(folderspec)
IF !.FolderExists(parentPath) THEN CreateFolders(parentPath)
IF !.FolderExists(folderspec) THEN .CreateFolder(folderspec)
ENDWITH
FEND
//////////////////////////////////////////////////
// 【引数】
// interval : 加算する時間間隔を表す文字列式（yyyy：年、m：月、d：日、ww：週、h：時、n：分、s：秒）
// num : dateに加算する値。未来は正、過去は負で指定
// date : 時間間隔を加算する日付
// 【戻り値】
// 日時（date）に、指定した単位（interval）の時間（num）を加算して返します
//////////////////////////////////////////////////
FUNCTION dateAdd(interval, num, date)
DIM year, month, day, d
GETTIME(0, date)
DIM time = G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2
SELECT interval
CASE "yyyy"
d = (G_TIME_YY + num) + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
IF time <> "00:00:00" THEN d = d + " " + time
CASE "m"
IFB num > 0 THEN
year = G_TIME_YY + INT((G_TIME_MM + num) / 12)
month = REPLACE(FORMAT(((G_TIME_MM + num) MOD 12), 2), " ", "0")
ELSE
year = G_TIME_YY + CEIL((G_TIME_MM + num) / 12 - 1)
month = REPLACE(FORMAT(G_TIME_MM - (ABS(num) MOD 12), 2), " ", "0")
ENDIF
IF month = "00" THEN month = 12
day = G_TIME_DD2
d = "" + year + month + day
IFB !isDate(d) THEN
d = year + "/" + month + "/" + "01"
d = getEndOfMonth(d)
ELSE
d = year + "/" + month + "/" + day
ENDIF
IF time <> "00:00:00" THEN d = d + " " + time
CASE "d"
t = GETTIME(num, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "ww"
t = GETTIME(num * 7, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "h"
t = GETTIME(num / 24, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "n"
t = GETTIME(num / 1440, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "s"
t = GETTIME(num / 86400, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
// interval : 時間単位（yyyy︰年、q：四半期、m︰月、d︰日、w：週日、ww：週、h：時、n：分、s：秒）
// date1 : 日時1
// date2 : 日時2
// 【戻り値】
// date2からdate1を引いた時間間隔を求めます。
//////////////////////////////////////////////////
FUNCTION dateDiff(interval, date1, date2)
DIM y1, y2, m1, m2, d1, d2, d
SELECT interval
CASE "yyyy"
GETTIME(0, date1)
y1 = G_TIME_YY
GETTIME(0, date2)
y2 = G_TIME_YY
d = y2 - y1
CASE "q"
GETTIME(0, date1)
y1 = G_TIME_YY
m1 = G_TIME_MM
GETTIME(0, date2)
y2 = G_TIME_YY
m2 = G_TIME_MM
d = y2 * 4 + CEIL(m2/3) - (y1 * 4 + CEIL(m1/3))
CASE "m"
GETTIME(0, date1)
y1 = G_TIME_YY
m1 = G_TIME_MM
GETTIME(0, date2)
y2 = G_TIME_YY
m2 = G_TIME_MM
d = (y2 - y1) * 12 + m2 - m1
CASE "d"
d1 = GETTIME(0, date1)
d2 = GETTIME(0, date2)
d = (d2 - d1) / 86400
CASE "w"
d = INT(dateDiff("d", date1, date2) / 7)
CASE "ww"
date1 = dateAdd("d", -1 * getWeekday(date1), date1)
d = INT(dateDiff("d", date1, date2) / 7)
CASE "h"
d = dateDiff("d", date1, date2) * 24
CASE "n"
d = dateDiff("d", date1, date2) * 1440
CASE "s"
d = dateDiff("d", date1, date2) * 86400
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
//
// 【戻り値】
//
//////////////////////////////////////////////////
MODULE Decimal
CONST BASE = 1E+7
CONST LOG_BASE = 7
CONST MAX_SAFE_INTEGER = 1E+15 - 1
CONST MAX_DIGITS = 1E+9
PUBLIC precision = 20
PUBLIC rounding = 4
PUBLIC minE = -9E+15
PUBLIC maxE = 9E+15
PUBLIC quadrant = EMPTY
PUBLIC modulo = 1
DIM inexact = FALSE
PUBLIC toExpNeg = -7
PUBLIC toExpPos = 21
CONST MathLN10 = 2.302585092994046
CONST LN10 = "2.3025850929940456840179914546843642076011014886287729760333279009675726096773524802359972050895982983" + _
"4196778404228624863340952546508280675666628736909878168948290720832555468084379989482623319852839350" + _
"5308965377732628846163366222287698219886746543667474404243274365155048934314939391479619404400222105" + _
"1017141748003688084012647080685567743216228355220114804663715659121373450747856947683463616792101806" + _
"4450706480002775026849167465505868569356734206705811364292245544057589257242082413146956890167589402" + _
"5677631135691929203337658714166023010570308963457207544037084746994016826928280848118428931484852494" + _
"8644871927809676271275775397027668605952496716674183485704422507197965004714951050492214776567636938" + _
"6629769795221107182645497347726624257094293225827985025855097852653832076067263171643095059950878075" + _
"2371033310119785754733154142180842754386359177811705430982748238504564801909561029929182431823752535" + _
"7709750539565187697510374970888692180205189339507238539205144634197265287286965110862571492198849978" + _
"748873771345686209167058"
CONST isBinary = "^0b([01]+(\.[01]*)?|\.[01]+)(p[+-]?\d+)?$"
CONST isHex = "^0x([0-9a-f]+(\.[0-9a-f]*)?|\.[0-9a-f]+)(p[+-]?\d+)?$"
CONST isOctal = "^0o([0-7]+(\.[0-7]*)?|\.[0-7]+)(p[+-]?\d+)?$"
CONST isDecimal = "^(\d+(\.\d*)?|\.\d+)(e[+-]?\d+)?$"
CONST LN10PRECISION = LENGTH(LN10) - 1
CONST PI = "3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679" + _
"8214808651328230664709384460955058223172535940812848111745028410270193852110555964462294895493038196" + _
"4428810975665933446128475648233786783165271201909145648566923460348610454326648213393607260249141273" + _
"7245870066063155881748815209209628292540917153643678925903600113305305488204665213841469519415116094" + _
"3305727036575959195309218611738193261179310511854807446237996274956735188575272489122793818301194912" + _
"9833673362440656643086021394946395224737190702179860943702770539217176293176752384674818467669405132" + _
"0005681271452635608277857713427577896091736371787214684409012249534301465495853710507922796892589235" + _
"4201995611212902196086403441815981362977477130996051870721134999999837297804995105973173281609631859" + _
"5024459455346908302642522308253344685035261931188171010003137838752886587533208381420617177669147303" + _
"5982534904287554687311595628638823537875937519577818577805321712268066130019278766111959092164201989" + _
"380952572010654858632789"
CONST PI_PRECISION = LENGTH(PI) - 1
DIM external = TRUE
DIM folderspec = "cache\decimal\"
//////////////////////////////
// メイン関数
//////////////////////////////
FUNCTION absoluteValue(x, isnumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IF x[0] < 0 THEN x[0] = 1
RESULT = finalise(x)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION ceil(x, isnumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = finalise(x, x[1] + 1, 2)
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION clampedTo(x, min, max, isNumeric = FALSE)
x = Constructor(x)
min = Constructor(min)
max = Constructor(max)
IFB !min[0] OR !max[0] THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
IFB gt(min, max) THEN
RESULT = ERR_VALUE
EXIT
ENDIF
k = cmp(x, min)
RESULT = IIF(k < 0, min, IIF(cmp(x, max) > 0, max, Constructor(x)))
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION comparedTo(x, y)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
y = IIF(VARTYPE(y) < 8192, Constructor(y), y)
xd = SLICE(x, 2)
yd = SLICE(IIF(VARTYPE(y) < 8192, Constructor(y), y), 2)
xs = x[0]
ys = y[0]
DIM xIsNum = CHKNUM(x[1])
DIM yIsNum = CHKNUM(y[1])
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// Either NaN or ±Infinity?
IFB (xIsNaN OR yIsNaN) OR(xIsInf OR yIsInf) THEN
IFB xIsNaN OR yIsNaN THEN
RESULT = "NaN"
ELSEIF xs <> ys THEN
RESULT = xs
ELSEIF JOIN(xd, "") = JOIN(yd, "") THEN
RESULT = 0
ELSEIF POWER(VARTYPE(!xd[0], VAR_INTEGER), IIF(xs < 0, 1, 0)) THEN
RESULT = 1
ELSE
RESULT = -1
ENDIF
EXIT
ENDIF
// Either zero?
IFB xIsZero OR yIsZero THEN
RESULT = IIF(xd[0], xs, IIF(yd[0], -1 * ys, 0))
EXIT
ENDIF
// Signs differ?
IFB xs <> ys THEN
RESULT = xs
EXIT
ENDIF
// Compare exponents.
IFB x[1] <> y[1] THEN
RESULT = IIF(bitXor(x[1] > y[1], xs < 0), 1, -1)
EXIT
ENDIF
xdL = LENGTH(xd)
ydL = LENGTH(yd)
// Compare digit by digit.
FOR i = 0 TO IIF(xdL < ydL, xdL, ydL) - 1
IFB xd[i] <> yd[i] THEN
RESULT = IIF(xd[i] > yd[i], 1, -1)
RESULT = IIF(xs < 0, -1 * RESULT, RESULT)
EXIT
ENDIF
NEXT
// Compare lengths.
RESULT = IIF(xdL = ydL, 0, IIF(xdL > POWER(ydL, xs) < 0, 1, -1))
FEND
FUNCTION cosine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("cosine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = Constructor(x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
xd = SLICE(x, 2)
IFB !LENGTH(xd) THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
// cos(0) = cos(-0) = 1
IFB !xd[0] THEN
RESULT = Constructor(1)
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = VAL(x[1]), sd(x)
precision = pr + large(array, 1) + LOG_BASE
rounding = 1
x = cosine2(Ctor, toLessThanHalfPi2(Ctor, x))
precision = pr
rounding = rm
RESULT = finalise(IIF(quadrant = 2 OR quadrant = 3, neg(x), x), pr, rm, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION cubeRoot(x, isnumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
rep = 0
IFB !isFinite(x) OR isZero(x) THEN
RESULT = Constructor(x)
EXIT
ENDIF
external = FALSE
// Initial estimate.
s = x[0] * POWER(x[0] * toString(x), 1/3)
// Math.cbrt underflow/overflow?
// Pass x to Math.pow as integer, then adjust the exponent of the result.
IFB !s OR ABS(s) = "INF" THEN
xd = SLICE(x, 2)
n = digitsToString(xd)
e = x[1]
// Adjust n exponent so it is a multiple of 3 away from x exponent.
s = e - LENGTH(n) + 1
IF s MOD 3 THEN n = n + IIF(s = 1 OR s = -2, "0", "00")
s = POWER(n, 1 / 3)
// Rarely, e may be one less than the result exponent value.
e = GLOBAL.floor((e + 1) / 3) - (e MOD 3 = IIF(e < 0, -1, 2))
IFB s = 1 / 0 THEN
n = "5e" + e
ELSE
n = toExponential(s)
n = COPY(n, 1, POS("e", n) + 1) + e
ENDIF
r = Constructor(n)
r[0] = x[0]
ELSE
r = Constructor(s)
ENDIF
e = precision
sd = e + 3
// Halley's method.
// TODO? Compare Newton's method.
m = NULL
WHILE TRUE
t = r
td = SLICE(t, 2)
t3 = times(times(t, t), t)
t3plusx = plus(t3, x)
r = divide(times(plus(t3plusx, x), t), plus(t3plusx, t3), sd + 2, 1)
rd = SLICE(r, 2)
// TODO? Replace with for-loop and checkRoundingDigits.
n = digitsToString(rd)
IFB COPY(digitsToString(td), 1, sd) = COPY(n, 1, sd) THEN
n = COPY(n, sd - 3 + 1, 4)
// The 4th rounding digit may be in error by -1 so if the 4 rounding digits are 9999 or 4999
// , i.e. approaching a rounding boundary, continue the iteration.
IFB n = "9999" OR !rep AND n = "4999" THEN
// On the first iteration only, check to see if rounding up gives the exact result as the
// nines may infinitely repeat.
IFB !rep THEN
t = finalise(t, e + 1, 0)
IFB eq(times(times(t, t), t), x) THEN
r = t
BREAK
ENDIF
ENDIF
sd = sd + 4
rep = 1
ELSE
// If the rounding digits are null, 0{0,4} or 50{0,3}, check for an exact result.
// If not, then there are further digits and m will be truthy.
IFB !n OR COPY(n, 2) AND COPY(n, 0) = "5" THEN
// Truncate to the first rounding digit.
finalise(r, e + 1, 1)
m = !eq(times(times(r, r), r), x)
ENDIF
BREAK
ENDIF
ENDIF
WEND
external = TRUE
RESULT = finalise(r, e, rounding, m)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION decimalPlaces(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
d = SLICE(x, 2)
n = "NaN"
IFB LENGTH(d) THEN
DIM w = LENGTH(d) - 1
n = (w - GLOBAL.floor(x[1] / LOG_BASE)) * LOG_BASE
// Subtract the number of trailing zeros of the last word.
w = d[w]
IFB w THEN
WHILE w MOD 10 = 0
n = n - 1
w = w / 10
WEND
ENDIF
IF n < 0 THEN n = 0
ENDIF
RESULT = n
FEND
FUNCTION dividedBy(dividend, divisor, pr = NULL, rm = NULL, dp = NULL, _base = NULL, isnumeric = FALSE)
x = IIF(VARTYPE(dividend) < 8192, Constructor(dividend), dividend)
y = IIF(VARTYPE(divisor) < 8192, Constructor(divisor), divisor)
DIM sign = IIF(x[0]=y[0], 1, -1)
xd = SLICE(x, 2)
yd = SLICE(y, 2)
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// Either NaN, Infinity or 0?
IFB xIsNaN OR yIsNaN OR xIsInf OR yIsInf OR xIsZero OR yIsZero THEN
// Return NaN if either NaN, or both Infinity or 0.
// x,yのどちらかNaNならばNaN、両方ともInfinityか0ならNaNを返す
IFB (xIsNaN OR yIsNaN) OR (xIsInf AND yIsInf) OR (xIsZero AND yIsZero) THEN
RESULT = "NaN"
// xが0、yが±∞ならば±0を返す
ELSEIF xIsZero OR yIsInf THEN
RESULT = 0
// yが0ならば±∞を返す
ELSEIF yIsZero THEN
RESULT = IIF(isNegative(x), "-", "") + "INF"
ENDIF
RESULT = Constructor(RESULT)
EXIT
ENDIF
IFB _base <> NULL THEN
logBase = 1
e = x[1] - y[1]
ELSE
_base = BASE
logBase = LOG_BASE
value1 = x[1] / logBase
value2 = y[1] / logBase
e = GLOBAL.floor(x[1] / logBase) - GLOBAL.floor(y[1] / logBase)
ENDIF
yL = LENGTH(yd)
xL = LENGTH(xd)
DIM q = SAFEARRAY(0, 1)
q[0] = sign
q[1] = 0
DIM qd[-1]
// Result exponent may be one less than e.
// The digit array of a Decimal from toStringBinary may have trailing zeros.
IFB LENGTH(yd) > LENGTH(xd) THEN
DIM tmp[LENGTH(yd)]
SETCLEAR(tmp, 0)
FOR i = 0 TO UBound(xd)
tmp[i] = xd[i]
NEXT
ELSE
tmp = xd
ENDIF
i = 0
WHILE yd[i] = tmp[i]
i = i + 1
IF i = LENGTH(yd) THEN BREAK
WEND
IFB UBound(xd) >= i AND UBound(yd) >= i THEN
bool = IIF(VAL(yd[i]) > VAL(xd[i]), TRUE, FALSE)
ELSE
bool = FALSE
ENDIF
IF bool THEN e = e - 1
IFB pr = NULL THEN
pr = precision
sd = pr
rm = rounding
ELSEIF dp <> NULL THEN
sd = pr + (x[1] - y[1]) + 1
ELSE
sd = pr
ENDIF
IFB sd < 0 THEN
arrayPush(qd, 1)
more = TRUE
ELSE
// Convert precision in number of base 10 digits to base 1e7 digits.
sd = INT(sd / logBase + 2)
i = 0
// divisor < 1e7
IFB yL = 1 THEN
k = 0
yd = yd[0]
sd = sd + 1
// k is the carry.
WHILE (i < xL OR k) AND VARTYPE(sd, VAR_BOOLEAN)
sd = sd - 1
IF sd < 0 THEN BREAK
IFB i > UBound(xd) THEN
t = k * _base + 0
ELSE
t = k * _base + VAL(xd[i])
ENDIF
RESIZE(qd, i)
qd[i] = INT(t / yd)
k = INT(t MOD yd)
i = i + 1
WEND
arrayMerge(q, qd)
more = k OR i < xL
ELSE
// Normalise xd and yd so highest order digit of yd is >= base/2
k = INT(base / (VAL(yd[0]) + 1))
IFB k > 1 THEN
yd = multiplyInteger(yd, k, base)
xd = multiplyInteger(xd, k, base)
yL = LENGTH(yd)
xL = LENGTH(xd)
ENDIF
xi = yl
rem = SLICE(xd, 0, yL - 1)
remL = LENGTH(rem)
// Add zeros to make remainder as long as divisor.
WHILE remL < yL
RESIZE(rem, remL)
rem[remL] = 0
remL = remL + 1
WEND
yz = SLICE(yd)
arrayUnshift(yz, 0)
yd0 = yd[0]
IF yd[1] >= base / 2 THEN yd0 = VAL(yd0) + 1
WHILE TRUE
k = 0
// Compare divisor and remainder.
cmp = compare(yd, rem, yL, remL)
// If divisor < remainder.
IFB cmp < 0 THEN
// Calculate trial digit, k.
rem0 = rem[0]
IF yL <> remL THEN rem0 = rem0 * _base + INT(rem[1])
// k will be how many times the divisor goes into the current remainder.
k = INT(rem0 / yd0)
IFB k > 1 THEN
IF k >= base THEN k = base - 1
// product = divisor * trial digit.
prod = multiplyInteger(yd, k, base)
prodL = LENGTH(prod)
remL = LENGTH(rem)
// Compare product and remainder.
cmp = compare(prod, rem, prodL, remL)
// product > remainder.
IFB cmp = 1 THEN
k = k - 1
// Subtract divisor from product.
subtract(prod, IIF(yL < prodL, yz, yd), prodL, base)
ENDIF
ELSE
IFB k = 0 THEN
k = 1
cmp = k
ENDIF
prod = SLICE(yd)
ENDIF
prodL = LENGTH(prod)
IF prodL < remL THEN arrayUnshift(prod, 0)
// Subtract product from remainder.
subtract(rem, prod, remL, base)
IFB cmp = -1 THEN
remL = LENGTH(rem)
cmp = compare(yd, rem, yL, remL)
IFB cmp < 1 THEN
k = k + 1
subtract(rem, IIF(yL < remL, yz, yd), remL, base)
ENDIF
ENDIF
remL = LENGTH(rem)
ELSEIF cmp = 0 THEN
k = k + 1
rem = SAFEARRAY(-1)
rem[0] = 0
ENDIF
IF LENGTH(qd) >= i THEN RESIZE(qd, i)
IF LENGTH(q) >= i+2 THEN RESIZE(q, i+2)
qd[i] = k
q[i+2] = k
i = i + 1
IFB VARTYPE(cmp, VAR_BOOLEAN) AND VARTYPE(rem[0], VAR_BOOLEAN) THEN
IF UBound(rem) < remL THEN RESIZE(rem, remL)
IFB xi > UBound(xd) THEN
rem[remL] = 0
ELSE
rem[remL] = xd[xi]
ENDIF
remL = remL + 1
ELSE
TRY
rem[0] = xd[xi]
EXCEPT
rem[0] = NULL
ENDTRY
remL = 1
ENDIF
IFB (xi < xL OR UBound(rem) > 0) AND VARTYPE(sd, VAR_BOOLEAN) THEN
xi = xi + 1
sd = sd - 1
ELSE
BREAK
ENDIF
WEND
more = IIF(rem[0]<>NULL, TRUE, FALSE)
ENDIF
IFB !qd[0] THEN
arrayShift(qd)
RESIZE(q, 1)
arrayMerge(q, qd)
ENDIF
ENDIF
// logBase is 1 when divide is being used for base conversion.
IFB logBase = 1 THEN
q[1] = e
inexact = more
RESULT = SLICE(q)
EXIT
ELSE
// To calculate q.e, first get the number of digits of qd[0].
i = 1
k = qd[0]
WHILE k >= 10
k = k / 10
i = i + 1
WEND
q[1] = i + e * logBase - 1
q = SLICE(q)
dp = IIF(dp = NULL, FALSE, dp)
RESULT = finalise(q, IIF(dp, pr + q[1] + 1, pr), rm, more)
IFB external THEN
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
ELSE
RESULT = SLICE(RESULT)
ENDIF
EXIT
ENDIF
FEND
FUNCTION dividedToIntegerBy(x, y, isNumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
y = IIF(VARTYPE(y) < 8192, Constructor(y), y)
RESULT = finalise(divide(x, y, 0, 1, 1), precision, rounding)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION equals(x, y)
RESULT = cmp(x, y) = 0
FEND
FUNCTION floor(x, isnumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = finalise(x, x[1] + 1, 3)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION greaterThan(x, y)
RESULT = cmp(x, y) > 0
FEND
FUNCTION greaterThanOrEqualTo(x, y)
k = cmp(x, y)
RESULT = VARTYPE(k = 1 OR k = 0, VAR_BOOLEAN)
FEND
FUNCTION hyperbolicCosine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("hyperbolicCosine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
one = Constructor(1)
IFB !isFinite(x) THEN
RESULT = IIF(x[0], "INF", "NaN")
EXIT
ENDIF
IFB isZero(x) THEN
RESULT = one
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = x[1], sd(x)
precision = pr + large(array, 1) + 4
rounding = 1
xd = SLICE(x, 2)
len = LENGTH(xd)
// Argument reduction: cos(4x) = 1 - 8cos^2(x) + 8cos^4(x) + 1
// i.e. cos(x) = 1 - cos^2(x/4)(8 - 8cos^2(x/4))
// Estimate the optimum number of times to use the argument reduction.
// TODO? Estimation reused from cosine() and may not be optimal here.
IFB len < 32 THEN
k = GLOBAL.CEIL(len / 3)
n = "" + (1 / tinyPow(4, k))
ELSE
k = 16
n = "2.3283064365386962890625e-10"
ENDIF
x = taylorSeries(Ctor, 1, times(x, n), Constructor(1), TRUE)
// Reverse argument reduction
i = k
d8 = Constructor(8)
WHILE i > 0
i = i - 1
cosh2x = times(x, x, NULL)
x = times(cosh2x, d8, NULL)
x = minus(d8, x, NULL)
x = times(cosh2x, x, NULL)
x = minus(one, x, NULL)
WEND
precision = pr
rounding = rm
RESULT = finalise(x, precision, rounding, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION hyperbolicSine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("hyperbolicSine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
IFB !isFinite(x) OR isZero(x) THEN
RESULT = Constructor(x)
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = x[1], sd(x)
precision = pr + large(array, 1) + 4
rounding = 1
xd = SLICE(x, 2)
len = LENGTH(xd)
IFB len < 3 THEN
x = taylorSeries(Ctor, 2, x, x, TRUE)
ELSE
// Alternative argument reduction: sinh(3x) = sinh(x)(3 + 4sinh^2(x))
// i.e. sinh(x) = sinh(x/3)(3 + 4sinh^2(x/3))
// 3 multiplications and 1 addition
// Argument reduction: sinh(5x) = sinh(x)(5 + sinh^2(x)(20 + 16sinh^2(x)))
// i.e. sinh(x) = sinh(x/5)(5 + sinh^2(x/5)(20 + 16sinh^2(x/5)))
// 4 multiplications and 2 additions
// Estimate the optimum number of times to use the argument reduction.
k = 1.4 * GLOBAL.SQRT(len)
k = IIF(k > 16, 16, INT(k))
x = times(x, 1 / tinyPow(5, k), NULL)
x = taylorSeries(2, x, x, TRUE)
// Reverse argument reduction
d5 = Constructor(5)
d16 = Constructor(16)
d20 = Constructor(20)
WHILE k > 0
k = k - 1
sinh2x = times(x, x)
x = times(x, plus(d5, times(sinh2x, plus(times(d16, sinh2x), d20))))
WEND
ENDIF
precision = pr
rounding = rm
RESULT = finalise(x, pr, rm, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION hyperbolicTangent(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("hyperbolicTangent,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB !isFinite(x) THEN
RESULT = Constructor(x[0])
EXIT
ENDIF
IFB isZero(x) THEN
RESULT = Constructor(x)
EXIT
ENDIF
pr = precision
rm = rounding
precision = pr + 7
rounding = 1
precision = pr
rounding = rm
RESULT = finalise(divide(sinh(x), cosh(x), pr, rm))
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION inverseCosine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("hyperbolicTangent,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
k = cmp(absoluteValue(x), 1)
pr = precision
rm = rounding
IFB k <> -1 THEN
RESULT = IIF(k = 0, IIF(isNeg(x), getPi(Ctor, pr, rm), Constructor(0)), Constructor("NaN"))
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
IFB isZero(x) THEN
RESULT = times(getPi(Ctor, pr + 4, rm), 0.5, NULL)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
// TODO? Special case acos(0.5) = pi/3 and acos(-0.5) = 2*pi/3
precision = pr + 6
rounding = 1
x = asin(x)
halfPi = times(getPi(Ctor, pr + 4, rm), 0.5)
precision = pr
rounding = rm
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
RESULT = minus(halfPi, x)
FEND
FUNCTION inverseHyperbolicCosine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("inverseHyperbolicCosine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB lte(x, 1) THEN
RESULT = Constructor(IIF(eq(x, 1), 0, "NaN"))
EXIT
ENDIF
IFB !isFinite(x) THEN
RESULT = Constructor(x)
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = absoluteValue(x[1]), sd(x)
precision = pr + large(array, 1) + 4
rounding = 1
external = FALSE
x = plus(squareRoot(minus(times(x, x, NULL), "1", NULL)), x, NULL)
external = TRUE
precision = pr
rounding = rm
RESULT = naturalLogarithm(x, NULL, NULL)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION inverseHyperbolicSine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("inverseHyperbolicSine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB !isFinite(x) OR isZero(x) THEN
RESULT = Constructor(x)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = absoluteValue(x[1]), sd(x)
precision = pr + 2 * large(array, 1) + 6
rounding = 1
external = FALSE
x = plus(squareRoot(plus(times(x, x), 1)), x)
external = TRUE
precision = pr
rounding = rm
RESULT = naturalLogarithm(x, NULL, NULL)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION inverseHyperbolicTangent(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("inverseHyperbolicTangent,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB !isFinite(x) THEN
RESULT = Constructor("NaN")
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
IFB x[1] >= 0 THEN
RESULT = Constructor(IIF(eq(absoluteValue(x), 1), x[0] + "INF", IIF(isZero(x), x, "NaN")))
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
pr = precision
rm = rounding
xsd = sd(x)
DIM array[] = xsd, pr
IFB large(array, 1) < 2 * (-1 * x[1]) - 1 THEN
RESULT = finalise(Constructor(x), pr, rm, TRUE)
EXIT
ENDIF
wpr = xsd - x[1]
precision = wpr
x = divide(plus(x, 1, NULL), minus(Constructor(1), x, NULL), wpr + pr, 1)
precision = pr + 4
rounding = 1
x = naturalLogarithm(Constructor(x))
precision = pr
rounding = rm
RESULT = times(x, 0.5, NULL)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION inverseSine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("inverseSine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
IFB isZero(x) THEN
RESULT = Constructor(x)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
k = cmp(THIS.abs(x), 1)
pr = precision
rm = rounding
IFB k <> -1 THEN
// |x| is 1
IFB k = 0 THEN
halfPi = times(getPi(Ctor, pr + 4, rm), 0.5)
halfPi[0] = x[0]
RESULT = halfPi
ELSE
// |x| > 1 or x is NaN
RESULT = Constructor("NaN")
EXIT
ENDIF
ENDIF
// TODO? Special case asin(1/2) = pi/6 and asin(-1/2) = -pi/6
precision = pr + 6
rounding = 1
tmp = squareRoot(minus(Constructor(1), times(x, x, NULL), NULL), NULL)
tmp = plus(tmp, 1, NULL)
x = div(x, tmp, NULL, NULL, NULL, NULL, NULL)
x = atan(x)
precision = pr
rounding = rm
RESULT = times(x, 2, NULL)
IF isNumeric = NULL THEN EXIT
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION inverseTangent(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("inverseTangent,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
pr = precision
rm = rounding
IFB !isFinite(x) THEN
IFB !x[0] THEN
RESULT = Constructor("NaN")
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
IFB pr + 4 <= PI_PRECISION THEN
r = times(getPi(Ctor, pr + 4, rm), 0.5)
r[0] = x[0]
RESULT = r
EXIT
ENDIF
ELSEIF isZero(x) THEN
RESULT = Constructor(x)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ELSEIF eq(absoluteValue(x), 1) AND pr + 4 <= PI_PRECISION THEN
r = times(getPi(Ctor, pr + 4, rm), 0.25)
RESULT = r
ENDIF
wpr = pr + 10
precision = wpr
rounding = 1
// TODO? if (x >= 1 && pr <= PI_PRECISION) atan(x) = halfPi * x.s - atan(1 / x);
// Argument reduction
// Ensure |x| < 0.42
// atan(x) = 2 * atan(x / (1 + sqrt(1 + x^2)))
DIM array[] = 28, INT(wpr / LOG_BASE + 2)
k = small(array, 1)
i = k
WHILE i > 0
i = i - 1
tmp = times(x, x, NULL)
tmp = plus(tmp, 1, NULL)
tmp = squareRoot(tmp, NULL)
tmp = plus(tmp, 1, NULL)
x = div(x, tmp, NULL, NULL, NULL, NULL, NULL)
WEND
external = FALSE
j = CEIL(wpr / LOG_BASE)
n = 1
x2 = times(x, x, NULL)
r = Constructor(x)
px = x
// atan(x) = x - x^3/3 + x^5/5 - x^7/7 + ...
WHILE i <> -1
px = times(px, x2)
n = n + 2
tmp = div(px, n, NULL, NULL, NULL, NULL, NULL)
t = minus(r, div(px, n, NULL, NULL, NULL, NULL, NULL), NULL)
td = SLICE(t, 2)
px = times(px, x2, NULL)
n = n + 2
r = plus(t, div(px, n, NULL, NULL, NULL, NULL, NULL), NULL)
rd = SLICE(r, 2)
IFB UBound(rd) >= j THEN
i = j
WHILE i >= 0 AND rd[i] = td[i]
i = i - 1
IF i = -1 THEN BREAK
WEND
ENDIF
WEND
IF k <> 0 THEN r = times(r, POWER(2, k))
external = TRUE
precision = pr
rounding = rm
RESULT = finalise(r, precision, rounding, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION isFinite(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = IIF(x[1] <> NULL, TRUE, FALSE)
FEND
FUNCTION isInteger(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = VARTYPE(LENGTH(x) >= 3 AND GLOBAL.floor(x[1] / LOG_BASE) > LENGTH(x) - 2 - 2, VAR_BOOLEAN)
FEND
FUNCTION isNaN(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = IIF(x[0] = NULL, TRUE, FALSE)
FEND
FUNCTION isNegative(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = IIF(x[0] < 0, TRUE, FALSE)
FEND
FUNCTION isPositive(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = IIF(x[0] > 0, TRUE, FALSE)
FEND
FUNCTION isZero(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = VARTYPE(VARTYPE(x[2]) = 5 AND x[2] = 0, VAR_BOOLEAN)
FEND
FUNCTION lessThan(x, y)
RESULT = cmp(x, y) < 0
FEND
FUNCTION lessThanOrEqualTo(x, y)
RESULT = cmp(x, y) < 1
FEND
FUNCTION logarithm(x, base = NULL, isNumeric = FALSE)
arg = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
pr = precision
rm = rounding
guard = 5
// Default base is 10.
IFB base = NULL THEN
base = Constructor(10)
isBase10 = TRUE
ELSE
base = Constructor(base)
d = SLICE(base, 2)
// Return NaN if base is negative, or non-finite, or is 0 or 1.
IFB VAL(base[0]) < 0 OR LENGTH(d) >= 2 OR eq(base, 1) THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
isBase10 = eq(base, 10)
ENDIF
d = SLICE(arg, 2)
// The result will have a non-terminating decimal expansion if base is 10 and arg is not an
// integer power of 10.
inf = FALSE
IFB isBase10 THEN
IFB LENGTH(d) > 1 THEN
inf = TRUE
ELSE
k = d[0]
WHILE k MOD 10 = 0
k = k / 10
WEND
inf = k <> 1
ENDIF
ENDIF
external = FALSE
sd = pr + guard
num = naturalLogarithm(arg, sd)
IFB isBase10 THEN
denominator = getLn10(Ctor, sd + 10)
ELSE
denominator = naturalLogarithm(base, sd)
ENDIF
// The result will have 5 rounding digits.
r = divide(num, denominator, sd, 1)
rd = SLICE(r, 2)
// If at a rounding boundary, i.e. the result's rounding digits are [49]9999 or [50]0000,
// calculate 10 further digits.
//
// If the result is known to have an infinite decimal expansion, repeat this until it is clear
// that the result is above or below the boundary. Otherwise, if after calculating the 10
// further digits, the last 14 are nines, round up and assume the result is exact.
// Also assume the result is exact if the last 14 are zero.
//
// Example of a result that will be incorrectly rounded:
// log[1048576](4503599627370502) = 2.60000000000000009610279511444746...
// The above result correctly rounded using ROUND_CEIL to 1 decimal place should be 2.7, but it
// will be given as 2.6 as there are 15 zeros immediately after the requested decimal place, so
// the exact result would be assumed to be 2.6, which rounded using ROUND_CEIL to 1 decimal
// place is still 2.6.
k = pr
IFB checkRoundingDigits(rd, pr, rm) THEN
REPEAT
sd = sd + 10
num = naturalLogarithm(arg, sd)
denominator = IIF(isBase10, getLn10(Ctor, sd + 10), naturalLogarithm(base, sd))
r = divide(num, denominator, sd, 1)
rd = SLICE(r, 2)
IFB !inf THEN
// Check for 14 nines from the 2nd rounding digit, as the first may be 4.
IFB VAL(COPY(digitsToString(rd), k + 2, 14)) + 1 = 1E+14 THEN
r = finalise(r, pr + 1, 0)
ENDIF
BREAK
ENDIF
k = k + 10
UNTIL !(checkRoundingDigits(rd, k, rm))
ENDIF
external = TRUE
RESULT = finalise(r, pr, rm)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION minus(minuend, subtrahend, isnumeric = FALSE)
x = IIF(VARTYPE(minuend) < 8192, Constructor(minuend), minuend)
y = IIF(VARTYPE(subtrahend) < 8192, Constructor(subtrahend), subtrahend)
DIM xIsNum = CHKNUM(x[1])
DIM yIsNum = CHKNUM(y[1])
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// If either is not finite...
IFB !xIsNum OR !yIsNum THEN
// Return NaN if either is NaN
// どちらかがNaNならばNaNを返す
IFB xIsNaN OR yIsNaN THEN
RESULT = "NaN"
// Return y negated if x is finite and y is ±Infinity.
// xが有限値でyが無限値ならばyを否定して返す
ELSEIF !xIsInf AND yIsInf THEN
y[0] = -1 * y[0]
RESULT = finiteToString(y)
// Return x if y is finite and x is ±Infinity.
// yが有限値でxが無限値ならばxを返す
ELSEIF yIsNum AND xIsInf THEN
RESULT = finiteToString(x)
// Return x if both are ±Infinity with different signs.
// 両方とも±∞で符号が違うならばxを返す
ELSEIF x[0] <> y[0] AND xIsInf AND yIsInf THEN
RESULT = finiteToString(x)
// Return NaN if both are ±Infinity with the same sign.
// 両方とも±∞で符号が同じならばNaNを返す
ELSEIF x[0] = y[0] AND xIsInf AND yIsInf THEN
RESULT = "NaN"
ENDIF
EXIT
ENDIF
// If signs differ...
IFB x[0] <> y[0] THEN
y[0] = -1 * y[0]
// x = finalise(x, pr, rm)
// y = finalise(y, pr, rm)
RESULT = Decimal.plus(x, y, isnumeric)
EXIT
ENDIF
xd = SLICE(x, 2)
yd = SLICE(y, 2)
pr = precision
rm = rounding
// If either is zero...
IFB !xd[0] OR !yd[0] THEN
// Return y negated if x is zero and y is non-zero.
IFB yd[0] THEN
y[0] = -1 * y[0]
// Return x if y is zero and x is non-zero.
ELSEIF xd[0] THEN
y = x
// Return zero if both are zero.
// From IEEE 754 (2008) 6.3: 0 - 0 = -0 - -0 = -0 when rounding to -Infinity.
ELSE
RESULT = 0
EXIT
ENDIF
RESULT = IIF(external, finalise(y, pr, rm), y)
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
// Calculate base 1e7 exponents.
e = GLOBAL.floor(y[1] / LOG_BASE)
xe = GLOBAL.floor(x[1] / LOG_BASE)
k = xe - e
// If base 1e7 exponents differ...
IFB k <> 0 THEN
xLTy = k < 0
IFB xLTy THEN
d = SLICE(xd)
k = -1 * k
len = LENGTH(yd)
ELSE
d = SLICE(yd)
e = xe
len = LENGTH(xd)
ENDIF
DIM tmp[] = CEIL(pr / LOG_BASE), len
i = CALCARRAY(tmp, CALC_MAX) + 2
IFB k > i THEN
k = i
RESIZE(d, 1)
ENDIF
// Prepend zeros to equalise exponents.
arrayReverse(d)
i = k - 1
WHILE i >= 0
arrayPush(d, 0)
i = i - 1
WEND
arrayReverse(d)
// copy
IFB xLTy THEN
xd = SLICE(d)
ELSE
yd = SLICE(d)
ENDIF
ELSE
// Check digits to determine which is the bigger number.
i = LENGTH(x) - 2
len = LENGTH(y) - 2
xLTy = i < len
IF xLTy <> 0 THEN len = i
FOR i = 0 TO len - 1
IFB VAL(xd[i]) <> VAL(yd[i]) THEN
xLTy = VAL(xd[i]) < VAL(yd[i])
BREAK
ENDIF
NEXT
k = 0
ENDIF
IFB xLTy <> 0 THEN
d = SLICE(xd)
xd = SLICE(yd)
yd = SLICE(d)
y[0] = -1 * y[0]
ENDIF
len = LENGTH(xd)
// Append zeros to `xd` if shorter.
// Don't add zeros to `yd` if shorter as subtraction only needs to start at `yd` length.
i = LENGTH(yd) - len
WHILE i > 0
arrayPush(xd, 0)
len = len + 1
i = i - 1
WEND
// Subtract yd from xd.
i = LENGTH(yd)
WHILE i > k
i = i - 1
IFB VAL(xd[i]) < VAL(yd[i]) THEN
j = i
j = j - 1
WHILE VARTYPE(j+1, VAR_BOOLEAN) AND VARTYPE(xd[j] = 0, VAR_BOOLEAN)
xd[j] = BASE - 1
j = j - 1
WEND
xd[j] = VAL(xd[j] )- 1
xd[i] = VAL(xd[i]) + BASE
ENDIF
xd[i] = VAL(xd[i]) - VAL(yd[i])
WEND
// Remove trailing zeros.
len = LENGTH(xd)
WHILE len > 0
IFB xd[len - 1] = 0 THEN
arrayPop(xd)
len = LENGTH(xd)
ELSE
BREAK
ENDIF
WEND
// Remove leading zeros and adjust exponent accordingly.
IFB LENGTH(xd) <> 0 THEN
WHILE xd[0] = 0
arrayShift(xd)
e = e - 1
WEND
ENDIF
// Zero?
IFB LENGTH(xd) = 0 THEN
RESULT = Constructor(IIF(rm=3, -0, 0))
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
RESIZE(y, 1)
arrayMerge(y, xd)
y[1] = getBase10Exponent(xd, e)
IFB external THEN
RESULT = finalise(y, pr, rm)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
ELSE
RESULT = SLICE(y)
ENDIF
FEND
FUNCTION modulo(x, y)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
y = IIF(VARTYPE(y) < 8192, Constructor(y), y)
DIM xIsNum = CHKNUM(x[1])
DIM yIsNum = CHKNUM(y[1])
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// Return NaN if x is ±Infinity or NaN, or y is NaN or ±0.
IFB (xIsInf OR xIsNaN) OR (yIsNaN OR yIsZero) THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
// Prevent rounding of intermediate calculations.
external = FALSE
IFB modulo = 9 THEN
// Euclidian division: q = sign(y) * floor(x / abs(y))
// result = x - q * y where 0 <= result < abs(y)
q = divide(x, absoluteValue(y), 0, 3, 1)
q[0] = q[0] * y[0]
ELSE
q = divide(x, y, 0, modulo, 1)
ENDIF
q = times(q, y)
external = TRUE
RESULT = minus(x, q)
FEND
FUNCTION negated(x, isNumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
x[0] = -1 * x[0]
RESULT = finalise(x)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION plus(augend, addend, isnumeric = FALSE)
x = IIF(VARTYPE(augend) < 8192, Constructor(augend), augend)
y = IIF(VARTYPE(addend) < 8192, Constructor(addend), addend)
DIM xIsNum = CHKNUM(x[1])
DIM yIsNum = CHKNUM(y[1])
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// If either is not finite...
IFB !xIsNum OR !yIsNum THEN
// Return NaN if either is NaN.
// どちらかがNaNならばNaNを返す
IFB xIsNaN OR yIsNaN THEN
RESULT = "NaN"
// Return x if y is finite and x is ±Infinity.
// yが有限でxが±∞ならばxを返す
ELSEIF yIsNum AND xIsInf THEN
RESULT = finiteToString(x)//IIF(isNegative(x), "-", "") + "INF"
// Return x if both are ±Infinity with the same sign.
// 両方とも±∞で符号が同じならばxを返す
ELSEIF x[0] = y[0] AND xIsInf AND yIsInf THEN
RESULT = finiteToString(x)//IIF(isNegative(x), "-", "") + "INF"
// Return NaN if both are ±Infinity with different signs.
// 両方とも±∞で符号が違うならばNaNを返す
ELSEIF x[0] <> y[0] AND xIsInf AND yIsInf THEN
RESULT = "NaN"
// Return y if x is finite and y is ±Infinity.
// xが有限でyが±∞ならばyを返す
ELSEIF xIsNum AND yIsInf THEN
RESULT = "INF"//finiteToString(y)//IIF(isNegative(y), "-", "") + "INF"//toString(finalise(y, pr, rm))
ENDIF
RESULT = Constructor(RESULT)
EXIT
ENDIF
// If signs differ...
IFB x[0] <> y[0] THEN
y[0] = -1 * y[0]
RESULT = Decimal.minus(x, y, isnumeric)
EXIT
ENDIF
xd = SLICE(x, 2)
yd = SLICE(y, 2)
pr = precision
rm = rounding
// If either is zero...
IFB !xd[0] OR !yd[0] THEN
IF !yd[0] THEN y = x
RESULT = IIF(external, finalise(y, pr, rm), y)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
// Calculate base 1e7 exponents.
// value = x[1]/LOG_BASE
// k = INT(value) + IIF(value<0 AND value <> INT(value), -1, 0)
// value = y[1]/LOG_BASE
// e = INT(value) + IIF(value<0 AND value- INT(value) <> 0, -1, 0)
k = GLOBAL.floor(x[1] / LOG_BASE)
e = GLOBAL.floor(y[1] / LOG_BASE)
i = k - e
// If base 1e7 exponents differ
IFB i <> 0 THEN
IFB i < 0 THEN
DIM d = SLICE(xd)
i = -1 * i
len = LENGTH(yd)
flg = TRUE
ELSE
d = SLICE(yd)
e = k
len = LENGTH(xd)
flg = FALSE
ENDIF
// Limit number of zeros prepended to max(ceil(pr / LOG_BASE), len) + 1.
k = CEIL(pr/LOG_BASE)
len = IIF(k > len, k + 1, len + 1)
// i = LENGTH(yd)
//TEXTBLOCK
IFB i > len THEN
i = len
RESIZE(d, 1)
ENDIF
//ENDTEXTBLOCK
// Prepend zeros to equalise exponents. Note: Faster to use reverse then do unshifts.
arrayReverse(d)
WHILE i > 0
arrayPush(d, 0)
i = i - 1
WEND
arrayReverse(d)
// copy
IFB flg THEN
xd = SLICE(d)
ELSE
yd = SLICE(d)
ENDIF
ENDIF
len = LENGTH(xd)
i = LENGTH(yd)
// If yd is longer than xd, swap xd and yd so xd points to the longer array.
IFB len - i < 0 THEN
i = len
d = SLICE(yd)
yd = SLICE(xd)
xd = SLICE(d)
ENDIF
// Only start adding at yd.length - 1 as the further digits of xd can be left as they are.
DIM carry = 0
WHILE i > 0
i = i - 1
xd[i] = VAL(xd[i]) + VAL(yd[i]) + carry
carry = INT(xd[i] / BASE)
xd[i] = xd[i] MOD BASE
WEND
IFB carry THEN
// xd.unshift(carry)
arrayUnshift(xd, carry)
e = e + 1
ENDIF
// Remove trailing zeros.
// No need to check for zero, as +x + +y != 0 && -x + -y != 0 RESULT = ERR_VALUE
len = LENGTH(xd)
WHILE len > 0
IFB xd[len - 1] = 0 THEN
arrayPop(xd)
len = LENGTH(xd)
ELSE
BREAK
ENDIF
WEND
RESIZE(y, 1)
arrayMerge(y, xd)
y[1] = getBase10Exponent(xd, e)
IFB external THEN
RESULT = finalise(y, pr, rm)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
ELSE
RESULT = SLICE(y)
ENDIF
FEND
FUNCTION precision(x, z = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
xd = SLICE(x, 2)
IFB LENGTH(xd) THEN
k = getPrecision(xd)
IFB z <> NULL THEN
IF z AND x[1] + 1 > k THEN k = x[1] + 1
ENDIF
ELSE
k = "NaN"
ENDIF
RESULT = k
FEND
FUNCTION round(x, isNumeric = FALSE)
x = Constructor(x)
RESULT = finalise(x, x[1] + 1, rounding)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION sine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("sine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
IFB !isFinite(x) THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
IFB isZero(x) THEN
RESULT = Constructor(x)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = x[1], sd(x)
precision = pr + CALCARRAY(array, CALC_MAX) + LOG_BASE
rounding = 1
x = sine2(Ctor, toLessThanHalfPi(Ctor, x))
precision = pr
rounding = rm
RESULT = finalise(IIF(quadrant > 2, neg(x), x), pr, rm, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION squareRoot(x, isNumeric = FALSE)
x = Constructor(x)
d = SLICE(x, 2)
e = x[1]
s = x[0]
DIM xIsNum = CHKNUM(x[1])
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
// Negative/NaN/Infinity/zero?
IFB s <> 1 OR xIsNaN OR xIsInf OR xIsZero THEN
RESULT = Constructor(IIF(!s OR s < 0 AND (!d OR d[0]), "NaN", IIF(d, x, 1 / 0)))
ENDIF
external = FALSE
// Initial estimate.
n = finiteToString(x)
// s = GLOBAL.SQRT(n)
DIM SC = CREATEOLEOBJ("ScriptControl")
SC.Language = "JScript"
s = SC.Eval("Math.sqrt(" + n + ").toPrecision(16)")
//s = 4.898979485566356//GLOBAL.SQRT(VAL(JOIN(d, "")))
// Math.sqrt underflow/overflow?
// Pass x to Math.sqrt as integer, then adjust the exponent of the result.
IFB s = 0 OR s = 1 / 0 THEN
n = digitsToString(d)
IF (LENGTH(n) + e) MOD 2 = 0 THEN n = n + "0"
s = GLOBAL.SQRT(n)
e = floor((e + 1) / 2) - (e < 0 OR e MOD 2)
IFB s = 1 / 0 THEN
n = "5E" + e
ELSE
n = toExponential(s)
n = SLICE(n, 1, POS("e", n) + 1) + e
ENDIF
r = Constructor(n)
ELSE
r = Constructor("" + s)
ENDIF
e = precision
sd = e + 3
// Newton-Raphson iteration.
rep = FALSE
WHILE TRUE
t = r
td = SLICE(t, 2)
// tmp = divide(x, t, sd + 2, 1)
// tmp = plus(t, tmp)
// r = times(tmp, 0.5)
r = times(plus(t, divide(x, t, sd + 2, 1)), 0.5)
rd = SLICE(r, 2)
// TODO? Replace with for-loop and checkRoundingDigits.
n = digitsToString(rd)
m = COPY(digitsToString(td), 1, sd)
IFB m = COPY(n, 1, sd) THEN
n = COPY(n, sd - 3 + 1, 4)
// The 4th rounding digit may be in error by -1 so if the 4 rounding digits are 9999 or
// 4999, i.e. approaching a rounding boundary, continue the iteration.
IFB n = "9999" OR !rep AND n = "4999" THEN
// On the first iteration only, check to see if rounding up gives the exact result as the
// nines may infinitely repeat.
IFB !rep THEN
finalise(t, e + 1, 0)
IFB eq(times(t, t), x) THEN
r = t
BREAK
ENDIF
ENDIF
sd = sd + 4
rep = 1
ELSE
// If the rounding digits are null, 0{0,4} or 50{0,3}, check for an exact result.
// If not, then there are further digits and m will be truthy.
IFB n <> 0 OR COPY(n, 2) <> "0" AND COPY(n, 1, 1) = "5" THEN
// Truncate to the first rounding digit.
finalise(r, e + 1, 1)
m = !eq(times(r, r), x)
ENDIF
BREAK
ENDIF
ENDIF
WEND
external = TRUE
RESULT = finalise(r, e, rounding, m)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION tangent(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("tangent,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = Constructor(x)
IFB !isFinite(x) THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
IFB isZero(x) THEN
RESULT = Constructor(x)
EXIT
ENDIF
pr = precision
rm = rounding
precision = pr + 10
rounding = 1
x = sine(x, NULL)
x[0] = 1
tmp = times(x, x, NULL)
tmp = minus(1, tmp, NULL)
tmp = THIS.sqrt(tmp, NULL)
x = divide(x, tmp)
// x = divide(x, squareRoot(minus(Constructor(1), times(x, x))), pr + 10, 0)
precision = pr
rounding = rm
RESULT = finalise(IIF(quadrant = 2 OR quadrant = 4, neg(x), x), pr, rm, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION times(multiplicand, multiplier, isnumeric = FALSE)
x = IIF(VARTYPE(multiplicand) < 8192, Constructor(multiplicand), multiplicand)
y = IIF(VARTYPE(multiplier) < 8192, Constructor(multiplier), multiplier)
xd = SLICE(x, 2)
yd = SLICE(y, 2)
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
IFB xIsNaN OR yIsNan THEN
y[0] = "NaN"
ELSE
y[0] = y[0] * x[0]
ENDIF
// If either is NaN, ±Infinity or ±0...
IFB (xIsNaN OR yIsNaN) OR (xIsInf OR yIsInf) OR (xIsZero OR yIsZero) THEN
// Return NaN if either is NaN.
// どちらかがNaNならばNaNを返す
IFB xIsNaN OR yIsNaN THEN
RESULT = "NaN"
// Return NaN if x is ±0 and y is ±Infinity, or y is ±0 and x is ±Infinity.
// xが±0、yが±無限大、もしくはyが±0、xが±無限大ならばNaNを返す
ELSEIF (xIsZero AND yIsInf) OR (yIsZero AND xIsInf) THEN
RESULT = "NaN"
// Return ±Infinity if either is ±Infinity.
// どちらかが±無限大ならば±無限大を返す
ELSEIF xIsInf OR yIsInf THEN
RESULT = "INF"
// Return ±0 if either is ±0.
// どちらかが±0ならば±0を返す
ELSEIF xIsZero OR yIsZero THEN
RESULT = "0"
ENDIF
RESULT = Constructor(RESULT)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
e = GLOBAL.floor(x[1] / LOG_BASE) + GLOBAL.floor(y[1] / LOG_BASE)
xdL = LENGTH(xd)
ydL = LENGTH(yd)
// Ensure xd points to the longer array.
IFB xdL < ydL THEN
r = SLICE(xd)
xd = SLICE(yd)
yd = SLICE(r)
rL = xdL
xdL = ydL
ydL = rL
ENDIF
// Initialise the result array with zeros.
DIM r[-1]
rL = xdL + ydL
i = rL
WHILE i > 0
arrayPush(r, 0)
i = i - 1
WEND
// Multiply!
i = ydL
WHILE i > 0
i = i - 1
carry = 0
k = xdL + i
WHILE k > i
t = VAL(r[k]) + VAL(yd[i]) * VAL(xd[k-i-1]) + carry
r[k] = t MOD BASE
k = k - 1
carry = INT(t / BASE)
WEND
r[k] = (r[k] + carry) MOD BASE
WEND
// Remove trailing zeros.
rL = rL - 1
WHILE r[rL] = 0
arrayPop(r)
rL = rL - 1
WEND
IFB carry <> 0 THEN
e = e + 1
ELSE
arrayShift(r)
ENDIF
RESIZE(y, 1)
arrayMerge(y, r)
y[1] = getBase10Exponent(r, e)
IFB external THEN
RESULT = finalise(y, precision, rounding)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
ELSE
RESULT = SLICE(y)
ENDIF
FEND
FUNCTION toBinary(x, sd = NULL, rm = NULL)
RESULT = toStringBinary(x, 2, sd, rm)
FEND
FUNCTION toDecimalPlaces(x, dp = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB dp = NULL THEN
RESULT = SLICE(x)
RESULT = toString(RESULT)
EXIT
ENDIF
checkInt32(dp, 0, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
RESULT = finiteToString(finalise(x, dp + x[1] + 1, rm))
FEND
FUNCTION toExponential(x, dp = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB dp = NULL THEN
str = finiteToString(x, TRUE)
ELSE
checkInt32(dp, 0, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
x = finalise(Constructor(x), dp + 1, rm)
str = finiteToString(x, TRUE, dp + 1)
ENDIF
RESULT = IIF(isNeg(x) AND !isZero(x), "-" + str, str)
FEND
FUNCTION toFixed(x, dp = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB dp = NULL THEN
str = finiteToString(x)
ELSE
checkInt32(dp, 0, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
y = finalise(Constructor(x), dp + x[1] + 1, rm)
str = finiteToString(y, FALSE, dp + y[1] + 1)
ENDIF
// To determine whether to add the minus sign look at the value before it was rounded,
// i.e. look at `x` rather than `y`.
RESULT = IIF(isNeg(x) AND !isZero(x), "-" + str, str)
FEND
FUNCTION toFraction(x, maxD = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
xd = SLICE(x, 2)
IFB LENGTH(xd) = 0 THEN
RESULT = Constructor(x)
ENDIF
d0 = Constructor(1)
n1 = d0
n0 = Constructor(0)
d1 = n0
d = Constructor(d1)
d[1] = getPrecision(xd) - x[1] - 1
e = d[1]
k = e MOD LOG_BASE
d[2] = POW(10, IIF(k < 0, LOG_BASE + k, k))
IFB maxD = NULL THEN
// d is 10**e, the minimum max-denominator needed.
maxD = IIF(e > 0, d, n1)
ELSE
n = Constructor(maxD)
IFB !isInt(n) <> 0 OR lt(n, n1) THEN
RESULT = ERR_VALUE
EXIT
ENDIF
maxD = IIF(gt(n, d), IIF(e > 0, d, n1), n)
ENDIF
external = FALSE
n = Constructor(digitsToString(xd))
pr = precision
e = LENGTH(xd) * LOG_BASE * 2
precision = e
WHILE TRUE
q = divide(n, d, 0, 1, 1)
d2 = plus(d0, times(q, d1), NULL)
IF cmp(d2, maxD) = 1 THEN BREAK
d0 = d1
d1 = d2
d2 = n1
n1 = plus(n0, times(q, d2), NULL)
n0 = d2
d2 = d
d = minus(n, times(q, d2))
n = d2
WEND
d2 = divide(minus(maxD, d0), d1, 0, 1, 1)
n0 = plus(n0, times(d2, n1), NULL)
d0 = plus(d0, times(d2, d1), NULL)
n1[0] = x[0]
n0[0] = n1[0]
// Determine which fraction is closer to x, n0/d0 or n1/d1?
tmp1 = divide(n1, d1, e, 1)
tmp1 = minus(tmp1, x)
tmp1 = THIS.abs(tmp1)
tmp2 = divide(n0, d0, e, 1)
tmp2 = minus(tmp2, x)
tmp2 = THIS.abs(tmp2)
DIM r[-1]
IFB cmp(tmp1, tmp2) < 1 THEN
arrayPush(r, finiteToString(n1))
arrayPush(r, finiteToString(d1))
ELSE
arrayPush(r, finiteToString(n0))
arrayPush(r, finiteToString(d0))
ENDIF
precision = pr
external = TRUE
RESULT = SLICE(r)
FEND
FUNCTION toHexadecimal(x, sd = NULL, rm = NULL)
RESULT = toStringBinary(x, 16, sd, rm)
FEND
FUNCTION toNearest(x, y = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
xd = SLICE(x, 2)
IFB y = NULL THEN
// If x is not finite, return x.
IFB !LENGTH(xd) THEN
RESULT = SLICE(x)
EXIT
ENDIF
y = Constructor(1)
rm = rounding
ELSE
y = Constructor(y)
yd = SLICE(y, 2)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
// If x is not finite, return x if y is not NaN, else NaN.
IFB !LENGTH(xd) THEN
RESULT = IIF(y[0], x, y)
ENDIF
// If y is not finite, return Infinity with the sign of x if y is Infinity, else NaN.
IFB !LENGTH(yd) THEN
IF y[0] THEN y[0] = x[0]
RESULT = SLICE(y)
ENDIF
// If y is not zero, calculate the nearest multiple of y to x.
IFB yd[0] THEN
external = FALSE
x = times(divide(x, y, 0, rm, 1), y)
external = TRUE
finalise(x)
ELSE
// If y is zero, return zero with the sign of x.
y[0] = x[0]
x = y
ENDIF
ENDIF
RESULT = SLICE(x)
RESULT = .toNumber(RESULT)
FEND
FUNCTION toNumber(x)
str = finiteToString(x)
RESULT = VAL(IIF(isNegative(x), "-" + str, str))
FEND
FUNCTION toOctal(x, sd = NULL, rm = NULL)
RESULT = toStringBinary(x, 8, sd, rm)
FEND
FUNCTION toPower(base, exponent, isnumeric = FALSE)
DIM x = Constructor(base)
DIM y = Constructor(exponent)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
DIM yn = VAL(exponent)
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// Either ±Infinity, NaN or ±0?
// どちらかが±Infinity、NaNもしくは±0
IFB (xIsInf OR yIsInf) OR (xIsNaN OR yIsNaN) OR (xIsZero OR yIsZero) THEN
RESULT = POWER(base, exponent)
EXIT
ENDIF
IFB base = "1" THEN
RESULT = x
EXIT
ENDIF
pr = precision
rm = rounding
IFB exponent = "1" THEN
RESULT = finalise(x, pr, rm)
EXIT
ENDIF
// y exponent
e = GLOBAL.floor(y[1]/LOG_BASE)
// If y is a small integer use the 'exponentiation by squaring' algorithm.
DIM k = IIF(yn < 0, -1 * yn, yn)
IFB e >= LENGTH(y) - 2 - 1 AND k <= MAX_SAFE_INTEGER THEN
DIM r = intPow(Ctor, x, k, pr)
RESULT = IIF(VAL(y[0]) < 0, dividedBy("1", r), toString(finalise(r, pr, rm)))
EXIT
ENDIF
DIM s = x[0]
// if x is negative
IFB s < 0 THEN
// if y is not an integer
IFB e < LENGTH(y) - 2 - 1 THEN
RESULT = "NaN"
EXIT
ENDIF
// Result is positive if x is negative and the last digit of integer y is even.
IF (y[e+2] AND 1) = 0 THEN s = 1
// if x.eq(-1)
IFB x[1] = 0 AND x[2] = 1 AND LENGTH(x) - 2 = 1 THEN
x[0] = s
RESULT = x
EXIT
ENDIF
ENDIF
// Estimate result exponent.
// x^y = 10^e, where e = y * log10(x)
// log10(x) = log10(x_significand) + x_exponent
// log10(x_significand) = ln(x_significand) / ln(10)
xd = SLICE(x, 2)
k = POWER(digitsToString(xd), yn)
IFB k = 0 OR !isFinite(Constructor(k)) THEN
e = floor(yn * (LN("0." + digitsToString(xd)) / VAL(LN10) + VAL(x[1]) + 1))
ELSE
e = Constructor(k)[1]
ENDIF
// Exponent estimate may be incorrect e.g. x: 0.999999999999999999, y: 2.29, e: 0, r.e: -1.
// Overflow/underflow?
IFB e > maxE + 1 OR e < minE - 1 THEN
IFB e > 0 THEN
RESULT = IIF(s >= 0, "INF", "-INF")
ELSE
RESULT = "0"
ENDIF
EXIT
ENDIF
external = FALSE
x[0] = 1
rounding = x[0]
// Estimate the extra guard digits needed to ensure five correct rounding digits from
// naturalLogarithm(x). Example of failure without these extra digits (precision: 10):
// new Decimal(2.32456).pow('2087987436534566.46411')
// should be 1.162377823e+764914905173815, but is 1.162355823e+764914905173815
DIM array[] = 12, LENGTH(e)
k = small(array, 1)
// r = x^y = exp(y*ln(x))
r = naturalExponential(times(y, naturalLogarithm(x, pr + k)), pr)
rd = SLICE(r, 2)
// r may be Infinity, e.g. (0.9999999999999999).pow(-1e+40)
IFB LENGTH(rd) THEN
// Truncate to the required precision plus five rounding digits.
r = finalise(r, pr + 5, 1)
// If the rounding digits are [49]9999 or [50]0000 increase the precision by 10 and recalculate
// the result.
IFB checkRoundingDigits(rd, pr, rm) THEN
e = pr + 10
// Truncate to the increased precision plus five rounding digits.
r = finalise(naturalExponential(times(y, naturalLogarithm(x, e + k)), e), e + 5, 1)
// Check for 14 nines from the 2nd rounding digit (the first rounding digit may be 4 or 9).
IFB COPY(digitsToString(rd), pr + 1 + 1, pr + 15 + 1) + 1 = 1E+14 THEN
r = finalise(r, pr + 1, 0)
ENDIF
ENDIF
ENDIF
r[0] = s
external = TRUE
rounding = rm
RESULT = finalise(r, pr, rm)
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION toPrecision(x, sd = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB sd = NULL THEN
str = finiteToString(x, x[1] <= toExpNeg OR x[1] >= toExpPos)
ELSE
checkInt32(sd, 1, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
x = finalise(Constructor(x), sd, rm)
str = finiteToString(x, sd <= x[1] OR x[1] <= toExpNeg, sd)
ENDIF
RESULT = IIF(isNeg(x) AND isZero(x), "-" + str, str)
FEND
FUNCTION toSignificantDigits(x, sd = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB sd = NULL THEN
sd = precision
rm = rounding
ELSE
checkInt32(sd, 1, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
ENDIF
RESULT = toString(finalise(Constructor(x), sd, rm))
FEND
FUNCTION toString(x)
str = finiteToString(x, x[1] <= toExpNeg OR x[1] >= toExpPos)
RESULT = IIF(isNegative(x) AND !isZero(x), "-" + str, str)
FEND
FUNCTION truncated(x, isNumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = finalise(x, x[1] + 1, 1)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION valueOf(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
str = finiteToString(x, x[1] <= toExpNeg OR x[1] >= toExpPos)
RESULT = IIF(isNeg(x), "-" + str, str)
FEND
//////////////////////////////
// 短縮形
//////////////////////////////
FUNCTION abs(x)
RESULT = absoluteValue(x)
FEND
FUNCTION acos(x)
RESULT = inverseCosine(x)
FEND
FUNCTION acosh(x)
RESULT = inverseHyperbolicCosine(x)
FEND
FUNCTION asin(x)
RESULT = inverseSine(x)
FEND
FUNCTION asinh(x)
RESULT = inverseHyperbolicSine(x)
FEND
FUNCTION atan(x)
RESULT = inverseTangent(x)
FEND
FUNCTION atanh(x)
RESULT = inverseHyperbolicTangent(x)
FEND
FUNCTION add(augend, addend, isnumeric = FALSE)
RESULT = plus(augend, addend, isnumeric)
FEND
FUNCTION calc(str, pr = 20, rm = 4)
RESULT = calculate(str, pr, rm)
FEND
FUNCTION cbrt(x)
RESULT = cubeRoot(x)
FEND
FUNCTION clamp(x, min, max)
RESULT = clampedTo(x, min, max)
FEND
FUNCTION cmp(x, y)
RESULT = comparedTo(x, y)
FEND
FUNCTION cos(x)
RESULT = cosine(x)
FEND
FUNCTION cosh(x, isNumeric = FALSE)
RESULT = hyperbolicCosine(x, isNumeric)
FEND
FUNCTION divide(dividend, divisor, pr = 20, rm = 4, dp = NULL, _base = NULL, isnumeric = FALSE)
RESULT = dividedBy(dividend, divisor, pr, rm, dp, _base, isnumeric)
FEND
FUNCTION div(dividend, divisor, pr = 20, rm = 4, dp = NULL, _base = NULL, isnumeric = FALSE)
RESULT = dividedBy(dividend, divisor, pr, rm, dp, _base, isnumeric)
FEND
FUNCTION divToInt(x, y)
RESULT = dividedToIntegerBy(x, y)
FEND
FUNCTION dp(x)
RESULT = decimalPlaces(x)
FEND
FUNCTION eq(x, y)
RESULT = equals(x, y)
FEND
FUNCTION exp(x)
RESULT = naturalExponential(x)
FEND
FUNCTION gt(x, y)
RESULT = greaterThan(x, y)
FEND
FUNCTION gte(x, y)
RESULT = greaterThanOrEqualTo(x, y)
FEND
FUNCTION isInt(x)
RESULT = isInteger(x)
FEND
FUNCTION isNeg(x)
RESULT = isNegative(x)
FEND
FUNCTION isPos(x)
RESULT = isPositive(x)
FEND
FUNCTION ln(x)
RESULT = naturalLogarithm(x)
FEND
FUNCTION log(arg, base)
RESULT = logarithm(arg, base)
FEND
FUNCTION lt(x, y)
RESULT = lessThan(x, y)
FEND
FUNCTION lte(x, y)
RESULT = lessThanOrEqualTo(x, y)
FEND
FUNCTION mod(x, y)
RESULT = modulo(x, y)
FEND
FUNCTION mul(multiplicand, multiplier, isnumeric = FALSE)
RESULT = times(multiplicand, multiplier, isnumeric)
FEND
FUNCTION neg(x)
RESULT = negated(x)
FEND
FUNCTION pow(base, exponent)
RESULT = toPower(base, exponent)
FEND
FUNCTION sd(x, z = NULL)
RESULT = precision(x, z)
FEND
FUNCTION sin(x)
RESULT = sine(x)
FEND
FUNCTION sinh(x, isNumeric = FALSE)
RESULT = hyperbolicSine(x, isNumeric)
FEND
FUNCTION sqrt(x, isNumeric = FALSE)
RESULT = squareRoot(x, isNumeric)
FEND
FUNCTION sub(minuend, subtrahend, isnumeric = FALSE)
RESULT = minus(minuend, subtrahend, isnumeric)
FEND
FUNCTION tan(x)
RESULT = tangent(x)
FEND
FUNCTION tanh(x)
RESULT = hyperbolicTangent(x)
FEND
//////////////////////////////
// ヘルパー関数
//////////////////////////////
FUNCTION digitsToString(d)
indexOfLastWord = LENGTH(d) - 1
str = ""
w = d[0]
IFB indexOfLastWord > 0 THEN
str = str + w
DIM i = 1
WHILE i < indexOfLastWord
ws = d[i] + ""
k = LOG_BASE - LENGTH(ws)
IF k THEN str = str + getZeroString(k)
str = str + ws
i = i + 1
WEND
w = d[i]
ws = w + ""
k = LOG_BASE - LENGTH(ws)
IF k THEN str = str + getZeroString(k)
ELSEIF w = 0 THEN
RESULT = "0"
EXIT
ENDIF
// Remove trailing zeros of last w.
WHILE w MOD 10 = 0 AND w <> 0
w = w / 10
WEND
RESULT = str + w
FEND
FUNCTION checkInt32(i, min, max)
IF i <> VARTYPE(i, VAR_INTEGER) OR i < min OR i > max THEN RESULT = ERR_VALUE
FEND
FUNCTION checkRoundingDigits(d, i, rm, repeating = NULL)
// Get the length of the first word of the array d.
k = d[0]
WHILE k >= 10
i = i - 1
k = k / 10
WEND
// Is the rounding digit in the first word of d?
i = i - 1
IFB i < 0 THEN
i = i + LOG_BASE
di = 0
ELSE
di = VAL(CEIL((i + 1) / LOG_BASE))
i = i MOD LOG_BASE
ENDIF
// i is the index (0 - 6) of the rounding digit.
// E.g. if within the word 3487563 the first rounding digit is 5,
// then i = 4, k = 1000, rd = 3487563 % 1000 = 563 RESULT = ERR_VALUE
k = POWER(10, LOG_BASE - i)
IFB di > UBound(d) THEN
rd = 0
ELSE
rd = d[di] MOD k
ENDIF
IFB repeating = NULL THEN
IFB i < 3 THEN
IFB i = 0 THEN
rd = rd / 100
ELSEIF i = 1 THEN
rd = rd / 10
ENDIF
r = rm < 4 AND rd = 99999 OR rm > 3 AND rd = 49999 OR rd = 50000 OR rd = 0
ELSE
IFB di + 1 > UBound(d) THEN
n = 0
ELSE
n = d[di + 1]
ENDIF
r = (rm < 4 AND rd + 1 = k OR rm > 3 AND rd + 1 = k / 2) AND (n / k / 100) = POWER(10, i - 2) - 1 OR (rd = k / 2 OR rd = 0) AND (n / k / 100) = 0
ENDIF
ELSE
IFB i < 4 THEN
IFB i = 0 THEN
rd = rd / 1000
ELSEIF i = 1 THEN
rd = rd / 100
ELSEIF i = 2 THEN
rd = rd / 10
ENDIF
r = (repeating OR rm < 4) AND rd = 9999 OR !repeating AND rm > 3 AND rd = 4999
ELSE
IFB di + 1 > UBound(d) THEN
n = 0
ELSE
n = d[di + 1]
ENDIF
r = ((repeating OR rm < 4) AND rd + 1 = k OR (!repeating AND rm > 3) AND rd + 1 = k / 2) AND (n / k / 1000) = POWER(10, i - 3) - 1
ENDIF
ENDIF
RESULT = VARTYPE(r, VAR_BOOLEAN)
FEND
FUNCTION convertBase(str, baseIn, baseOut)
CONST NUMERALS = "0123456789abcdef"
DIM arr[0] = 0
DIM i = 0
DIM strL = LENGTH(str)
WHILE i < strL
arrL = LENGTH(arr)
WHILE TRUE
arrL = arrL - 1
IF arrL < 0 THEN BREAK
arr[arrL] = arr[arrL] * baseIn
WEND
arr[0] = arr[0] + (POS(COPY(str, i+1, 1), NUMERALS) - 1)
i = i + 1
j = 0
WHILE j < LENGTH(arr)
IFB arr[j] > baseOut - 1 THEN
IF j + 1 > UBound(arr) THEN
RESIZE(arr, j + 1)
arr[j+1] = 0
ENDIF
arr[j+1] = arr[j+1] + INT(arr[j] / baseOut)
arr[j] = arr[j] MOD baseOut
ENDIF
j = j + 1
WEND
WEND
arrayReverse(arr)
RESULT = SLICE(arr)
FEND
FUNCTION cosine2(Ctor, x)
IFB isZero(x) THEN
RESULT = SLICE(x)
EXIT
ENDIF
// Argument reduction: cos(4x) = 8*(cos^4(x) - cos^2(x)) + 1
// i.e. cos(x) = 8*(cos^4(x/4) - cos^2(x/4)) + 1
// Estimate the optimum number of times to use the argument reduction.
xd = x
xd = SLICE(xd, 2)
len = LENGTH(xd)
IFB len < 32 THEN
k = GLOBAL.CEIL(len / 3)
y = "" + (1 / tinyPow(4, k))
ELSE
k = 16
y = "2.3283064365386962890625e-10"
ENDIF
precision = precision + k
x = taylorSeries(Ctor, 1, times(x, y), Constructor(1))
// Reverse argument reduction
i = k
WHILE i > 0
i = i - 1
cos2x = times(x, x, NULL)
x = times(cos2x, cos2x, NULL)
x = minus(x, cos2x, NULL)
x = times(x, 8, NULL)
x = plus(x, 1, NULL)
WEND
precision = precision - k
RESULT = SLICE(x)
FEND
FUNCTION finalise(x, sd = NULL, rm = NULL, isTruncated = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
xd = SLICE(x, 2)
WHILE sd <> NULL
// Get the length of the first word of the digits array xd.
digits = 1
k = VAL(xd[0])
WHILE k >= 10
digits = digits + 1
k = k / 10
WEND
i = sd - digits
// Is the rounding digit in the first word of xd?
IFB i < 0 THEN
i = i + LOG_BASE
j = sd
xdi = 0
w = xd[xdi]
// Get the rounding digit at index j of w.
rd = w / POWER(10, digits - j - 1) MOD 10
ELSE
xdi = GLOBAL.CEIL((i+1)/LOG_BASE)
k = LENGTH(xd)
IFB xdi >= k THEN
IFB isTruncated THEN
// Needed by `naturalExponential`, `naturalLogarithm` and `squareRoot`.
WHILE k <= xdi
arrayPush(xd, 0)
k = k + 1
WEND
rd = 0
w = rd
digits = 1
i = i MOD LOG_BASE
j = i - LOG_BASE + 1
ELSE
BREAK
ENDIF
ELSE
k = xd[xdi]
w = k
// Get the number of digits of w.
digits = 1
WHILE k >= 10
digits = digits + 1
k = k / 10
WEND
// Get the index of rd within w.
i = i MOD LOG_BASE
// Get the index of rd within w, adjusted for leading zeros.
// The number of leading zeros of w is given by LOG_BASE - digits.
j = i - LOG_BASE + digits
// Get the rounding digit at index j of w.
rd = IIF(j < 0, 0, INT(w / POWER(10, digits - j - 1)) MOD 10)
ENDIF
ENDIF
// Are there any non-zero digits after the rounding digit?
// isTruncated =
//IF isTruncated OR sd < 0 OR x[xdi+3] = EMPTY THEN
//isTruncated = FALSE
IFB isTruncated THEN
ELSEIF sd < 0 THEN
isTruncated = TRUE
ELSEIF xdi > UBound(xd) THEN
isTruncated = TRUE
ELSEIF IIF(j < 0, w, w MOD POWER(10, digits - j - 1)) THEN
isTruncated = TRUE
ENDIF
// The expression `w % mathpow(10, digits - j - 1)` returns all the digits of w to the right
// of the digit at (left-to-right) index j, e.g. if w is 908714 and j is 2, the expression
// will give 714.
IFB i > 0 THEN
tmp = IIF(j > 0, w / POWER(10, digits - j), 0)
ELSE
IFB xdi = 0 THEN
tmp = 0
ELSE
tmp = xd[xdi - 1] MOD 10
ENDIF
ENDIF
IF isTruncated = NULL THEN isTruncated = FALSE
roundUp = IIF(rm < 4, _
// truepart
(VARTYPE(rd, VAR_BOOLEAN) OR VARTYPE(isTruncated, VAR_BOOLEAN)) AND (rm = 0 OR VARTYPE(rm = IIF(x[0] < 0, 3, 2), VAR_BOOLEAN)), _
// falsepart
rd > 5 OR rd = 5 AND (rm = 4 OR isTruncated OR rm = 6 AND _
// Check whether the digit to the left of the rounding digit is odd.
bitAnd(tmp, 1) OR rm = IIF(x[0] < 0, 8, 7) _
) _
)
IFB sd < 1 OR !xd[0] THEN
RESIZE(xd, 0)
IFB roundUp THEN
// Convert sd to decimal places.
sd = sd - (x[1] + 1)
// 1, 0.1, 0.01, 0.001, 0.0001 etc.
x[2] = POWER(10, (LOG_BASE - sd MOD LOG_BASE) MOD LOG_BASE)
x[1] = -1 * sd
ELSE
// Zero.
RESIZE(x, 2)
x[2] = 0
x[1] = 0
ENDIF
RESULT = SLICE(x)
EXIT
ENDIF
// Remove excess digits.
IFB i = 0 THEN
RESIZE(xd, xdi-1)
RESIZE(x, 1)
arrayMerge(x, xd)
k = 1
xdi = xdi - 1
ELSE
RESIZE(xd, xdi)
RESIZE(x, 1)
arrayMerge(x, xd)
k = POWER(10, LOG_BASE-i)
// E.g. 56700 becomes 56000 if 7 is the rounding digit.
// j > 0 means i > number of leading zeros of w.
IFB j > 0 THEN
RESIZE(x, xdi+2)
xd[xdi] = INT(INT(w / POWER(10, digits-j)) MOD POWER(10, j)) * k
x[xdi+2] = xd[xdi]
ELSE
RESIZE(x, xdi+2)
xd[xdi] = 0
x[xdi+2] = xd[xdi]
ENDIF
ENDIF
IFB roundUp THEN
WHILE TRUE
// Is the digit to be rounded up in the first word of xd?
IFB xdi = 0 THEN
// i will be the length of xd[0] before k is added.
i = 1
j = VAL(xd[0])
WHILE j >= 10
i = i + 1
j = j / 10
WEND
xd[0] = VAL(xd[0]) + k
x[2] = xd[0]
j = VAL(xd[0])
k = 1
WHILE j >= 10
k = k + 1
j = j / 10
WEND
// if i != k the length has increased.
IFB i <> k THEN
x[1] = x[1] + 1
IF x[2] = BASE THEN x[2] = 1
ENDIF
BREAK
ELSE
xd[xdi] = xd[xdi] + k
IF xd[xdi] <> BASE THEN BREAK
xd[xdi] = 0
xdi = xdi - 1
k = 1
ENDIF
WEND
ENDIF
// Remove trailing zeros.
FOR i = UBound(xd) TO 0 STEP -1
IFB xd[i] = 0 THEN
arrayPop(xd)
ELSE
BREAK
ENDIF
NEXT
BREAK
WEND
IFB external THEN
// Overflow?
IFB x[1] > maxE THEN
// Infinity
RESIZE(x, 1)
x[1] = EMPTY // 仮の値
// Underflow?
ELSEIF x[1] < minE THEN
x[1] = 0
RESIZE(x, 2)
x[2] = 0
ENDIF
ENDIF
RESIZE(x, 1)
arrayMerge(x, xd)
RESULT = SLICE(x)
FEND
FUNCTION finiteToString(x, isExp = FALSE, sd = EMPTY)
IFB !isFinite(x) THEN
RESULT = nonFiniteToString(x)
EXIT
ENDIF
e = x[1]
xd = SLICE(x, 2)
str = digitsToString(xd)
len = LENGTH(str)
IFB isExp THEN
k = sd - len
IFB sd AND k > 0 THEN
str = COPY(str, 1, 1) + "." + COPY(str, 2) + getZeroString(k)
ELSEIF len > 1 THEN
str = COPY(str, 1, 1) + "." + COPY(str, 2)
ENDIF
str = str + IIF(x[1] < 0, "e", "e+") + x[1]
ELSEIF e < 0 THEN
str = "0." + getZeroString(-1 * e - 1) + str
k = sd - len
IF sd AND k > 0 THEN str = str + getZeroString(k)
ELSEIF e >= len THEN
str = str + getZeroString(e + 1 - len)
k = sd - e - 1
IF sd AND k > 0 THEN str = str + "." + getZeroString(k)
ELSE
k = e + 1
IF k < len THEN str = COPY(str, 1, k) + "." + COPY(str, k+1)
k = sd - len
IFB sd AND k > 0 THEN
IF e + 1 = len THEN str = str + "."
str = str + getZeroString(k)
ENDIF
ENDIF
RESULT = str
FEND
FUNCTION getBase10Exponent(digits[], e)
DIM w = digits[0]
e = e * LOG_BASE
WHILE w >= 10
e = e + 1
w = w / 10
WEND
RESULT = e
FEND
FUNCTION getLN10(Ctor, sd, pr = NULL)
IFB sd > LN10PRECISION THEN
// Reset global state in case the exception is caught.
external = TRUE
IF pr THEN precision = pr
ENDIF
RESULT = finalise(Constructor(LN10), sd, 1, TRUE)
FEND
FUNCTION getPI(Ctor, sd, rm)
IFB sd > PI_PRECISION THEN
RESULT = ERR_VALUE
ELSE
RESULT = finalise(Constructor(PI), sd, rm, TRUE)
ENDIF
FEND
FUNCTION getPrecision(digits)
w = LENGTH(digits) - 1
len = w * LOG_BASE + 1
w = digits[w]
// If non-zero...
IFB w <> 0 THEN
// Subtract the number of trailing zeros of the last word.
WHILE w MOD 10 = 0
len = len - 1
w = w / 10
WEND
// Add the number of digits of the first word.
w = digits[0]
WHILE VAL(w) >= 10
len = len + 1
w = w / 10
WEND
ENDIF
RESULT = len
FEND
FUNCTION getZeroString(k)
zs = ""
WHILE k > 0
zs = zs + "0"
k = k - 1
WEND
RESULT = zs
FEND
FUNCTION intPow(Ctor, x, n, pr)
DIM isTruncated
DIM r = Constructor("1")
// Max n of 9007199254740991 takes 53 loop iterations.
// Maximum digits array length; leaves [28, 34] guard digits.
DIM k = CEIL(pr / LOG_BASE + 4)
external = FALSE
WHILE TRUE
IFB n MOD 2 THEN
r = times(r, x)
rd = SLICE(r, 2)
IF truncate(rd, k) THEN isTruncated = TRUE
ENDIF
n = GLOBAL.floor(n/2)
IFB n = 0 THEN
rd = SLICE(r, 2)
// To ensure correct rounding when r.d is truncated, increment the last word if it is zero.
n = LENGTH(rd) - 1
IF isTruncated AND rd[n] = 0 THEN rd[n] = rd[n] + 1
BREAK
ENDIF
x = times(x, x)
xd = SLICE(x, 2)
truncate(xd, k)
WEND
external = TRUE
RESULT = r
FEND
FUNCTION isOdd(n)
IFB !isInteger(n) THEN
RESULT = ERR_VALUE
EXIT
ENDIF
RESULT = IIF(modulo(n, 2) = "0", FALSE, TRUE)
FEND
FUNCTION maxOrMin(Ctor, args, ltgt)
RESULT = ERR_VALUE
FEND
FUNCTION naturalExponential(x, sd = NULL, isNumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
rep = 0
i = 0
k = 0
rm = rounding
pr = precision
// 0/NaN/Infinity
IFB (x[0] = 1 AND x[1] = 0 AND x[2] = 0) OR x[1] = NULL OR x[1] > 17 THEN
ENDIF
IFB sd = NULL THEN
external = FALSE
wpr = pr
ELSE
wpr = sd
ENDIF
t = Constructor(0.03125)
// while abs(x) >= 0.1
WHILE x[1] > -2
// x = x / 2^5
x = times(x, t)
k = k + 5
WEND
// Use 2 * log10(2^k) + 5 (empirically derived) to estimate the increase in precision
// necessary to ensure the first 4 rounding digits are correct.
guard = INT(GLOBAL.LN(POWER(2, k)) / MathLN10 * 2 + 5)
wpr = wpr + guard
sum = Constructor("1")
pow = sum
denominator = pow
precision = wpr
WHILE TRUE
pow = finalise(times(pow, x), wpr, 1)
i = i + 1
denominator = times(denominator, i)
t = plus(sum, divide(pow, denominator, wpr, 1))
td = SLICE(t, 2)
sumd = SLICE(sum, 2)
IFB COPY(digitsToString(td), 1, wpr) = COPY(digitsToString(sumd), 1, wpr) THEN
j = k
j = j - 1
WHILE j >= 0
sum = finalise(times(sum, sum), wpr, 1)
j = j - 1
WEND
// Check to see if the first 4 rounding digits are [49]999.
// If so, repeat the summation with a higher precision, otherwise
// e.g. with precision: 18, rounding: 1
// exp(18.404272462595034083567793919843761) = 98372560.1229999999 (should be 98372560.123)
// `wpr - guard` is the index of first rounding digit.
IFB sd = NULL THEN
sumd = SLICE(sum, 2)
IFB rep < 3 AND checkRoundingDigits(sumd, wpr - guard, rm, rep) THEN
precision = wpr = wpr + 10
t = Constructor(1)
pow = t
denominator = pow
i = 0
rep = rep + 1
ELSE
precision = pr
RESULT = finalise(sum, precision, rm, external = TRUE)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
ELSE
precision = pr
RESULT = sum
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
ENDIF
sum = t
WEND
FEND
FUNCTION naturalLogarithm(y, sd = NULL, isNumeric = FALSE)
y = IIF(VARTYPE(y) < 8192, Constructor(y), y)
n = 1
guard = 10
x = y
xd = SLICE(x, 2)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
rm = rounding
pr = precision
// Is x negative or Infinity, NaN, 0 or 1?
IFB x[0] < 0 THEN
// RESULT = Constructor(0)
EXIT
ENDIF
IFB sd = NULL THEN
external = FALSE
wpr = pr
ELSE
wpr = sd
ENDIF
wpr = wpr + guard
precision = wpr
c = digitsToString(xd)
c0 = COPY(c, 1, 1)
e = x[1]
IFB .lessThan(GLOBAL.ABS(e), "1.5e+15") THEN
// Argument reduction.
// The series converges faster the closer the argument is to 1, so using
// ln(a^b) = b * ln(a), ln(a) = ln(a^b) / b
// multiply the argument by itself until the leading digits of the significand are 7, 8, 9,
// 10, 11, 12 or 13, recording the number of multiplications so the sum of the series can
// later be divided by this number, then separate out the power of 10 using
// ln(a*10^b) = ln(a) + b*ln(10).
// max n is 21 (gives 0.9, 1.0 or 1.1) (9e15 / 21 = 4.2e14).
//while (c0 < 9 && c0 != 1 || c0 == 1 && c.charAt(1) > 1) {
// max n is 6 (gives 0.7 - 1.3)
WHILE c0 < 7 AND c0 <> 1 OR c0 = 1 AND COPY(c, 1, 1) > 3
x = times(x, y)
xd = SLICE(x, 2)
c = digitsToString(xd)
c0 = COPY(c, 1, 1)
n = n + 1
WEND
e = x[1]
IFB c0 > 1 THEN
x = Constructor("0." + c)
e = e + 1
ELSE
x = Constructor(c0 + "." + COPY(c, 2))
ENDIF
ELSE
// The argument reduction method above may result in overflow if the argument y is a massive
// number with exponent >= 1500000000000000 (9e15 / 6 = 1.5e15), so instead recall this
// function using ln(x*10^e) = ln(x) + e*ln(10).
t = times(getLn10(Ctor, wpr + 2, pr), e)
x = plus(naturalLogarithm(Constructor(c0 + "." + COPY(c, 2)), wpr - guard), t)
precision = pr
external = TRUE
RESULT = IIF(sd = NULL, finalise(x, pr, rm, external), x)
EXIT
ENDIF
// x1 is x reduced to a value near 1.
x1 = x
// Taylor series.
// ln(y) = ln((1 + x)/(1 - x)) = 2(x + x^3/3 + x^5/5 + x^7/7 + ...)
// where x = (y - 1)/(y + 1) (|x| < 1)
x = divide(minus(x, "1"), plus(x, "1"), wpr, 1)
numerator = x
sum = numerator
sumd = SLICE(sum, 2)
x2 = finalise(times(x, x), wpr, 1)
denominator = 3
WHILE TRUE
numerator = finalise(times(numerator, x2), wpr, 1)
t = plus(sum, divide(numerator, constructor(denominator), wpr, 1, NULL, NULL, NULL), NULL)
td = SLICE(t, 2)
IFB COPY(digitsToString(td), 1, wpr) = COPY(digitstoString(sumd), 1, wpr) THEN
sum = times(sum, "2")
// Reverse the argument reduction. Check that e is not 0 because, besides preventing an
// unnecessary calculation, -0 + 0 = +0 and to ensure correct rounding -0 needs to stay -0.
IF e <> 0 THEN sum = plus(sum, times(getLn10(Ctor, wpr + 2, pr), e, NULL), NULL)
sum = divide(sum, Constructor(n), wpr, 1)
sumd = SLICE(sum, 2)
// Is rm > 3 and the first 4 rounding digits 4999, or rm < 4 (or the summation has
// been repeated previously) and the first 4 rounding digits 9999?
// If so, restart the summation with a higher precision, otherwise
// e.g. with precision: 12, rounding: 1
// ln(135520028.6126091714265381533) = 18.7246299999 when it should be 18.72463.
// `wpr - guard` is the index of first rounding digit.
IFB sd = NULL THEN
rep = 0
IFB checkRoundingDigits(sumd, wpr - guard, rm, rep) THEN
wpr = wpr + guard
precision = wpr
x = divide(minus(x1, "1"), plus(x1, "1"), wpr, 1)
numerator = x
t = numerator
x2 = finalise(times(x, x), wpr, 1)
rep = 1
denominator = wpr
ELSE
precision = pr
external = TRUE
RESULT = finalise(sum, precision, rm, external)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
ELSE
precision = pr
RESULT = sum
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
ENDIF
sum = t
sumd = SLICE(sum, 2)
denominator = denominator + 2
WEND
FEND
FUNCTION nonFiniteToString(x[])
IFB x[0] = NULL AND x[1] = NULL AND x[2] = FALSE THEN
RESULT = "NaN"
ELSEIF CHKNUM(x[0]) AND x[1] = NULL AND x[2] = FALSE THEN
RESULT = IIF(x[0] > 0, "", "-") + "INF"
ENDIF
FEND
FUNCTION parseDecimal(x, str)
// Decimal point?
e = POS(".", str) - 1
IF e <> 0 THEN str = REPLACE(str, ".", "")
// Exponential form?
DIM i = POS("e", str)
IFB i <> 0 THEN
// Determine exponent.
IF e < 0 THEN e = i
e = VAL(COPY(str, i+1))
str = COPY(str, 1, i-1)
ELSEIF e < 0 THEN
// Integer
e = LENGTH(str)
ENDIF
// Determine leading zeros.
i = 0
WHILE COPY(str, i+1, 1) = "0"
i = i + 1
WEND
// Determine trailing zeros.
len = LENGTH(str)
WHILE COPY(str, len, 1) = "0"
len = len - 1
IF len = 0 THEN BREAK
WEND
str = COPY(str, i+1, len-i)
IFB str <> 0 AND str <> "" THEN
len = len - i
e = e - i - 1
RESIZE(x, 1)
x[1] = e
//x[2] = 0
// Transform base
// e is the base 10 exponent.
// i is where to slice str to get the first word of the digits array.
i = (e + 1) MOD LOG_BASE
IF e < 0 THEN i = i + LOG_BASE
IFB i < len THEN
IF i THEN arrayPush(x, VAL(COPY(str, 1, i)))
len = len - LOG_BASE
WHILE i < len
arrayPush(x, VAL(COPY(str, i+1, LOG_BASE)))
i = i + LOG_BASE
WEND
str = COPY(str, i+1)
i = LOG_BASE - LENGTH(str)
ELSE
i = i - len
ENDIF
WHILE i > 0
str = str + "0"
i = i - 1
WEND
arrayPush(x, VAL(str))
IFB external THEN
// Overflow?
IFB x[1] = maxE THEN
// Infinity.
x[2] = NULL
x[1] = NULL
// Underflow?
ELSEIF x[1] = minE THEN
// Zero.
x[1] = 0
x[2] = 0
ENDIF
ENDIF
ELSE
// Zero.
RESIZE(x, 2)
x[1] = 0
x[2] = 0
ENDIF
RESULT = SLICE(x)
FEND
FUNCTION parseOther(x, str)
IF POS("Infinity", str) THEN str = REPLACE(str, "Infinity", "INF")
IFB POS("_", str) <> 0 THEN
ELSEIF str = "INF" OR str = "NaN" THEN
IF str = "NaN" THEN x[0] = NULL
RESIZE(x, 2)
x[1] = NULL
x[2] = FALSE
RESULT = SLICE(x)
EXIT
ENDIF
IFB reTest(str, isHex) THEN
_base = 16
str = STRCONV(str, SC_LOWERCASE)
ELSEIF reTest(str, isBinary) THEN
_base = 2
ELSEIF reTest(str, isOctal) THEN
_base = 8
ELSE
EXIT
ENDIF
// Is there a binary exponent part?
i = POS("p", str)
IFB i > 0 THEN
p = COPY(str, (i+1)+1)
str = COPY(str, 2+1, i+1)
ELSE
p = NULL
str = COPY(str, 2+1)
ENDIF
// Convert `str` as an integer then divide the result by `base` raised to a power such that the
// fraction part will be restored.
i = POS(".", str)
isFloat = i >= 1
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
IFB isFloat THEN
str = REPLACE(str, ".", "")
len = LENGTH(str)
i = len - i
// log[10](16) = 1.2041... , log[10](88) = 1.9444....
divisor = intPow(Ctor, Constructor(base), i, i * 2)
ELSE
len = NULL
divisor = NULL
ENDIF
xd = convertBase(str, _base, base)
xe = LENGTH(xd) - 1
// Remove trailing zeros.
i = xe
WHILE xd[i] = 0
i = i - 1
arrayPop(xd)
WEND
IFB i < 0 THEN
// RESULT =
EXIT
ENDIF
RESIZE(x, 1)
x[1] = getBase10Exponent(xd, xe)
arrayMerge(x, xd)
external = FALSE
// At what precision to perform the division to ensure exact conversion?
// maxDecimalIntegerPartDigitCount = ceil(log[10](b) * otherBaseIntegerPartDigitCount)
// log[10](2) = 0.30103, log[10](8) = 0.90309, log[10](16) = 1.20412
// E.g. ceil(1.2 * 3) = 4, so up to 4 decimal digits are needed to represent 3 hex int digits.
// maxDecimalFractionPartDigitCount = {Hex:4|Oct:3|Bin:1} * otherBaseFractionPartDigitCount
// Therefore using 4 * the number of digits of str will always be enough.
IF isFloat THEN x = divide(x, divisor, len * 4)
// Multiply by the binary exponent part if present.
IF p <> NULL THEN x = times(x, POWER(2, p))
external = TRUE
RESULT = SLICE(x)
FEND
FUNCTION sine2(Ctor, x)
xd = x
xd = SLICE(xd, 2)
len = LENGTH(xd)
IFB len < 3 THEN
RESULT = IIF(isZero(x), x, taylorSeries(Ctor, 2, x, x))
EXIT
ENDIF
// Argument reduction: sin(5x) = 16*sin^5(x) - 20*sin^3(x) + 5*sin(x)
// i.e. sin(x) = 16*sin^5(x/5) - 20*sin^3(x/5) + 5*sin(x/5)
// and sin(x) = sin(x/5)(5 + sin^2(x/5)(16sin^2(x/5) - 20))
// Estimate the optimum number of times to use the argument reduction.
k = 1.4 * GLOBAL.SQRT(len)
k = INT(IIF(k > 16, 16, k))
x = times(x, 1 / tinyPow(5, k), NULL)
x = taylorSeries(Ctor, 2, x, x)
// Reverse argument reduction
d5 = Constructor(5)
d16 = Constructor(16)
d20 = Constructor(20)
WHILE k > 0
k = k - 1
sin2x = times(x, x, NULL)
x = times(x, plus(d5, times(sin2x, minus(times(d16, sin2x, NULL), d20, NULL), NULL), NULL), NULL)
WEND
RESULT = SLICE(x)
FEND
FUNCTION taylorSeries(Ctor, n, x, y, isHyperbolic = NULL)
i = 1
pr = precision
k = GLOBAL.CEIL(pr / LOG_BASE)
external = FALSE
x2 = times(x, x)
u = Constructor(y)
WHILE TRUE
multiplicand = times(u, x2)
multiplier = Constructor(n * (n + 1))
t = divide(multiplicand, multiplier, pr, 1)
n = n + 2
isHyperbolic = IIF(isHyperbolic = NULL, FALSE, isHyperbolic)
u = IIF(isHyperbolic, plus(y, t), minus(y, t))
y = divide(times(t, x2), Constructor(n * (n + 1)), pr, 1)
n = n + 2
t = plus(u, y)
td = SLICE(t, 2)
ud = SLICE(u, 2)
IFB !(UBound(td) < k) THEN
j = k
TRY
WHILE td[j] = ud[j] AND j >= 0
j = j - 1
IF j = 0 THEN BREAK 2
WEND
EXCEPT
ENDTRY
IF j = -1 THEN BREAK
ENDIF
j = u
u = y
y = t
t = j
i = i + 1
WEND
external = TRUE
RESIZE(td, k)
RESIZE(t, 1)
arrayMerge(t, td)
RESULT = SLICE(t)
FEND
FUNCTION tinyPow(b, e)
DIM n = b
e = e - 1
WHILE e > 0
n = n * b
e = e - 1
WEND
RESULT = n
FEND
FUNCTION toLessThanHalfPi(Ctor, x)
isNeg = x[0] < 0
_pi = getPi(Ctor, Ctor.precision, 1)
halfPi = times(_pi, "0.5", NULL)
x = absoluteValue(x, NULL)
IFB lte(x, halfPi) THEN
quadrant = IIF(isNeg, 4, 1)
RESULT = SLICE(x)
EXIT
ENDIF
t = divToInt(x, pi)
IFB isZero(t) THEN
quadrant = IIF(isNeg, 3, 2)
ELSE
x = minus(x, times(t, pi))
// 0 <= x <pi
IFB lte(x, halfPi) THEN
quadrant = IIF(isOdd(t), IIF(isNeg, 2, 3), IIF(isNeg, 4, 1))
RESULT = SLICE(x)
EXIT
ENDIF
quadrant = IIF(isOdd(t), IIF(isNeg, 1, 4), IIF(isNeg, 3, 2))
ENDIF
RESULT = abs(minus(x, pi))
FEND
FUNCTION toLessThanHalfPi2(Ctor, x)
isNeg = x[0] < 0
_pi = getPi(Ctor, precision, 1)
halfPi = times(_pi, "0.5", NULL)
x = absoluteValue(x, NULL)
IFB lte(x, halfPi) THEN
quadrant = IIF(isNeg, 4, 1)
RESULT = SLICE(x)
EXIT
ENDIF
t = divToInt(x, pi)
IFB isZero(t) THEN
quadrant = IIF(isNeg, 3, 2)
ELSE
x = minus(x, times(t, pi), NULL)
// 0 <= x <pi
IFB lte(x, halfPi) THEN
quadrant = IIF(isOdd(t), IIF(isNeg, 2, 3), IIF(isNeg, 4, 1))
RESULT = SLICE(x)
EXIT
ENDIF
quadrant = IIF(isOdd(t), IIF(isNeg, 1, 4), IIF(isNeg, 3, 2))
ENDIF
RESULT = abs(minus(x, pi))
FEND
FUNCTION toStringBinary(x, baseOut, sd, rm)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
isExp = IIF(sd <> NULL, TRUE, FALSE)
IFB isExp THEN
checkInt32(sd, 1, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
ELSE
sd = precision
rm = rounding
ENDIF
IFB !isFinite(x) THEN
str = nonFiniteToString(x)
ELSE
str = finiteToString(x)
i = POS(".", str) - 1
// Use exponential notation according to `toExpPos` and `toExpNeg`? No, but if required:
// maxBinaryExponent = floor((decimalExponent + 1) * log[2](10))
// minBinaryExponent = floor(decimalExponent * log[2](10))
// log[2](10) = 3.321928094887362347870319429489390175864
IFB isExp THEN
_base = 2
IFB baseOut = 16 THEN
sd = sd * 4 - 3
ELSEIF baseOut = 8 THEN
sd = sd * 3 - 2
ENDIF
ELSE
_base = baseOut
ENDIF
ENDIF
// Convert the number as an integer then divide the result by its base raised to a power such
// that the fraction part will be restored.
// Non-integer.
IFB i >= 0 THEN
str = REPLACE(str, ".", "")
y = Constructor(1)
y[1] = LENGTH(str) - i
yd = convertBase(finiteToString(y), 10, _base)
RESIZE(y, 1)
arrayMerge(y, yd)
y[1] = LENGTH(yd)
ENDIF
xd = convertBase(str, 10, _base)
len = LENGTH(xd)
e = len
// Remove trailing zeros.
len = len - 1
WHILE xd[len] = 0
arrayPop(xd)
IF len = 0 THEN BREAK
len = len - 1
WEND
IFB !xd[0] THEN
str = IIF(isExp, "0p+0", "0")
ELSE
IFB i < 0 THEN
e = e - 1
roundUp = FALSE
ELSE
// 修正
x = Constructor(x)
x = RESIZE(x, 1)
arrayMerge(x, xd)
x[1] = e
x = divide(x, y, sd, rm, 0, base)
xd = SLICE(x)
e = x[1]
roundUp = inexact
ENDIF
// The rounding digit, i.e. the digit after the digit that may be rounded up.
IFB sd > UBound(xd) THEN
i = NULL
roundUp = roundUp OR FALSE
ELSE
i = xd[sd]
roundUp = roundUp OR xd[sd + 1] <> NULL
ENDIF
k = _base / 2
IFB rm < 4 THEN
// (i !== void 0 || roundUp) && (rm === 0 || rm === (x.s < 0 ? 3 : 2))
roundUp = (i = NULL OR roundUp) AND (rm = 0 OR rm = IIF(x[0] < 0, 3, 2))
ELSE
// i > k || i === k && (rm === 4 || roundUp || rm === 6 && xd[sd - 1] & 1 ||
// rm === (x.s < 0 ? 8 : 7));
bit = IIF(sd - 1 > UBound(xd), 0, 1)
roundUp = (i > k OR i = k AND (rm = 4 OR roundUp OR rm = 6 AND bitAnd(bit, 1)) OR rm = IIF(x[0] < 0, 8, 7))
ENDIF
// roundUp = IIF(rm < 4, _
// (i <> NULL OR roundUp) AND (rm = 0 OR rm = IIF(x[0] < 0, 3, 2)), _
// i > k OR i = k AND (rm = 4 OR roundUp OR rm = 6 AND xd[sd - 1] AND 1 OR rm = IIF(x[0] < 0, 8, 7))
RESIZE(xd, sd)
IFB roundUp THEN
// Rounding up may mean the previous digit has to be rounded up and so on.
sd = sd - 1
WHILE xd[sd] > base - 1
xd[sd] = 0
IFB !sd THEN
e = e + 1
arrayUnshift(xd)
ENDIF
WEND
ENDIF
// Determine trailing zeros.
len = LENGTH(xd)
WHILE !xd[len - 1]
len = len - 1
WEND
// E.g. [4, 11, 15] becomes 4bf.
str = ""
FOR i = 0 TO len - 1
str = str + COPY(NUMERALS, VAL(xd[i]) + 1, 1)
NEXT
// Add binary exponent suffix?
IFB isExp THEN
IFB len > 1 THEN
IFB baseOut = 16 OR baseOut = 8 THEN
i = IIF(baseOut = 16, 4, 3)
WHILE len MOD i
str = str + "0"
len = len + 1
WEND
xd = convertBase(str, base, baseOut)
len = xd
WHILE !xd[len - 1]
len = len - 1
WEND
// xd[0] will always be be 1
str = "1"
FOR i = 1 TO len
str = str + COPY(NUMERALS, xd[i], 1)
NEXT
ELSE
str = COPY(str, 1, 1) + "." + COPY(str, 2)
ENDIF
ENDIF
ELSEIF e < 0 THEN
WHILE e < 0
str = "'0" + str
e = e + 1
WEND
str = "0." + str
ELSE
e = e + 1
IFB e > len THEN
FOR e = e - len TO 1 STEP -1
str = str + "0"
NEXT
ELSEIF e < len THEN
str = COPY(str, 1, e) + "." + COPY(str, e)
ENDIF
ENDIF
str = IIF(baseOut = 16, "0x", IIF(baseOut = 2, "0b", IIF(baseOut = 8, "0o", ""))) + str
ENDIF
RESULT = IIF(x[0] < 0, "-" + str, str)
FEND
FUNCTION truncate(arr, len)
IFB LENGTH(arr) > len THEN
RESIZE(arr, len)
RESULT = TRUE
EXIT
ENDIF
FEND
//////////////////////////////
// その他
//////////////////////////////
FUNCTION compare(a, b, aL, bL)
IFB aL <> bL THEN
r = IIF(aL > bL, 1, -1)
ELSE
r = 0
i = r
WHILE i < aL
IFB a[i] <> b[i] THEN
r = IIF(a[i] > b[i], 1, -1)
BREAK
ENDIF
i = i + 1
WEND
ENDIF
RESULT = r
FEND
FUNCTION Constructor(v)
CONST number = 5
CONST string = 258
DIM x = SAFEARRAY(-1)
// Duplicate.
IFB isDecimalInstance(v) THEN
x[0] = v[0]
vd = SLICE(v, 2)
IFB external THEN
IFB !LENGTH(vd) OR v[1] > maxE THEN
// Infinity.
RESIZE(x, 2)
x[1] = NULL
x[2] = NULL
ELSEIF v[1] < minE THEN
// Zero.
RESIZE(x, 2)
x[1] = 0
x[2] = 0
ELSE
RESIZE(x, 1)
x[1] = v[1]
arrayMerge(x, vd)
ENDIF
ELSE
RESIZE(x, 1)
x[1] = v[1]
arrayMerge(x, vd)
ENDIF
RESULT = SLICE(x)
EXIT
ENDIF
t = VARTYPE(v)
IFB t = number THEN
IFB v = 0 THEN
RESIZE(x, 2)
x[0] = IIF(1/v<0, -1, 1)
x[1] = 0
x[2] = 0
RESULT = SLICE(x)
EXIT
ENDIF
IFB v < 0 THEN
v = -1 * v
x[0] = -1
ELSE
x[0] = 1
ENDIF
// Fast path for small integers.
IFB v < POWER(10, 7) THEN
IFB v = VARTYPE(v, VAR_INTEGER) THEN
e = 0
i = v
WHILE i >= 10
e = e + 1
i = i / 10
WEND
IFB external THEN
IFB e > maxE THEN
RESIZE(x, 2)
x[1] = NULL
x[2] = NULL
ELSEIF e < minE THEN
RESIZE(x, 2)
x[1] = 0
x[2] = 0
ELSE
RESIZE(x, 1)
x[1] = e
arrayPush(x, v)
ENDIF
ELSE
RESIZE(x, 1)
x[1] = e
DIM tmp[] = v
arrayMerge(x, tmp)
ENDIF
RESULT = SLICE(x)
EXIT
// Infinity, NaN
ELSEIF v * 0 <> 0 THEN
IF !v THEN x[0] = NULL
x[1] = NULL
x[2] = NULL
EXIT
ENDIF
ENDIF
RESULT = parseDecimal(x, v)
EXIT
ELSEIF v = "NaN" THEN
RESIZE(x, 2)
x[0] = NULL
x[1] = NULL
x[2] = FALSE
RESULT = SLICE(x)
EXIT
ELSEIF t <> string THEN
RESULT = ERR_VALUE
EXIT
ENDIF
// Minus sign?
i = COPY(v, 1, 1)
IFB i = "-" THEN
v = COPY(v, 2)
x[0] = -1
ELSE
// Plus sign?
IF i = "+" THEN v = COPY(v, 1)
x[0] = 1
ENDIF
RESULT = IIF(reTest(v, "^(\d+(\.\d*)?|\.\d+)(e[+-]?\d+)?$"), parseDecimal(x, v), parseOther(x, v))
FEND
FUNCTION isDecimalInstance(v)
RESULT = IIF(isArray(v), TRUE, FALSE)
FEND
FUNCTION multiplyInteger(x, k, base)
DIM carry = 0
DIM i = UBound(x)
WHILE i >= 0
temp = x[i] * k + carry
x[i] = INT(temp MOD base)
carry = INT(temp / base)
i = i - 1
WEND
IF carry <> 0 THEN arrayUnshift(x, carry)
RESULT = SLICE(x)
FEND
PROCEDURE subtract(Var a, b, aL, base)
DIM i = 0
// Subtract b from a.
WHILE aL > 0
aL = aL - 1
a[aL] = a[aL] - i
i = IIF(a[aL] < b[aL], 1, 0)
a[aL] = i * base + a[aL] - b[aL]
WEND
// Remove leading zeros.
WHILE !a[0] AND LENGTH(a) > 1
arrayShift(a)
WEND
FEND
//////////////////////////////
// 自作関数
//////////////////////////////
FUNCTION calculate(str, pr = 20, rm = 4)
RESULT = tokenize(str)
RESULT = toRPN(RESULT)
RESULT = calcRPN(RESULT, pr, rm)
FEND
FUNCTION calcRPN(tokens, pr, rm)
DIM denominator[-1]
DIM numerator[-1]
FOR token IN tokens
IFB reTest(token, "[0-9.]+") THEN
arrayPush(denominator, "" + 1)
arrayPush(numerator, "" + token)
ELSEIF token = "u-" THEN
arrayPush(numerator, times("-1", arrayPop(numerator)))
ELSEIF token = "floor" THEN
bottom = arrayPop(denominator)
top = arrayPop(numerator)
arrayPush(denominator, "1")
arrayPush(numerator, floor(dividedBy(top, bottom)))
ELSEIF token = "ceil" THEN
bottom = arrayPop(denominator)
top = arrayPop(numerator)
arrayPush(denominator, "1")
arrayPush(numerator, THIS.ceil(dividedBy(top, bottom)))
ELSE
IFB token = "+" OR token = "-" THEN
DIM du = UBound(denominator)
DIM nu = UBound(numerator)
bottom = times(denominator[du], denominator[du-1])
top = EVAL(denominator[du] * numerator[nu-1] + token + numerator[nu] * denominator[du-1])
arrayPop(denominator)
arrayPop(denominator)
arrayPop(numerator)
arrayPop(numerator)
arrayPush(denominator, bottom)
arrayPush(numerator, top)
ELSEIF token = "*" THEN
arrayPush(denominator, times(arrayPop(denominator), arrayPop(denominator)))
arrayPush(numerator, times(arrayPop(numerator), arrayPop(numerator)))
ELSEIF token = "/" THEN
swap(denominator[UBound(denominator)], numerator[UBound(numerator)])
arrayPush(denominator, times(arrayPop(denominator), arrayPop(denominator)))
arrayPush(numerator, times(arrayPop(numerator), arrayPop(numerator)))
ELSEIF token = "//" THEN
swap(denominator[UBound(denominator)], numerator[UBound(numerator)])
arrayPush(denominator, times(arrayPop(denominator), arrayPop(denominator)))
arrayPush(numerator, times(arrayPop(numerator), arrayPop(numerator)))
bottom = arrayPop(denominator)
top = arrayPop(numerator)
arrayPush(denominator, "1")
arrayPush(numerator, THIS.floor(dividedBy(top, bottom)))
ELSEIF token = "%" THEN
bottom = dividedBy(arrayPop(numerator), arrayPop(denominator))
top = dividedBy(arrayPop(numerator), arrayPop(denominator))
arrayPush(denominator, "1")
arrayPush(numerator, modulo(top, bottom ))
ENDIF
ENDIF
IFB COPY(denominator[UBound(denominator)], 1, 1) = "-" THEN
denominator[UBound(denominator)] = times("-1", denominator[UBound(denominator)])
numerator[UBound(numerator)] = times("-1", numerator[UBound(numerator)])
ENDIF
NEXT
DIM x = SAFEARRAY(-1)
DIM n = dividedBy(numerator[0], denominator[0])
x = Constructor(n)
RESULT = toString(finalise(x, pr, rm))
FEND
FUNCTION cmpPrecedence(token1, token2)
DIM operators[] = "+", 0, LEFT, "-", 0, LEFT, "*", 5, LEFT, "/", 5, LEFT, "%", 5, LEFT, "^", 10, RIGHT
IFB isOperator(token1) AND isOperator(token2) THEN
RESULT = operators[arraySearch(token1, operators)+1] - operators[arraySearch(token2, operators)+1]
ELSE
RESULT = ERR_VALUE
ENDIF
FEND
FUNCTION isOperator(token)
RESULT = reTest(token, "[+\-*/%^]")
FEND
FUNCTION tokenize(expr)
DIM tokens[-1]
DIM i = 1
DIM str = ""
WHILE i <= LENGTH(expr)
char = COPY(expr, i, 1)
IFB reTest(char, "\s") THEN
i = i + 1
CONTINUE
ENDIF
IFB reTest(char, "[0-9.]") THEN
num = char
i = i + 1
WHILE i <= LENGTH(expr) AND reTest(COPY(expr, i, 1), "[0-9.]")
num = num + COPY(expr, i, 1)
i = i + 1
WEND
arrayPush(tokens, VAL(num))
CONTINUE
ENDIF
IFB reTest(char, "[+\-*/^%]") THEN
IFB COPY(expr, i, 2) = "//" THEN
arrayPush(tokens, "//")
i = i + 2
ELSE
DIM prev = ""
IF LENGTH(tokens) >= 1 THEN prev = tokens[LENGTH(tokens)-1]
IFB char = "-" AND (LENGTH(tokens) = 0 OR (VARTYPE(prev) = 258 AND (isOperator(prev) OR prev = "(")))
arrayPush(tokens, "u-")
ELSE
arrayPush(tokens, char)
ENDIF
i = i + 1
ENDIF
CONTINUE
ENDIF
IFB reTest(char, "[A-Za-z0-9]") THEN
str = str + char
i = i + 1
WHILE i <= LENGTH(expr) AND reTest(COPY(expr, i, 1), "[A-Za-z0-9]")
str = str + COPY(expr, i, 1)
i = i + 1
WEND
arrayPush(tokens, str)
str = ""
CONTINUE
ENDIF
IFB reTest(char, "[()]") THEN
IFB str <> "" THEN
arrayPush(tokens, str)
str = ""
ENDIF
arrayPush(tokens, char)
i = i + 1
CONTINUE
ENDIF
WEND
RESULT = SLICE(tokens)
FEND
FUNCTION toRPN(tokens, pr = 20, rm = 4, isnumeric = FALSE)
HASHTBL precedence
precedence["^"] = 4
precedence["u-"] = 3
precedence["*"] = 2
precedence["/"] = 2
precedence["%"] = 2
precedence["+"] = 1
precedence["-"] = 1
HASHTBL rightAssociative
rightAssociative["u-"] = TRUE
rightAssociative["^"] = TRUE
DIM output[-1]
DIM stack[-1]
FOR token IN tokens
IFB reTest(token, "[0-9]+") THEN
arrayPush(output, token)
ELSEIF token = "floor" OR token = "ceil" THEN
arrayPush(stack, token)
ELSEIF token ="(" THEN
arrayPush(stack, token)
ELSEIF token = ")" THEN
WHILE LENGTH(stack) <> 0 AND stack[LENGTH(stack)-1] <> "("
arrayPush(output, arrayPop(stack))
WEND
arrayPop(stack)
IFB LENGTH(stack) <> 0 THEN
IF stack[LENGTH(stack) - 1] = "floor" OR stack[LENGTH(stack) - 1] = "ceil" THEN arrayPush(output, arrayPop(stack))
ENDIF
ELSE
WHILE LENGTH(stack)
IFB stack[LENGTH(stack)-1] <> "(" AND _
( _
precedence[token] < precedence[stack[LENGTH(stack)-1]] OR _
( _
precedence[token] = precedence[stack[LENGTH(stack)-1]] AND _
!rightAssociative[token] _
) _
) THEN
arrayPush(output, arrayPop(stack))
ELSE
BREAK
ENDIF
WEND
arrayPush(stack, token)
ENDIF
NEXT
WHILE LENGTH(stack)
arrayPush(output, arrayPop(stack))
WEND
RESULT = SLICE(output)
FEND
ENDMODULE
//////////////////////////////////////////////////
// 【引数】
// num : 数値
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION decimalDigits(num)
DIM str = fixed(num)
RESULT = IIF(POS(".", str), LENGTH(BETWEENSTR(str, ".")), 0)
FEND
//////////////////////////////////////////////////
// 【引数】
// dec : 10進数
// signFlg : 符号付きならばTrueを指定
// digits : 変換した2進数の桁数合わせを自動で行うかを示すブール値、もしくは桁数を表す数値（8,16,24,32,64のいずれか）を指定
// errorMsg : エラーメッセージを出力するかを示すブール値
// 【戻り値】
// 2進数に変換した値
//////////////////////////////////////////////////
FUNCTION decToBin(dec, signFlg = FALSE, digits = FALSE, errorMsg = FALSE)
// 負数で符号なしならばエラー値を返す
IFB dec < 0 AND signFlg = FALSE THEN
PRINT "負数の場合signFlgにTrueを指定してください"
RESULT = ERR_VALUE
EXIT
ENDIF
// digitsのビット数が足りなければエラー値を返す、負数なら1桁多く取る
IFB VARTYPE(digits) <> VAR_BOOLEAN AND digits < CEIL(LOGN(2, ABS(dec))) + IIF(dec < 0, 1, 0) THEN
PRINT "ビット数が足りません"
RESULT = ERR_VALUE
EXIT
ENDIF
// signFlgがTrueかつdigitsがFalseならばエラー値を返す
IFB signFlg AND !digits THEN
PRINT "signFlgがTrueのときdigitsはFalse以外を選択してください"
RESULT = ERR_VALUE
EXIT
ENDIF
// bin：2進数に変換した結果を代入する変数
DIM bin = ""
DIM msg = ""
DIM isError = FALSE
DIM decimalFlg = IIF(POS(".", dec) <> 0, TRUE, FALSE)
DIM negativeFlg = IIF(dec < 0, TRUE, FALSE)
dec = ABS(dec)
// (1) 10進数を整数部と小数部に分ける
DIM integer = IIF(decimalFlg, COPY(dec, 1, POS(".", dec) - 1), dec)
DIM decimal = IIF(decimalFlg, "0." + COPY(dec, POS(".", dec) + 1), 0)
// (2) 10進数（整数部）を2進数に変換する。
REPEAT
bin = (integer MOD 2) + bin
integer = INT(integer / 2)
UNTIL integer = 0
// (3) 10進数（小数部）を2進数に変換する。
IFB decimalFlg THEN
bin = bin + "."
DIM loop = 0
REPEAT
loop = loop + 1
decimal = decimal * 2
bin = bin + IIF(decimal >= 1, "1", "0")
IF decimal > 1 THEN decimal = decimal - 1
UNTIL decimal = 1 OR loop > 64
ENDIF
// digitsがFALSE以外なら
IFB digits THEN
// (4) 2進数の桁合わせを行う
DIM tmp = bin
DIM binInteger = TOKEN(".", tmp)
DIM binDecimal = TOKEN(".", tmp)
// 整数部、小数部を4bit単位になるまで拡張
// 整数部、4の倍数になるまで整数部の先頭に'0'を追加
IF LENGTH(binInteger) MOD 4 <> 0 THEN binInteger = strRepeat("0", 4 - LENGTH(binInteger) MOD 4) + binInteger
// 小数部、4の倍数になるまで小数部の末尾に'0'を追加
IF LENGTH(binDecimal) MOD 4 <> 0 THEN binDecimal = binDecimal + strRepeat("0", 4 - LENGTH(binDecimal) MOD 4)
DIM digit = LENGTH(binInteger + binDecimal)
// 10進数の場合、一旦自動調整を行う
integer = INT(dec)
IF signFlg AND COPY(binInteger, 1, 1) = "1" THEN binInteger = strRepeat("0", 4) + binInteger
IFB signFlg THEN
IFB integer >= -128 AND integer <= 127 THEN // -2^7〜2^7-1
binInteger = strRepeat("0", 8 - LENGTH(binInteger)) + binInteger
ELSEIF integer >= -32768 AND integer <= 32767 THEN // -2^15〜2^15-1
binInteger = strRepeat("0", 16 - LENGTH(binInteger)) + binInteger
ELSEIF integer >= -8388608 AND integer <= 8388607 THEN // -2^23〜2^23-1
binInteger = strRepeat("0", 24 - LENGTH(binInteger)) + binInteger
ELSEIF integer >= -2147783648 AND integer <= 2147483647 THEN // -2^31〜2^31-1
binInteger = strRepeat("0", 32 - LENGTH(binInteger)) + binInteger
ELSE
binInteger = strRepeat("0", 64 - LENGTH(binInteger)) + binInteger
ENDIF
ELSE
IFB integer <= 255 THEN // 2^8-1
binInteger = strRepeat("0", 8 - LENGTH(binInteger)) + binInteger
ELSEIF integer <= 65535 THEN // 2^16-1
binInteger = strRepeat("0", 16 - LENGTH(binInteger)) + binInteger
ELSEIF integer <= 16777215 THEN // 2^24-1
binInteger = strRepeat("0", 24 - LENGTH(binInteger)) + binInteger
ELSEIF integer <= 4294967295 THEN // 2^32-1
binInteger = strRepeat("0", 32 - LENGTH(binInteger)) + binInteger
ELSE
binInteger = strRepeat("0", 64 - LENGTH(binInteger)) + binInteger
ENDIF
ENDIF
totalDigits = LENGTH(binInteger + binDecimal)
IFB totalDigits > 64 THEN
DIM del32 = totalDigits - 32
DIM del64 = totalDigits - 64
IFB del32 = LENGTH(binDecimal) AND digits <> 64 THEN
binDecimal = ""
msg = "32bitを超えたため、小数点以下を削除しました"
ELSEIF del32 < LENGTH(binDecimal) AND digits <> 64 THEN
binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - del32)
msg = "32bitを超えたため、小数点以下の一部を削除しました"
ELSEIF del64 = LENGTH(binDecimal) AND del64 <> 0 THEN
binDecimal = ""
msg = "64bitを超えたため、小数点以下を削除しました"
ELSEIF del64 < LENGTH(binDecimal) THEN
binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - del64)
msg = "64bitを超えたため、小数点以下の一部を削除しました"
ELSE
msg = "64bitを超えるため、変換できません"
isError = TRUE
ENDIF
ENDIF
// 整数部、小数部の合計桁数を8,16,24,32,64bit単位になるまで拡張
digit = LENGTH(binInteger + binDecimal)
DIM array[] = 8, 16, 24, 32, 64
FOR item IN array
IFB digit <= item THEN
binInteger = strRepeat("0", item - digit) + binInteger
BREAK
ENDIF
NEXT
// 指定ビットに調整
// 合計桁数の再設定
totalDigits = LENGTH(binInteger + binDecimal)
IFB digits = TRUE THEN
// 桁合わせを自動調整
IFB totalDigits > 64 THEN
len = LENGTH(binInteger + binDecimal)
WHILE LENGTH(binInteger) > 8 AND len > digits
IFB COPY(binInteger, 1, 4) = "0000" THEN
binInteger = COPY(binInteger, 5)
len = len - 4
ELSE
BREAK
ENDIF
WEND
WHILE LENGTH(binDecimal) > 4 AND LENGTH(binInteger + binDecimal) > digits
IFB COPY(binDecimal, LENGTH(binDecimal) - 4) = "0000" THEN
binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - 4)
ELSE
BREAK
ENDIF
WEND
tmp = binInteger + "." + binDecimal
binInteger = COPY(tmp, 1, POS(".", tmp) - 1)
binDecimal = COPY(tmp, POS(".", tmp) + 1)
totalDigits = LENGTH(binInteger + binDecimal)
IFB totalDigits > 64 THEN
isError = TRUE
msg = "64bitを超えたため変換できません"
ENDIF
ENDIF
ELSE
// 指定ビットに調整
IFB totalDigits <= digits THEN
binInteger = strPad(binInteger, digits - LENGTH(binDecimal), "0", LEFT)
ELSE
// 桁あふれ調整
totalDigits = LENGTH(binInteger + binDecimal)
len = LENGTH(binInteger + binDecimal)
WHILE LENGTH(binInteger) > 8 AND len > digits
IFB COPY(binInteger, 1, 4) = "0000" THEN
binInteger = COPY(binInteger, 5)
len = len - 4
ELSE
BREAK
ENDIF
WEND
WHILE LENGTH(binDecimal) > 4 AND LENGTH(binInteger + binDecimal) > digits
IFB COPY(binDecimal, LENGTH(binDecimal) - 4) = "0000" THEN
binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - 4)
ELSE
BREAK
ENDIF
WEND
tmp = binInteger + "." + binDecimal
binInteger = COPY(tmp, 1, POS(".", tmp) - 1)
binDecimal = COPY(tmp, POS(".", tmp) + 1)
len = LENGTH(binInteger + binDecimal)
IFB len > digits THEN
DIM deleteLength = len - digits
IFB deleteLength = LENGTH(binDecimal) THEN
binDecimal = ""
msg = "指定ビット数にするため小数点以下を削除しました"
ELSEIF deleteLength < LENGTH(binDecimal) THEN
binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - deleteLength)
msg = "指定ビット数にするため小数点以下の一部を削除しました"
ELSE
isError = TRUE
msg = "指定ビット数では変換できません"
ENDIF
ENDIF
ENDIF
ENDIF
bin = binInteger + IIF(binDecimal <> "", "." + binDecimal, "")
// (5) 入力値がマイナスのため、2進数をマイナス値に変換する
IFB negativeFlg THEN
// 1の補数
bin = bitNot(bin)
// 2の補数
DIM res = ""
DIM carry = "1"
FOR i = LENGTH(bin) TO 1 STEP -1
IFB carry = "1" THEN
SELECT COPY(bin, i, 1)
CASE "0"
res = "1" + res
carry = 0
CASE "1"
res = "0" + res
DEFAULT
res = COPY(bin, i, 1) + res
SELEND
ELSE
res = COPY(bin, i, 1) + res
ENDIF
NEXT
bin = res
ENDIF
ENDIF
IF errorMsg AND msg <> "" THEN PRINT msg
RESULT = IIF(isError, ERR_VALUE, bin)
FEND
//////////////////////////////////////////////////
// 【引数】
// dec : 10進数
// signFlg : 符号付きならばTrue
// digits : 変換した16進数の桁数合わせを自動で行うかを示すブール値、もしくは桁数を表す数値（8,16,24,32,64のいずれか）を指定
// errorMsg : エラーメッセージを出力するかを示すブール値
// 【戻り値】
// 16進数に変換した値
//////////////////////////////////////////////////
FUNCTION decToHex(dec, signFlg = FALSE, digits = FALSE, errorMsg = FALSE)
DIM hex = ""
DIM msg = ""
DIM isError = FALSE
DIM dec2hex[] = "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F"
DIM decimalFlg = IIF(POS(".", dec) <> 0, TRUE, FALSE)
DIM negativeFlg = IIF(dec < 0, TRUE, FALSE)
dec = Decimal.absoluteValue(dec)//dec = ABS(dec)
// (1) 10進数を整数部と小数部に分ける
DIM integer = Decimal.floor(dec)
DIM decimal = Decimal.modulo(dec, "1")
// (2) 10進数（整数部）を16進数に変換する。
REPEAT
hex = dec2hex[Decimal.modulo(integer, 16)] + hex
integer = Decimal.truncated(Decimal.dividedBy(integer, 16))
UNTIL Decimal.equals(integer, 0)
// (3) 10進数（小数部）を16進数に変換する。
IFB decimalFlg THEN
hex = hex + "."
DIM loop = 0
REPEAT
loop = loop + 1
decimal = Decimal.times(decimal, 16)
hex = hex + dec2hex[decimal]
offset = Decimal.toPower(10, LENGTH(decimal) - POS(".", decimal))
decimal = Decimal.dividedBy(Decimal.minus(Decimal.times(decimal, offset), Decimal.times(Decimal.truncated(decimal), offset)), offset)
UNTIL Decimal.equals(decimal, 0) OR loop > 16
ENDIF
// digitsがFALSE以外ならば
IFB digits THEN
// (4) 16進数の桁合わせを行う
DIM tmp = hex
DIM hexInteger = TOKEN(".", tmp)
DIM hexDecimal = TOKEN(".", tmp)
// 整数部、小数部を4bit単位になるまで拡張
// 整数部、4の倍数になるまで整数部の先頭に'0'を追加
// ※16進数は4bit単位なのでこの処理は不要
DIM digit = LENGTH(hexInteger + hexDecimal)
integer = Decimal.truncated(dec)
IF signFlg AND COPY(hexToBin(hexInteger), 1, 1) = "1" THEN hexInteger = "0" + hexInteger
IFB signFlg THEN
WITH Decimal
IFB .greaterThanOrEqualTo(integer, -128) AND .lessThanOrEqualTo(integer, 127) THEN // -2^7〜2^7-1
hexInteger = strRepeat("0", 2 - LENGTH(hexInteger)) + hexInteger
ELSEIF .greaterThanOrEqualTo(integer, -32768) AND .lessThanOrEqualTo(integer, 32767) THEN // -2^15〜2^15-1
hexInteger = strRepeat("0", 4 - LENGTH(hexInteger)) + hexInteger
ELSEIF .greaterThanOrEqualTo(integer, -8388608) AND .lessThanOrEqualTo(integer, 8388607) THEN // -2^23〜2^23-1
hexInteger = strRepeat("0", 6 - LENGTH(hexInteger)) + hexInteger
ELSEIF .greaterThanOrEqualTo(integer, -2147783648) AND .lessThanOrEqualTo(integer, 2147483647) THEN // -2^31〜2^31-1
hexInteger = strRepeat("0", 8 - LENGTH(hexInteger)) + hexInteger
ELSE
hexInteger = strRepeat("0", 16 - LENGTH(hexInteger)) + hexInteger
ENDIF
ENDWITH
ELSE
WITH Decimal
IFB .lessThanOrEqualTo(integer, 255) THEN // 2^8-1
hexInteger = strRepeat("0", 2 - LENGTH(hexInteger)) + hexInteger
ELSEIF .lessThanOrEqualTo(integer, 65535) THEN // 2^16-1
hexInteger = strRepeat("0", 4 - LENGTH(hexInteger)) + hexInteger
ELSEIF .lessThanOrEqualTo(integer, 16777215) THEN // 2^24-1
hexInteger = strRepeat("0", 6 - LENGTH(hexInteger)) + hexInteger
ELSEIF .lessThanOrEqualTo(integer, 4294967295) THEN // 2^32-1
hexInteger = strRepeat("0", 8 - LENGTH(hexInteger)) + hexInteger
ELSE
hexInteger = strRepeat("0", 16 - LENGTH(hexInteger)) + hexInteger
ENDIF
ENDWITH
ENDIF
totalDigits = LENGTH(hexInteger + hexDecimal) * 4
// 64bitを超えたら
IFB totalDigits > 64 THEN
DIM del32 = totalDigits - 32
DIM del64 = totalDigits - 64
IFB del32 = LENGTH(hexDecimal) * 4 AND digits <> 64 THEN
hexDecimal = ""
msg = "32bitを超えたため、小数点以下を削除しました"
ELSEIF del32 < LENGTH(hexDecimal) * 4 AND digits <> 64 THEN
hexDecimal = COPY(hexDecimal, 1, (LENGTH(hexDecimal) * 4 - del32) / 4)
msg = "32bitを超えたため、小数点以下の一部を削除しました"
ELSEIF del64 = LENGTH(hexDecimal) * 4 AND del64 <> 0 THEN
hexDecimal = ""
msg = "64bitを超えたため、小数点以下を削除しました"
ELSEIF del64 < LENGTH(hexDecimal) * 4 THEN
hexDecimal = COPY(hexDecimal, 1, (LENGTH(hexDecimal) * 4 - del64) / 4)
msg = "64bitを超えたため、小数点以下の一部を削除しました"
ELSE
isError = TRUE
msg = "64bitを超えるため、変換できません"
ENDIF
ENDIF
// 整数部、小数部の合計桁数を8,16,24,32,64bit単位になるまで拡張
digit = LENGTH(hexInteger + hexDecimal) * 4
DIM array[] = 8, 16, 24, 32, 64
FOR item IN array
IFB digit <= item THEN
hexInteger = strRepeat("0", (item - digit) / 4) + hexInteger
BREAK
ENDIF
NEXT
totalDigits = LENGTH(hexInteger + hexDecimal) * 4
IFB digits = TRUE THEN
// 桁合わせを自動調整
IFB totalDigits > 64 THEN
digit = LENGTH(hexInteger + hexDecimal)
WHILE LENGTH(hexInteger) > 8 AND digit > digits
IFB COPY(hexInteger, 1, 1) = "0" THEN
digit = digit - 1
ELSE
BREAK
ENDIF
WEND
WHILE LENGTH(hexDecimal) * 4 > 4 AND LENGTH(hexInteger + hexDecimal) > digits
IFB COPY(hexDecimal, LENGTH(hexDecimal) - 1) = "0" THEN
hexDecimal = COPY(hexDecimal, 1, LENGTH(hexDecimal) - 1)
ELSE
BREAK
ENDIF
WEND
tmp = hexInteger + "." + hexDecimal
hexInteger = COPY(tmp, 1, POS(".", tmp) - 1)
hexDecimal = COPY(tmp, POS(".", tmp) + 1)
totalDigits = LENGTH(hexInteger + hexDecimal)
IFB totalDigits > 64 THEN
isError = TRUE
msg = "64bitを超えたため変換できません"
ENDIF
ENDIF
ELSE
// 指定ビットに調整
IFB totalDigits <= digits THEN
hexInteger = strPad(hexInteger, digits / 4 - LENGTH(hexDecimal), "0", LEFT)
ELSE
// 桁あふれ調整
totalDigits = LENGTH(hexInteger + hexDecimal)
digit = LENGTH(hexInteger + hexDecimal)
WHILE LENGTH(hexInteger) * 4 > 8 AND digit > digits
IFB COPY(hexInteger, 1, 1) = "0" THEN
hexInteger = COPY(hexInteger, 2)
digit = digit - 4 / 4
ELSE
BREAK
ENDIF
WEND
WHILE LENGTH(hexDecimal) * 4 > 4 AND LENGTH(hexInteger + hexDecimal) > digits
IFB COPY(hexDecimal, LENGTH(hexDecimal) - 1) = "0" THEN
hexDecimal = COPY(hexDecimal, 1, LENGTH(hexDecimal) - 1)
ELSE
BREAK
ENDIF
WEND
tmp = hexInteger + "." + hexDecimal
hexInteger = COPY(tmp, 1, POS(".", tmp) - 1)
hexDecimal = COPY(tmp, POS(".", tmp) + 1)
digit = LENGTH(hexInteger + hexDecimal) * 4
IFB digit > digits THEN
DIM deleteLength = digit - digits
IFB deleteLength = LENGTH(hexDecimal) * 4 THEN
hexDecimal = ""
msg = "指定ビット数にするため小数点以下を削除しました"
ELSEIF deleteLength < LENGTH(hexDecimal) * 4 THEN
hexDecimal = COPY(hexDecimal, 1, LENGTH(hexDecimal) - deleteLength / 4)
msg = "指定ビット数にするため小数点以下の一部を削除しました"
ELSE
isError = TRUE
msg = "指定ビット数では変換できません"
ENDIF
ENDIF
ENDIF
ENDIF
hex = hexInteger + IIF(hexDecimal <> "", "." + hexDecimal, "")
// (5) 入力値がマイナスのため、16進数をマイナス値に変換する
IFB negativeFlg THEN
bin = hexToBin(hex)
// 1の補数
bin = bitNot(bin)
// 2の補数
DIM res = ""
DIM carry = "1"
FOR i = LENGTH(bin) TO 1 STEP -1
IFB carry = "1" THEN
SELECT COPY(bin, i, 1)
CASE "0"
res = "1" + res
carry = 0
CASE "1"
res = "0" + res
DEFAULT
res = COPY(bin, i, 1) + res
SELEND
ELSE
res = COPY(bin, i, 1) + res
ENDIF
NEXT
hex = binToHex(res)
ENDIF
ENDIF
IF errorMsg AND msg <> "" THEN PRINT msg
RESULT = IIF(isError, ERR_VALUE, hex)
FEND
//////////////////////////////////////////////////
// 【引数】
// dividend : 被除数
// divisor : 除数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION division(dividend, divisor)
DIM array[] = dividend, divisor
DIM g = GCD(array)
DIM tmp = divisor / g
DIM dat[] = 10, 5, 2
DIM position = 0
FOR i = 0 TO UBound(dat)
WHILE tmp MOD dat[i] = 0
tmp = INT(tmp / dat[i])
position = position + 1
WEND
NEXT
DIM repetend = ""
DIM res = ""
tmp = 0
i = 0
WHILE TRUE
DIM quotient = INT(dividend/divisor)
DIM remainder = dividend MOD divisor
IF i = position THEN tmp = remainder
IFB i > position THEN
repetend = repetend + quotient
ELSE
res = res + quotient
IF i = 0 THEN res = res + "."
ENDIF
IF i > position AND tmp = remainder THEN BREAK
dividend = remainder * 10
i = i + 1
WEND
RESULT = res + IIF(repetend<>0, "[" + repetend + "]", "")
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 相互変換させるバイナリデータ
// 【戻り値】
// 変換したバイナリデータ
//////////////////////////////////////////////////
FUNCTION Endian(str)
DIM len = LENGTH(str)
IFB !isEven(len) THEN
str = "0" + str
len = len + 1
ENDIF
DIM res = ""
FOR n = 1 TO len STEP 2
res = COPY(str, n, 2) + res
NEXT
RESULT = res
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 数値
// digits : 小数点以下の桁数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION fixed(num, digits = EMPTY)
num = VAL(num) // 指数表記を整える
IFB POS("E-", num) THEN
DIM mantissa = BETWEENSTR(num,, "E")
DIM exponent = BETWEENSTR(num, "E")
RESULT = "0." + strRepeat("0", VAL(ABS(exponent) - 1)) + REPLACE(mantissa, ".", "")
ELSEIF POS("E", num) THEN
RESULT = ROUND(num, -1 *digits)
mantissa = BETWEENSTR(num,, "E")
exponent = BETWEENSTR(num, "E")
RESULT = REPLACE(mantissa, ".", "") + strRepeat("0", VAL(exponent) - decimalDigits(mantissa))
ELSEIF LENGTH(BETWEENSTR(num, ".")) < digits THEN
DIM keta = digits - LENGTH(BETWEENSTR(num, "."))
RESULT = num + IIF(POS(".", num) OR keta = 0, "", ".") + strRepeat("0", keta)
ELSE
IF digits = EMPTY THEN digits = LENGTH(BETWEENSTR(num, "."))
RESULT = "" + roundOff(num, digits)
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 丸め処理を行う値
// 【戻り値】
// 負の方向に丸めた値
//////////////////////////////////////////////////
FUNCTION floor(num)
RESULT = INT(num) + IIF(num < 0 AND num <> INT(num), -1, 0)
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 最大公約数を求める数値を格納した配列
// 【戻り値】
// 最大公約数
//////////////////////////////////////////////////
FUNCTION GCD(array[])
DIM c = LENGTH(array)
DIM rem = array[c-1] MOD array[c-2]
IFB rem = 0 THEN
IFB LENGTH(array) = 2 THEN
RESULT = array[c-2]
EXIT
ENDIF
RESIZE(array, c-2)
RESULT = GCD(array)
EXIT
ENDIF
array[c-1] = array[c-2]
array[c-2] = rem
RESULT = GCD(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// path : ビットマップ画像のパス
// 【戻り値】
// 配列。0:サイズ（Byte）、1:幅（px）、2:高さ（px）、3:ビットの深さ（bit）
//////////////////////////////////////////////////
FUNCTION getBitmap(path)
CONST adTypeBinary = 1
DIM array[3]
DIM Stream = CREATEOLEOBJ("ADODB.Stream")
Stream.Open()
Stream.Type = adTypeBinary
Stream.LoadFromFile(path)
DIM tmp = Stream.Read(30)
Stream.Close()
DIM fmt = ""
FOR i = 0 TO 1
fmt = fmt + decToHex(tmp[i])
NEXT
IFB fmt <> "424D" THEN
RESULT = ERR_VALUE
EXIT
ENDIF
DIM size = ""
FOR i = 2 TO 5
hex = decToHex(tmp[i], FALSE)
size = size + IIF(LENGTH(hex) = 1, "0", "") + hex
NEXT
array[0] = hexToDec(Endian(size))
DIM width = ""
FOR i = 18 TO 21
hex = decToHex(tmp[i], FALSE)
width = width + IIF(LENGTH(hex) = 1, "0", "") + hex
NEXT
array[1] = hexToDec(Endian(width))
DIM height = ""
FOR i = 22 TO 25
hex = decToHex(tmp[i], FALSE)
height = height + IIF(LENGTH(hex) = 1, "0", "") + hex
NEXT
array[2] = hexToDec(Endian(height))
DIM bit = ""
FOR i = 28 TO 29
hex = decToHex(tmp[i], FALSE)
bit = bit + IIF(LENGTH(hex) = 1, "0", "") + hex
NEXT
array[3] = hexToDec(Endian(bit))
RESULT = SLICE(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）
// m : 第一引数の指定日からプラスマイナスm月とする
// 【戻り値】
// dateからm月後の月末の日付
//////////////////////////////////////////////////
FUNCTION getEndOfMonth(date, m = 0)
date = dateAdd("m", m + 1, date)
GETTIME(0, date)
GETTIME(-G_TIME_DD, date)
RESULT = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付文字列（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）もしくはシリアル値
// type : 取得する曜日番号の種類を示す0〜3または11〜17の値。1と17は日曜日を1、2と11は月曜日を1とカウントします。11以降はExcel2010で追加された値で、互換性を保つために重複した値があります。
// 【戻り値】
// typeで指定した種類によって以下の値を返します。 : （0 : 0(日曜)〜6(土曜)、1 : 1(日曜)～7(土曜)、2 : 1(月曜)～7(日曜)、3 : 0(月曜)〜6(日曜)、11 : 1(月曜)～7(日曜)、12 : 1(火曜)～7(月曜)、13 : 1(水曜)～7(火曜)、14 : 1(木曜)～7(水曜)、15 : 1(金曜)～7(木曜)、16 : 1(土曜)～7(金曜)、17 : 1(日曜)～7(土曜)）
//////////////////////////////////////////////////
FUNCTION getWeekday(date, type = 1)
IF VARTYPE(date) <> 258 THEN date = text(date, "yyyy/mm/dd")
GETTIME(0, date)
DIM w = G_TIME_WW
SELECT TRUE
CASE type = 0
RESULT = w
CASE type = 1
RESULT = w + 1
CASE type = 2
RESULT = IIF(w=0, 7, w)
CASE type = 3
RESULT = (w+6) MOD 7
CASE type >= 11
RESULT = ((getWeekday(date, 2) + 17 - type) MOD 7) + 1
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// str : ハッシュ化する文字列
// 【戻り値】
// ハッシュ化した文字列
//////////////////////////////////////////////////
MODULE Hash
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM path
PROCEDURE Hash()
CONST TemporaryFolder = 2
DIM Folder = FSO.GetSpecialFolder(TemporaryFolder)
DIM folderspec = Folder.Path
DIM filename = FSO.GetTempName
path = FSO.BuildPath(folderspec, filename)
FEND
FUNCTION md2(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD2 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION md4(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD4 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION md5(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD5 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha1(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA1 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha256(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA256 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha384(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA384 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha512(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA512 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
ENDMODULE
//////////////////////////////////////////////////
// 【引数】
// hex : 16進数
// 【戻り値】
// 2進数に変換した値
//////////////////////////////////////////////////
FUNCTION hexToBin(hex)
HASHTBL hb
hb["0"] = "0000"; hb["1"] = "0001"; hb["2"] = "0010"; hb["3"] = "0011";
hb["4"] = "0100"; hb["5"] = "0101"; hb["6"] = "0110"; hb["7"] = "0111";
hb["8"] = "1000"; hb["9"] = "1001"; hb["A"] = "1010"; hb["B"] = "1011";
hb["C"] = "1100"; hb["D"] = "1101"; hb["E"] = "1110"; hb["F"] = "1111";
DIM bin = ""
IFB POS(".", hex) <> 0 THEN
FOR i = 1 TO LENGTH(hex)
DIM str = COPY(hex, i, 1)
IF str = "." THEN bin = bin + "."
bin = bin + hb[str]
NEXT
ELSE
FOR i = 1 TO LENGTH(hex)
bin = bin + hb[COPY(hex, i, 1)]
NEXT
ENDIF
RESULT = bin
FEND
//////////////////////////////////////////////////
// 【引数】
// hex : 16進数
// signFlg : 符号付きならばTrue
// 【戻り値】
// 10進数に変換した値
//////////////////////////////////////////////////
FUNCTION hexToDec(hex, signFlg = TRUE)
hex = STRCONV(hex, SC_UPPERCASE)
DIM dec = 0
DIM decimalFlg = IIF(POS(".", hex) <> 0, TRUE, FALSE)
hex = IIF(LENGTH(REPLACE(hex,".", "" )) MOD 2 <> 0, "0", "") + hex
DIM negativeFlg = IIF(COPY(hexToBin(hex), 1, 1) = "1", TRUE, FALSE)
DIM sign = 1
IF negativeFlg AND signFlg THEN sign = -1
IFB negativeFlg AND signFlg THEN
DIM bin = hexToBin(hex)
DIM msb = IIF(decimalFlg, POS(".", bin) - 1, LENGTH(bin))
DIM lsb = IIF(decimalFlg, POS(".", bin) - LENGTH(bin), 0)
DIM a = hexToDec(hex, FALSE)
DIM b = POWER(2, msb) - 1
FOR i = -1 TO lsb STEP -1
b = b + POWER(2, i)
NEXT
DIM dec2 = bitXor(a, b) + POWER(2, lsb)
hex = decToHex(dec2)
ENDIF
integer = IIF(decimalFlg, COPY(hex, 1, POS(".", hex) - 1), hex)
decimal = IIF(decimalFlg, COPY(hex, POS(".", hex) + 1), "0")
FOR i = 1 TO LENGTH(integer)
s = COPY(hex, i, 1)
num = IIF(CHKNUM(s), s, ASC(s) - (ASC("A") - 10))
dec = dec + num * POWER(16, LENGTH(integer) - i)
NEXT
FOR i = 1 TO LENGTH(decimal)
s = COPY(decimal, i, 1)
num = IIF(CHKNUM(s), s, ASC(s) - (ASC("A") - 10))
dec = dec + num * POWER(16, -1 * i)
NEXT
RESULT = sign * dec
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : シリアル値もしくは時刻文字列
// 【戻り値】
// 時刻から時間を表す0〜23の範囲の値
//////////////////////////////////////////////////
FUNCTION Hour(serial)
IF VARTYPE(serial) = 258 THEN serial = timeValue(serial)
RESULT = INT(serial * 24) MOD 24
FEND
//////////////////////////////////////////////////
// 【引数】
// expr : 評価する式
// truepart : 評価した式がTrueのときに返す値
// falsepart : 評価した式がFalseのときに返す値
// 【戻り値】
// truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき
//////////////////////////////////////////////////
FUNCTION IIF(expr, truepart, falsepart)
IFB EVAL(expr) THEN
RESULT = truepart
ELSE
RESULT = falsepart
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// variable : 型を調べる変数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION isArray(variable[])
RESULT = IIF(VARTYPE(variable) AND 8192, TRUE, FALSE)
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 存在するかを調べる日付文字列。YYYYMMDD or YYYY/MM/DD or YYYY-MM-DDのいずれかの形式。
// 【戻り値】
// TRUE : 日付として認識できる、FALSE : 日付として認識できない
//////////////////////////////////////////////////
FUNCTION isDate(date)
TRY
GETTIME(0, date)
RESULT = TRUE
EXCEPT
RESULT = FALSE
ENDTRY
FEND
//////////////////////////////////////////////////
// 【引数】
// 数値 : 整数
// 【戻り値】
// True : 偶数、False : 偶数以外の数値、ERR_VALUE : 数値以外
//////////////////////////////////////////////////
FUNCTION isEven(n)
IFB VAL(n) = n THEN
RESULT = IIF(INT(n) MOD 2 = 0, TRUE, FALSE)
ELSE
RESULT = ERR_VALUE
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// variable : 型を調べる変数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION isFloat(variable)
IFB VAL(variable) <> ERR_VALUE THEN
RESULT = IIF((VARTYPE(variable) = VAR_SINGLE OR VARTYPE(variable) = VAR_DOUBLE) AND INT(variable) <> variable, TRUE, FALSE)
ELSE
RESULT = FALSE
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// variable : 型を調べる変数
// 【戻り値】
// : TRUE : 与えられた変数が文字列型である、
// FALSE : 与えられた変数が文字列型でない、 :
//////////////////////////////////////////////////
FUNCTION isString(variable)
RESULT = IIF(VARTYPE(variable) = VAR_ASTR OR VARTYPE(variable) = VAR_USTR, TRUE, FALSE)
FEND
//////////////////////////////////////////////////
// 【引数】
// text : JSONとして解析する文字列
// value : JSON文字列に変換する値
// reviver : 使用不可
// replacer : 使用不可
// space : 出力するJSON文字列に空白を挿入するための文字列もしくは数値
// 【戻り値】
// : Parse : JSON文字列をオブジェクトに変換、
// Stringify : オブジェクトをJSON文字列に変換、 :
//////////////////////////////////////////////////
MODULE JSON
DIM SC, CodeObject
PROCEDURE JSON
SC = CREATEOLEOBJ("ScriptControl")
WITH SC
.Language = "JScript"
.ExecuteStatement(json2)
.ExecuteStatement(statement)
CodeObject = .CodeObject
ENDWITH
FEND
FUNCTION Parse(text, reviver = NULL)
RESULT = CodeObject.JSON.parse(text, reviver)
FEND
FUNCTION Stringify(value, replacer = "", space = FALSE)
RESULT = CodeObject.JSON.stringify(value, NULL, replacer)
IF space THEN RESULT = REPLACE(RESULT, CHR(10), "<#CR>")
FEND
ENDMODULE
TEXTBLOCK statement
Array.prototype.Item = function(i, value){
if(value === undefined) return this[i]; this[i] = value;
}
Array.prototype.item = Array.prototype.Item;
ENDTEXTBLOCK
TEXTBLOCK json2
// json2.js
// 2023-05-10
// Public Domain.
// NO WARRANTY EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
// USE YOUR OWN COPY. IT IS EXTREMELY UNWISE TO LOAD CODE FROM SERVERS YOU DO
// NOT CONTROL.
// This file creates a global JSON object containing two methods: stringify
// and parse. This file provides the ES5 JSON capability to ES3 systems.
// If a project might run on IE8 or earlier, then this file should be included.
// This file does nothing on ES5 systems.
// JSON.stringify(value, replacer, space)
// value any JavaScript value, usually an object or array.
// replacer an optional parameter that determines how object
// values are stringified for objects. It can be a
// function or an array of strings.
// space an optional parameter that specifies the indentation
// of nested structures. If it is omitted, the text will
// be packed without extra whitespace. If it is a number,
// it will specify the number of spaces to indent at each
// level. If it is a string (such as "\t" or " "),
// it contains the characters used to indent at each level.
// This method produces a JSON text from a JavaScript value.
// When an object value is found, if the object contains a toJSON
// method, its toJSON method will be called and the result will be
// stringified. A toJSON method does not serialize: it returns the
// value represented by the name/value pair that should be serialized,
// or undefined if nothing should be serialized. The toJSON method
// will be passed the key associated with the value, and this will be
// bound to the value.
// For example, this would serialize Dates as ISO strings.
// Date.prototype.toJSON = function (key) {
// function f(n) {
// // Format integers to have at least two digits.
// return (n < 10)
// ? "0" + n
// : n;
// }
// return this.getUTCFullYear() + "-" +
// f(this.getUTCMonth() + 1) + "-" +
// f(this.getUTCDate()) + "T" +
// f(this.getUTCHours()) + ":" +
// f(this.getUTCMinutes()) + ":" +
// f(this.getUTCSeconds()) + "Z";
// };
// You can provide an optional replacer method. It will be passed the
// key and value of each member, with this bound to the containing
// object. The value that is returned from your method will be
// serialized. If your method returns undefined, then the member will
// be excluded from the serialization.
// If the replacer parameter is an array of strings, then it will be
// used to select the members to be serialized. It filters the results
// such that only members with keys listed in the replacer array are
// stringified.
// Values that do not have JSON representations, such as undefined or
// functions, will not be serialized. Such values in objects will be
// dropped; in arrays they will be replaced with null. You can use
// a replacer function to replace those with JSON values.
// JSON.stringify(undefined) returns undefined.
// The optional space parameter produces a stringification of the
// value that is filled with line breaks and indentation to make it
// easier to read.
// If the space parameter is a non-empty string, then that string will
// be used for indentation. If the space parameter is a number, then
// the indentation will be that many spaces.
// Example:
// text = JSON.stringify(["e", {pluribus: "unum"}]);
// // text is '["e",{"pluribus":"unum"}]'
// text = JSON.stringify(["e", {pluribus: "unum"}], null, "\t");
// // text is '[\n\t"e",\n\t{\n\t\t"pluribus": "unum"\n\t}\n]'
// text = JSON.stringify([new Date()], function (key, value) {
// return this[key] instanceof Date
// ? "Date(" + this[key] + ")"
// : value;
// });
// // text is '["Date(---current time---)"]'
// JSON.parse(text, reviver)
// This method parses a JSON text to produce an object or array.
// It can throw a SyntaxError exception.
// The optional reviver parameter is a function that can filter and
// transform the results. It receives each of the keys and values,
// and its return value is used instead of the original value.
// If it returns what it received, then the structure is not modified.
// If it returns undefined then the member is deleted.
// Example:
// // Parse the text. Values that look like ISO date strings will
// // be converted to Date objects.
// myData = JSON.parse(text, function (key, value) {
// var a;
// if (typeof value === "string") {
// a =
// /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2}(?:\.\d*)?)Z$/.exec(value);
// if (a) {
// return new Date(Date.UTC(
// +a[1], +a[2] - 1, +a[3], +a[4], +a[5], +a[6]
// ));
// }
// return value;
// }
// });
// myData = JSON.parse(
// "[\"Date(09/09/2001)\"]",
// function (key, value) {
// var d;
// if (
// typeof value === "string"
// && value.slice(0, 5) === "Date("
// && value.slice(-1) === ")"
// ) {
// d = new Date(value.slice(5, -1));
// if (d) {
// return d;
// }
// }
// return value;
// }
// );
// This is a reference implementation. You are free to copy, modify, or
// redistribute.
/*jslint
eval, for, this
*/
/*property
JSON, apply, call, charCodeAt, getUTCDate, getUTCFullYear, getUTCHours,
getUTCMinutes, getUTCMonth, getUTCSeconds, hasOwnProperty, join,
lastIndex, length, parse, prototype, push, replace, slice, stringify,
test, toJSON, toString, valueOf
*/
// Create a JSON object only if one does not already exist. We create the
// methods in a closure to avoid creating global variables.
if (typeof JSON !== "object") {
JSON = {};
}
(function () {
"use strict";
var rx_one = /^[\],:{}\s]*$/;
var rx_two = /\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g;
var rx_three = /"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g;
var rx_four = /(?:^|:|,)(?:\s*\[)+/g;
var rx_escapable = /[\\"\u0000-\u001f\u007f-\u009f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g;
var rx_dangerous = /[\u0000\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g;
function f(n) {
// Format integers to have at least two digits.
return (n < 10)
? "0" + n
: n;
}
function this_value() {
return this.valueOf();
}
if (typeof Date.prototype.toJSON !== "function") {
Date.prototype.toJSON = function () {
return isFinite(this.valueOf())
? (
this.getUTCFullYear()
+ "-"
+ f(this.getUTCMonth() + 1)
+ "-"
+ f(this.getUTCDate())
+ "T"
+ f(this.getUTCHours())
+ ":"
+ f(this.getUTCMinutes())
+ ":"
+ f(this.getUTCSeconds())
+ "Z"
)
: null;
};
Boolean.prototype.toJSON = this_value;
Number.prototype.toJSON = this_value;
String.prototype.toJSON = this_value;
}
var gap;
var indent;
var meta;
var rep;
function quote(string) {
// If the string contains no control characters, no quote characters, and no
// backslash characters, then we can safely slap some quotes around it.
// Otherwise we must also replace the offending characters with safe escape
// sequences.
rx_escapable.lastIndex = 0;
return rx_escapable.test(string)
? "\"" + string.replace(rx_escapable, function (a) {
var c = meta[a];
return typeof c === "string"
? c
: "\\u" + ("0000" + a.charCodeAt(0).toString(16)).slice(-4);
}) + "\""
: "\"" + string + "\"";
}
function str(key, holder) {
// Produce a string from holder[key].
var i; // The loop counter.
var k; // The member key.
var v; // The member value.
var length;
var mind = gap;
var partial;
var value = holder[key];
// If the value has a toJSON method, call it to obtain a replacement value.
if (
value
&& typeof value === "object"
&& typeof value.toJSON === "function"
) {
value = value.toJSON(key);
}
// If we were called with a replacer function, then call the replacer to
// obtain a replacement value.
if (typeof rep === "function") {
value = rep.call(holder, key, value);
}
// What happens next depends on the value's type.
switch (typeof value) {
case "string":
return quote(value);
case "number":
// JSON numbers must be finite. Encode non-finite numbers as null.
return (isFinite(value))
? String(value)
: "null";
case "boolean":
case "null":
// If the value is a boolean or null, convert it to a string. Note:
// typeof null does not produce "null". The case is included here in
// the remote chance that this gets fixed someday.
return String(value);
// If the type is "object", we might be dealing with an object or an array or
// null.
case "object":
// Due to a specification blunder in ECMAScript, typeof null is "object",
// so watch out for that case.
if (!value) {
return "null";
}
// Make an array to hold the partial results of stringifying this object value.
gap += indent;
partial = [];
// Is the value an array?
if (Object.prototype.toString.apply(value) === "[object Array]") {
// The value is an array. Stringify every element. Use null as a placeholder
// for non-JSON values.
length = value.length;
for (i = 0; i < length; i += 1) {
partial[i] = str(i, value) || "null";
}
// Join all of the elements together, separated with commas, and wrap them in
// brackets.
v = partial.length === 0
? "[]"
: gap
? (
"[\n"
+ gap
+ partial.join(",\n" + gap)
+ "\n"
+ mind
+ "]"
)
: "[" + partial.join(",") + "]";
gap = mind;
return v;
}
// If the replacer is an array, use it to select the members to be stringified.
if (rep && typeof rep === "object") {
length = rep.length;
for (i = 0; i < length; i += 1) {
if (typeof rep[i] === "string") {
k = rep[i];
v = str(k, value);
if (v) {
partial.push(quote(k) + (
(gap)
? ": "
: ":"
) + v);
}
}
}
} else {
// Otherwise, iterate through all of the keys in the object.
for (k in value) {
if (Object.prototype.hasOwnProperty.call(value, k)) {
v = str(k, value);
if (v) {
partial.push(quote(k) + (
(gap)
? ": "
: ":"
) + v);
}
}
}
}
// Join all of the member texts together, separated with commas,
// and wrap them in braces.
v = partial.length === 0
? "{}"
: gap
? "{\n" + gap + partial.join(",\n" + gap) + "\n" + mind + "}"
: "{" + partial.join(",") + "}";
gap = mind;
return v;
}
}
// If the JSON object does not yet have a stringify method, give it one.
if (typeof JSON.stringify !== "function") {
meta = { // table of character substitutions
"\b": "\\b",
"\t": "\\t",
"\n": "\\n",
"\f": "\\f",
"\r": "\\r",
"\"": "\\\"",
"\\": "\\\\"
};
JSON.stringify = function (value, replacer, space) {
// The stringify method takes a value and an optional replacer, and an optional
// space parameter, and returns a JSON text. The replacer can be a function
// that can replace values, or an array of strings that will select the keys.
// A default replacer method can be provided. Use of the space parameter can
// produce text that is more easily readable.
var i;
gap = "";
indent = "";
// If the space parameter is a number, make an indent string containing that
// many spaces.
if (typeof space === "number") {
for (i = 0; i < space; i += 1) {
indent += " ";
}
// If the space parameter is a string, it will be used as the indent string.
} else if (typeof space === "string") {
indent = space;
}
// If there is a replacer, it must be a function or an array.
// Otherwise, throw an error.
rep = replacer;
if (replacer && typeof replacer !== "function" && (
typeof replacer !== "object"
|| typeof replacer.length !== "number"
)) {
throw new Error("JSON.stringify");
}
// Make a fake root object containing our value under the key of "".
// Return the result of stringifying the value.
return str("", {"": value});
};
}
// If the JSON object does not yet have a parse method, give it one.
if (typeof JSON.parse !== "function") {
JSON.parse = function (text, reviver) {
// The parse method takes a text and an optional reviver function, and returns
// a JavaScript value if the text is a valid JSON text.
var j;
function walk(holder, key) {
// The walk method is used to recursively walk the resulting structure so
// that modifications can be made.
var k;
var v;
var value = holder[key];
if (value && typeof value === "object") {
for (k in value) {
if (Object.prototype.hasOwnProperty.call(value, k)) {
v = walk(value, k);
if (v !== undefined) {
value[k] = v;
} else {
delete value[k];
}
}
}
}
return reviver.call(holder, key, value);
}
// Parsing happens in four stages. In the first stage, we replace certain
// Unicode characters with escape sequences. JavaScript handles many characters
// incorrectly, either silently deleting them, or treating them as line endings.
text = String(text);
rx_dangerous.lastIndex = 0;
if (rx_dangerous.test(text)) {
text = text.replace(rx_dangerous, function (a) {
return (
"\\u"
+ ("0000" + a.charCodeAt(0).toString(16)).slice(-4)
);
});
}
// In the second stage, we run the text against regular expressions that look
// for non-JSON patterns. We are especially concerned with "()" and "new"
// because they can cause invocation, and "=" because it can cause mutation.
// But just to be safe, we want to reject all unexpected forms.
// We split the second stage into 4 regexp operations in order to work around
// crippling inefficiencies in IE's and Safari's regexp engines. First we
// replace the JSON backslash pairs with "@" (a non-JSON character). Second, we
// replace all simple value tokens with "]" characters. Third, we delete all
// open brackets that follow a colon or comma or that begin the text. Finally,
// we look to see that the remaining characters are only whitespace or "]" or
// "," or ":" or "{" or "}". If that is so, then the text is safe for eval.
if (
rx_one.test(
text
.replace(rx_two, "@")
.replace(rx_three, "]")
.replace(rx_four, "")
)
) {
// In the third stage we use the eval function to compile the text into a
// JavaScript structure. The "{" operator is subject to a syntactic ambiguity
// in JavaScript: it can begin a block or an object literal. We wrap the text
// in parens to eliminate the ambiguity.
j = eval("(" + text + ")");
// In the optional fourth stage, we recursively walk the new structure, passing
// each name/value pair to a reviver function for possible transformation.
return (typeof reviver === "function")
? walk({"": j}, "")
: j;
}
// If the text is not JSON parseable, then a SyntaxError is thrown.
throw new SyntaxError("JSON.parse");
};
}
}());
ENDTEXTBLOCK
//////////////////////////////////////////////////
// 【引数】
// array : 配列
// rank : 抽出する値の大きい方から数えた順位
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION large(array[], rank)
IFB rank >= 1 AND rank <= LENGTH(array) THEN
shellSort(array)
RESULT = array[LENGTH(array) - rank]
ELSE
RESULT = ERR_VALUE
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
//
// 【戻り値】
// 現在の日時
//////////////////////////////////////////////////
FUNCTION now()
GETTIME()
DIM datetime = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2
RESULT = (GETTIME(0, datetime) - GETTIME(0, "1899/12/30")) / 86400
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 正規表現による検索の対象となる文字列
// Pattern : 正規表現で使用するパターンを設定
// IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse
// Global : 文字列全体を検索する場合はTrue、しない場合はFalse
// 【戻り値】
// 正規表現で検索した結果をMatchesコレクションとして返します。
//////////////////////////////////////////////////
FUNCTION reExecute(str, Pattern, IgnoreCase = TRUE, Global = TRUE)
DIM re = CREATEOLEOBJ("VBScript.RegExp")
re.Pattern = Pattern
re.IgnoreCase = IgnoreCase
re.Global = Global
RESULT = re.Execute(str)
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 正規表現による検索の対象となる文字列
// Pattern : 正規表現で使用するパターンを設定
// IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse
// Global : 文字列全体を検索する場合はTrue、しない場合はFalse
// 【戻り値】
// 正規表現にマッチするかどうかを示すブール値
//////////////////////////////////////////////////
FUNCTION reTest(str, Pattern, IgnoreCase = TRUE, Global = TRUE)
DIM re = CREATEOLEOBJ("VBScript.RegExp")
re.Pattern = Pattern
re.IgnoreCase = IgnoreCase
re.Global = Global
RESULT = re.Test(str)
FEND
//////////////////////////////////////////////////
// 【引数】
// r : 赤成分もしくは#RRGGBB形式の文字列
// g : 緑成分。rで#RRGGBB形式の文字列を指定した場合は省略。
// b : 青成分。rで#RRGGBB形式の文字列を指定した場合は省略。
// 【戻り値】
// Color値
//////////////////////////////////////////////////
FUNCTION RGBToColor(r, g = EMPTY, b = EMPTY)
IFB COPY(r, 1, 1) = "#" THEN
DIM color = 0
FOR i = 1 TO 3
color = color + VAL(hexToDec(COPY(r, i * 2, 2), FALSE)) * POWER(256, i - 1)
NEXT
RESULT = color
ELSE
RESULT = r + g * 256 + b * 65536
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 数値
// digit : 四捨五入する位置（マイナスで整数方向）
// 【戻り値】
// 四捨五入した値
//////////////////////////////////////////////////
FUNCTION roundOff(num, digit = 0)
DIM sign = sign(num)
num = ABS(num)
DIM offset = POWER(10, digit)
DIM n = num * offset - INT(num * offset)
RESULT = sign * IIF(n >= 0.5, CEIL(num * offset) / offset, INT(num * offset) / offset)
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : 時間を表すシリアル値を指定
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION Second(serial)
RESULT = REPLACE(FORMAT(INT(serial * 86400) MOD 60, 2), " ", "0")
FEND
//////////////////////////////////////////////////
// 【引数】
// array : ソートする数値を格納した配列。参照引数。
// 【戻り値】
//
//////////////////////////////////////////////////
PROCEDURE shellSort(Var array[])
DIM i, j, inc, temp
inc = 4
WHILE INT(inc) > 0
FOR i = 0 TO UBound(array)
j = i
temp = array[i]
WHILE j >= inc AND array[zcut(j-inc)] > temp
array[j] = array[j-inc]
j = j - inc
WEND
array[j] = temp
NEXT
IFB inc / 2 <> 0 THEN
inc = inc / 2
ELSEIF inc = 1 THEN
inc = 0
ELSE
inc = 1
ENDIF
WEND
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 符号を求める数値
// 【戻り値】
// 1 : 正の数、0 : ゼロ、-1 : 負の数、ERR_VALUE : それ以外
//////////////////////////////////////////////////
FUNCTION sign(num)
SELECT TRUE
CASE !CHKNUM(num)
RESULT = ERR_VALUE
CASE num > 0
RESULT = 1
CASE num = 0
RESULT = 0
CASE num < 0
RESULT = -1
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 配列
// rank : 抽出する値の小さい方から数えた順位
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION small(array[], rank)
IFB rank >= 1 AND rank <= LENGTH(array) THEN
shellSort(array)
RESULT = array[rank-1]
ELSE
RESULT = ERR_VALUE
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// input : 入力文字列
// length : 埋めたあとの長さ
// str : 埋める文字
// type : 埋める方向
// 【戻り値】
// 指定文字で埋めた文字列
//////////////////////////////////////////////////
FUNCTION strPad(input, length, str = " ", type = RIGHT)
DIM s = ""
SELECT type
CASE LEFT
FOR i = 1 TO CEIL((length - LENGTH(input)) / LENGTH(str))
s = s + str
NEXT
input = COPY(s, 1, length - LENGTH(input)) + input
CASE RIGHT
FOR i = 1 TO CEIL((length - LENGTH(input)) / LENGTH(str))
s = s + str
NEXT
input = input + COPY(s, 1, length - LENGTH(input))
SELEND
RESULT = input
FEND
//////////////////////////////////////////////////
// 【引数】
// inputs : 繰り返す文字列
// multiplier : inputsを繰り返す回数
// 【戻り値】
// inputsをmultiplier回を繰り返した文字列を返します
//////////////////////////////////////////////////
FUNCTION strRepeat(inputs, multiplier)
DIM res = ""
FOR n = 1 TO multiplier
res = res + inputs
NEXT
RESULT = res
FEND
//////////////////////////////////////////////////
// 【引数】
// a : bと交換する値。参照引数。
// b : aと交換する値。参照引数。
// 【戻り値】
//
//////////////////////////////////////////////////
PROCEDURE swap(Var a, Var b)
DIM tmp = a
a = b
b = tmp
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : シリアル値
// format : フォーマット
// 【戻り値】
// 数値を表示書式に基づいて変換した文字列
//////////////////////////////////////////////////
FUNCTION text(serial, format, hour12 = FALSE)
HASHTBL startDate
startDate["明治"] = "1868/01/25"
startDate["大正"] = "1912/07/30"
startDate["昭和"] = "1926/12/25"
startDate["平成"] = "1989/01/08"
startDate["令和"] = "2019/05/01"
DIM baseDate = "1899/12/30"
serial = VAL(serial)
SELECT TRUE
CASE reTest(format, "\[h+\]")
Matches = reExecute(format, "\[(h+)\]")
DIM hour = iif(hour12, Hour(serial) MOD 12, Hour(serial))
RESULT = text(hour, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE reTest(format, "^h+$")
Matches = reExecute(format, "^(h+)$")
hour = iif(hour12, Hour(serial) MOD 12, Hour(serial))
RESULT = text(hour MOD 24, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE reTest(format, "\[m+\]")
Matches = reExecute(format, "\[(m+)\]")
RESULT = text(serial * 1440, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE format = "m"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_MM, "0")
CASE format = "mm"
GETTIME(serial, baseDate)
RESULT = G_TIME_MM2
CASE format = "n"
GETTIME(serial, baseDate)
RESULT = G_TIME_NN
CASE format = "nn"
GETTIME(serial, baseDate)
RESULT = G_TIME_NN2
CASE format = "s"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_SS, "0")
CASE format = "ss"
GETTIME(serial, baseDate)
RESULT = G_TIME_SS2
CASE format = "yyyy"
GETTIME(serial, baseDate)
RESULT = G_TIME_YY4
CASE format = "yy"
GETTIME(serial, baseDate)
RESULT = COPY(G_TIME_YY4, 3, 2)
CASE format = "e"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 2018
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1988
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1925
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1911
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1867
SELEND
CASE format = "ee"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 2018, "00")
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1988, "00")
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1925, "00")
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1911, "00")
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1867, "00")
SELEND
CASE format = "g"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "R"
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "H"
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "S"
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "T"
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "M"
SELEND
CASE format = "gg"
RESULT = COPY(text(serial, "ggg"), 1, 1)
CASE format = "ggg"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "令和"
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "平成"
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "昭和"
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "大正"
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "明治"
SELEND
CASE format = "mmmmm"
RESULT = COPY(text(serial, "mmmm"), 1, 1)
CASE format = "mmmm"
DIM month[] = "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"
RESULT = month[text(serial, "m") - 1]
CASE format = "mmm"
RESULT = COPY(text(serial, "mmmm"), 1, 3)
CASE format = "dd"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_DD2, "00")
CASE format = "d"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_DD, "0")
CASE reTest(format, "^[ad]{3,4}$")
Matches = reExecute(format, "([ad]{3,4})")
GETTIME(serial, baseDate)
DIM aaa[] = "日", "月", "火", "水", "木", "金", "土"
DIM aaaa[] = "日曜日", "月曜日", "火曜日", "水曜日", "木曜日", "金曜日", "土曜日"
DIM ddd[] = "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"
DIM dddd[] = "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday";
RESULT = EVAL(Matches.Item(0).SubMatches(0) + "[" + getWeekday(G_TIME_WW, 1) + "]")
CASE reTest(format, "(0+\.?0+)?%")
Matches = reExecute(format, "(0+\.?0+)?%")
RESULT = text(serial * 100, Matches.Item(0).SubMatches(0)) + "%"
CASE reTest(format, "^\[DBNum\d{1,4}\](.*?)$")
Matches = reExecute(format, "^\[DBNum(\d{1,4})\](.*?)$")
DIM value = VAL(Matches.Item(0).SubMatches(0))
DIM sss = text(serial, Matches.Item(0).SubMatches(1))
Matches = reExecute(sss, "(\D+)?(\d+)(\D+)?")
DIM res = ""
FOR m = 0 TO Matches.Count - 1
serial = Matches.Item(m).SubMatches(1)
SELECT value
CASE 1, 2
DIM n[][9] = "〇", "一", "二", "三", "四", "五", "六", "七", "八", "九", + _
"", "壱", "弐", "参", "四", "伍", "六", "七", "八", "九"
DIM a[][3] = "", "十", "百", "千", + _
"", "拾", "百", "阡"
DIM b[][3] = "", "万", "億", "兆", + _
"", "萬", "億", "兆"
DIM r = ""
DIM j = 0
type = value - 1
REPEAT
DIM str = ""
DIM n4 = serial MOD 10000
FOR i = LENGTH(n4) TO 1 STEP -1
s = COPY(n4, i, 1)
IFB s = 1 AND a[type][LENGTH(n4)-i] <> "" THEN
str = IIF(s, a[type][LENGTH(n4)-i], "") + str
ELSE
str = n[type][s] + IIF(s, a[type][LENGTH(n4)-i], "") + str
ENDIF
NEXT
IF str <> "" THEN r = str + b[type][j] + r
j = j + 1
serial = INT(serial / 10000)
UNTIL serial = 0
res = res + Matches.Item(m).SubMatches(0) + r + Matches.Item(m).SubMatches(2)
CASE 3
res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_FULLWIDTH) + Matches.Item(m).SubMatches(2)
CASE 4
res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_HALFWIDTH) + Matches.Item(m).SubMatches(2)
SELEND
NEXT
RESULT = res
CASE reTest(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$")
Matches = reExecute(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$")
DIM array = SPLIT(Matches.Item(0).SubMatches(1), "/")
ampm = array[IIF(serial - INT(serial) >= 0.5, 1, 0)]
hour12 = TRUE
res = ""
WITH Matches.Item(0)
res = text(serial, .SubMatches(0), hour12) + ampm + text(serial, .SubMatches(2), hour12)
ENDWITH
RESULT = res
CASE reTest(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?")
Matches = reExecute(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?")
FOR n = 0 TO Matches.Count - 1
IF n = 0 THEN res = Matches.Item(n).SubMatches(0)
NEXT
FOR n = 0 TO Matches.Count - 1
WITH Matches.Item(n)
res = res + text(serial, .SubMatches(1), hour12) + .SubMatches(3)
ENDWITH
NEXT
RESULT = res
CASE format = "0/0"
DIM separator = POS(".", serial)
DIM g = 0
IFB separator <> 0 THEN
DIM keta = LENGTH(serial)
DIM shift = POWER(10, keta - separator)
IFB shift >= POWER(10, 15) THEN
DIM position = 0
FOR i = 0 TO 14
IFB serial * POWER(10, i) - serial >= 1 THEN
position = i
BREAK
ENDIF
NEXT
tmp = serial * POWER(10, position)
FOR i = 1 TO 15
r = (tmp * POWER(10, i)) / serial - (tmp / serial)
a1 = tmp * POWER(10, i) - tmp
IF a1 = INT(a1) THEN BREAK
NEXT
DIM frac[] = a1, r
g = GCD(frac)
RESULT = (a1/g) + "/" + (r/g)
ELSE
DIM molecule = serial * shift // 分子
DIM denominator = shift // 分母
DIM nums[] = molecule, denominator
g = GCD(nums)
molecule = molecule / g
denominator = denominator / g
RESULT = molecule + "/" + denominator
ENDIF
ELSE
RESULT = serial + "/1"
ENDIF
CASE reTest(format, "(0+)\.?(0+)?") AND UBound(SPLIT(format, ".")) <= 1
Matches = reExecute(format, "(0+)\.?(0+)?")
len1 = LENGTH(Matches.Item(0).SubMatches(0))
len2 = LENGTH(Matches.Item(0).SubMatches(1))
DIM arr[] = LENGTH(INT(serial)), len1
IFB POS(".", format) THEN
RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX) + len2 + 1, len2), " ", "0")
ELSE
RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX)), " ", "0")
ENDIF
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 時刻文字列。hh:nn:ss AM/PM、hh:nn AM/PM、hh AM/PM、hh:nn:ss、hh:nn、hh時nn分ss秒、hh時nn分のいずれかの形式を指定。
// 【戻り値】
// シリアル値 （例）0…00:00:00、0.5…12:00:00、0.999988425925926…23:59:59
//////////////////////////////////////////////////
FUNCTION timeValue(str)
DIM serial = 0
DIM Matches
DIM pattern = "(\d+)"
DIM hh = "(0?[0-9]|1[0-2])"
DIM ampm = "([AP]M|[ap]m)"
SELECT TRUE
CASE reTest(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b")
WITH Matches.Item(0)
serial = timeValue(.SubMatches(0) + " " + .SubMatches(3)) + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + hh + ":" + pattern + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + ":" + pattern + " " + ampm + "\b")
WITH Matches.Item(0)
serial = timeValue(.SubMatches(0) + " " + .SubMatches(2)) + VAL(.SubMatches(1)) / 1440
ENDWITH
CASE reTest(str, "\b" + hh + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + " " + ampm + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0) MOD 12) + IIF(reTest(.SubMatches(1), "AM|am"), 0, 12)
serial = serial / 24
ENDWITH
CASE reTest(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b")
Matches = reExecute(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + pattern + ":" + pattern + "\b")
Matches = reExecute(str, "\b" + pattern + ":" + pattern + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440
ENDWITH
CASE reTest(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒")
Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + pattern + "時" + pattern + "分")
Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440
ENDWITH
DEFAULT
serial = ERR_VALUE
SELEND
RESULT = serial - INT(serial)
FEND
//////////////////////////////////////////////////
// 【引数】
// arrayname : 上限値を求める配列の名前
// dimension : 返す次元を示す整数
// 【戻り値】
// 配列の上限値
//////////////////////////////////////////////////
FUNCTION UBound(arrayname[], dimension = 1)
RESULT = EVAL("RESIZE(arrayname" + strRepeat("[0]", dimension - 1) + ")")
FEND
//////////////////////////////////////////////////
// 【引数】
// path : ファイルのパス
// 【戻り値】
// 重複しないファイル名
//////////////////////////////////////////////////
FUNCTION uniqueFilename(path)
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
IFB FSO.FileExists(path) THEN
DIM fol = FSO.GetParentFolderName(path)
DIM filename = FSO.GetBaseName(path)
DIM extension = FSO.GetExtensionName(path)
DIM i = 2
WHILE FSO.FileExists(FSO.BuildPath(fol, filename + " (" + i + ")." + extension))
i = i + 1
WEND
RESULT = FSO.BuildPath(fol, filename + " (" + i + ")." + extension)
ELSE
RESULT = path
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 丸め処理を行う値
// 【戻り値】
// 負の方向に丸めた値
//////////////////////////////////////////////////
FUNCTION floor(num)
RESULT = INT(num) + IIF(num < 0 AND num <> INT(num), -1, 0)
FEND
//////////////////////////////////////////////////
// 【引数】
// expr : 評価する式
// truepart : 評価した式がTrueのときに返す値
// falsepart : 評価した式がFalseのときに返す値
// 【戻り値】
// truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき
//////////////////////////////////////////////////
FUNCTION IIF(expr, truepart, falsepart)
IFB EVAL(expr) THEN
RESULT = truepart
ELSE
RESULT = falsepart
ENDIF
FEND使用関数
ファイルを開いているプロセスを調べる
SETHOTKEY(VK_ESC, EMPTYPARAM, "forceQuit")
CONST TemporaryFolder = 2
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
WITH FSO
DIM Folder = .GetSpecialFolder(TemporaryFolder)
DIM folderspec = Folder.Path
DIM filename = .GetTempName
DIM path = .BuildPath(folderspec, filename)
ENDWITH
DIM Shell = CREATEOLEOBJ("Shell.Application")
Shell.FileRun()
DIM ID = GETID("ファイル名を指定して実行", "#32770")
SENDSTR(ID, "cmd /c openfiles /query /fo CSV > " + path)
CLKITEM(ID, "OK", CLK_BTN)
SLEEP(0.500)
REPEAT
SLEEP(0.100)
UNTIL GETID("C:\WINDOWS\system32\cmd.exe", "ConsoleWindowClass") = -1
DIM FID = FOPEN(path, F_READ)
TRY
DIM ID2 = GETID("使用中", "OperationStatusWindow")
GETITEM(ID2, ITM_ACCTXT, 1)
DIM str = ALL_ITEM_LIST[1]
DIM sep = IIF(POS("フォルダー", STATUS(ID2, ST_TITLE)) <> 0, "\", "")
DIM msg = "■" + str + "<#CR>"
FOR r = 5 TO FGET(FID, F_LINECOUNT)
IF POS("\" + str + sep, FGET(FID, r, 3)) <> 0 THEN
msg = msg + "ID：" + FGET(FID, r, 1) + ", プロセス名：" + FGET(FID, r, 2) + "<#CR>"
ENDIF
NEXT
FCLOSE(FID)
REPEAT
FUKIDASI(TRIM(msg))
SLEEP(0.100)
UNTIL GETID("使用中", "OperationStatusWindow") = -1
FINALLY
FSO.DeleteFile(path)
ENDTRY
//////////////////////////////////////////////////
// 【引数】
//
// 【戻り値】
//
//////////////////////////////////////////////////
PROCEDURE forceQuit()
EXITEXIT
FEND
//////////////////////////////////////////////////
// 【引数】
// expr : 評価する式
// truepart : 評価した式がTrueのときに返す値
// falsepart : 評価した式がFalseのときに返す値
// 【戻り値】
// truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき
//////////////////////////////////////////////////
FUNCTION IIF(expr, truepart, falsepart)
IFB EVAL(expr) THEN
RESULT = truepart
ELSE
RESULT = falsepart
ENDIF
FEND使用関数
コロナのグラフ
CONST xlDown = -4121
CONST xlColumnClustered = 51
CONST xlCategory = 1
CONST xlValue = 2
CONST xlLine = 4
CONST msoThemeColorText2 = 15
CONST msoThemeColorBackground1 = 14
DIM Excel = CREATEOLEOBJ("Excel.Application")
WITH Excel
.Visible = TRUE
.Workbooks.Open("D:\Downloads\covid19_data.csv")
DIM ws = .ActiveSheet
DIM ws2 = .Worksheets.Add(EMPTYPARAM, .Worksheets(.Worksheets.Count))
ws2.Name = "7日間平均"
ws.Range("1:1").Copy(ws2.Range("1:1"))
ws.Range("A:D").Copy(ws2.Range("A:D"))
ws.Range("W:AB").Copy(ws2.Range("W:AB"))
ws2.Range("E8").Value = "=INT(SUM(covid19_data!E2:E8)/7)"
ws2.Range("E8").AutoFill(ws2.Range("E8:V8"))
DIM lastRow = ws.Range("B2").End(xlDown).Row
ws2.Range("E8:V8").AutoFill(ws2.Range("E8:V" + lastRow))
DIM Chart
// 検査数
Chart = .Charts.Add
.ActiveSheet.Move(EMPTYPARAM, .Sheets(.Sheets.Count))
.ActiveSheet.Name = "検査数"
WITH Chart
.ChartType = xlColumnClustered
.SetSourceData(ws.Range("covid19_data!$E:$E"))
WITH .SeriesCollection(1)
.Name = "日検査数"
.XValues = "covid19_data!$Y2:$Y" + lastRow
WITH .Format.Line
.ForeColor.ObjectThemeColor = msoThemeColorText2
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.6000000238
.Transparency = 0
ENDWITH
ENDWITH
WITH .Axes(xlCategory)
.MinimumScale = dateSerial(2020, 1, 1) //43831
.MajorUnit = 4
.TickLabels.Font.Size = 14
ENDWITH
WITH .Axes(xlValue)
.HasMajorGridLines = TRUE
.HasMinorGridLines = TRUE
.MinimumScale = 0
.MajorUnit = 5000
.MinorUnit = 1000
.TickLabels.Font.Size = 14
ENDWITH
ENDWITH
// 陽性数
Chart = .Charts.Add
.ActiveSheet.Move(EMPTYPARAM, .Sheets(.Sheets.Count))
.ActiveSheet.Name = "陽性者数"
WITH Chart
.ChartType = xlColumnClustered
.SetSourceData(ws.Range("covid19_data!$G2:$G" + lastRow))
.SeriesCollection.NewSeries
.SeriesCollection(2).Values = "='7日間平均'!$G2:$G" + lastRow
// 日付
WITH .SeriesCollection(1)
.Name = "日陽性数"
.XValues = "covid19_data!$Y2:$Y" + lastRow
WITH .Format.Line
.ForeColor.ObjectThemeColor = msoThemeColorText2
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.6000000238
.Transparency = 0
ENDWITH
ENDWITH
// 7日間平均
WITH .SeriesCollection(2)
.Name = "7日間平均"
.ChartType = xlLine
.Format.Line.ForeColor.RGB = RGBToColor(0, 112, 192)
ENDWITH
// x軸
WITH .Axes(xlCategory)
.MinimumScale = dateSerial(2020, 1, 1) //43831
.MajorUnit = 4
.TickLabels.Font.Size = 14
ENDWITH
// y軸
WITH .Axes(xlValue)
.HasMajorGridLines = TRUE
.HasMinorGridLines = TRUE
.MinimumScale = 0
.MajorUnit = 5000
.MinorUnit = 1000
.TickLabels.Font.Size = 14
ENDWITH
ENDWITH
// 死亡数
Chart = .Charts.Add
.ActiveSheet.Move(EMPTYPARAM, .Sheets(.Sheets.Count))
.ActiveSheet.Name = "死亡数"
WITH Chart
.ChartType = xlColumnClustered
.SetSourceData(ws.Range("covid19_data!$O2:$O" + lastRow))
.SeriesCollection.NewSeries
.SeriesCollection(2).Values = "='7日間平均'!$O2:$O" + lastRow
WITH .SeriesCollection(1)
.Name = "日死亡数"
.XValues = "covid19_data!$Y2:$Y" + lastRow
WITH .Format.Line
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.150000006
.Transparency = 0
ENDWITH
ENDWITH
WITH .SeriesCollection(2)
.Name = "7日間平均"
.ChartType = xlLine
WITH .Format.Line
.Weight = 2.5
.Transparency = 0
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.5
ENDWITH
ENDWITH
WITH .Axes(xlCategory)
.MinimumScale = dateSerial(2020, 1, 1) //43831
.MajorUnit = 4
.TickLabels.Font.Size = 14
ENDWITH
WITH .Axes(xlValue)
.HasMajorGridLines = TRUE // 軸あり
.HasMinorGridLines = TRUE // 目盛線あり
.MinimumScale = 0 // 最小値
.TickLabels.Font.Size = 14 // フォントサイズ
ENDWITH
ENDWITH
// 死亡累計
Chart = .Charts.Add
.ActiveSheet.Move(EMPTYPARAM, .Sheets(.Sheets.Count))
.ActiveSheet.Name = "死亡累計"
WITH Chart
.ChartType = xlColumnClustered
.SetSourceData(ws.Range("covid19_data!$P2:$P" + lastRow))
WITH .SeriesCollection(1)
.Name = "死亡累計"
.XValues = "covid19_data!$Y2:$Y" + lastRow
WITH .Format.Line
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.150000006
.Transparency = 0
ENDWITH
ENDWITH
WITH .Axes(xlCategory)
.MinimumScale = dateSerial(2020, 1, 1) //43831
.MajorUnit = 4
.TickLabels.Font.Size = 14
ENDWITH
WITH .Axes(xlValue)
.HasMajorGridLines = TRUE // 軸あり
.MinimumScale = 0 // 最小値
.TickLabels.Font.Size = 14 // フォントサイズ
ENDWITH
.ChartTitle.Delete
ENDWITH
ENDWITH
//////////////////////////////////////////////////
// 【引数】
// arr : 追加される配列（参照引数）
// tmp : 追加する配列
// 【戻り値】
// 追加した後の配列の要素数
//////////////////////////////////////////////////
FUNCTION arrayMerge(Var arr[], tmp[])
FOR n = 0 TO UBound(tmp)
arrayPush(arr, tmp[n])
NEXT
RESULT = UBound(arr)
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 配列。参照引数。
// 【戻り値】
// 引数に指定した配列の最後の要素
//////////////////////////////////////////////////
FUNCTION arrayPop(Var array[])
DIM n = UBound(array)
DIM res = array[n]
RESIZE(array, n-1)
RESULT = res
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 要素を追加する配列（参照引数）
// values : 追加する要素をvalue1から指定
// 【戻り値】
// 処理後の配列の要素の数
//////////////////////////////////////////////////
FUNCTION arrayPush(var array[], value1 = EMPTY, value2 = EMPTY, value3 = EMPTY, value4 = EMPTY, value5 = EMPTY, value6 = EMPTY, value7 = EMPTY, value8 = EMPTY, value9 = EMPTY, value10 = EMPTY, value11 = EMPTY, value12 = EMPTY, value13 = EMPTY, value14 = EMPTY, value15 = EMPTY, value16 = EMPTY)
DIM i = 1
WHILE EVAL("value" + i) <> EMPTY
DIM res = RESIZE(array, UBound(array) + 1)
array[res] = EVAL("value" + i)
i = i + 1
WEND
RESULT = LENGTH(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 逆順にする配列
// 【戻り値】
//
//////////////////////////////////////////////////
PROCEDURE arrayReverse(Var array[])
DIM cnt = LENGTH(array)
FOR i = 0 TO INT(cnt / 2) - 1
swap(array[i], array[cnt-(i+1)])
NEXT
FEND
//////////////////////////////////////////////////
// 【引数】
// needle : 検索する値
// haystack : 配列
// 【戻り値】
// needleが見つかった場合に配列のキー
//////////////////////////////////////////////////
FUNCTION arraySearch(needle, haystack[])
DIM i = 0
FOR item IN haystack
IFB item = needle THEN
RESULT = i
EXIT
ENDIF
i = i + 1
NEXT
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 配列
// 【戻り値】
// arrayの最初の値。配列arrayは、要素一つ分だけ短くなり、全ての要素は前にずれます。
//////////////////////////////////////////////////
FUNCTION arrayShift(Var array[])
DIM res = array[0]
SHIFTARRAY(array, -1)
RESIZE(array, UBound(array) - 1)
RESULT = res
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 要素を加えられる配列
// values : 加える値をvalue1から順に指定
// 【戻り値】
// 処理後の配列の要素の数
//////////////////////////////////////////////////
FUNCTION arrayUnshift(var array[], value1 = EMPTY, value2 = EMPTY, value3 = EMPTY, value4 = EMPTY, value5 = EMPTY, value6 = EMPTY, value7 = EMPTY, value8 = EMPTY, value9 = EMPTY, value10 = EMPTY, value11 = EMPTY, value12 = EMPTY, value13 = EMPTY, value14 = EMPTY, value15 = EMPTY, value16 = EMPTY)
DIM tmp[-1]
DIM i = 1
WHILE EVAL("value" + i) <> EMPTY
arrayPush(tmp, EVAL("value" + i))
i = i + 1
WEND
arrayMerge(tmp, array)
RESIZE(array, UBound(tmp))
SETCLEAR(array, EMPTY)
FOR i = 0 TO UBound(tmp)
array[i] = tmp[i]
NEXT
RESULT = LENGTH(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// bin : 2進数
// signFlg : 符号付きならばTrue
// 【戻り値】
// 10進数に変換した値
//////////////////////////////////////////////////
FUNCTION binToDec(bin, signFlg = TRUE)
DIM dec = 0
DIM decimalFlg = IIF(POS(".", bin), TRUE, FALSE)
IFB COPY(bin, 1, 1) = "1" AND signFlg THEN
DIM msb = IIF(decimalFlg, POS(".", bin) - 1, LENGTH(bin))
DIM lsb = IIF(decimalFlg, POS(".", bin) - LENGTH(bin), 0)
DIM dec2 = POWER(2, msb) - 1
FOR i = -1 TO lsb STEP -1
dec2 = dec2 + POWER(2, i)
NEXT
DIM a = binToDec(bin, FALSE)
DIM b = dec2
dec = -1 * (bitXor(a, b) + POWER(2, lsb))
ELSE
IFB decimalFlg THEN
DIM integer = COPY(bin, 1, POS(".", bin) - 1)
DIM decimal = COPY(bin, POS(".", bin) + 1)
FOR i = 1 TO LENGTH(decimal)
dec = dec + COPY(decimal, i, 1) * POWER(2, -1 * i)
NEXT
ELSE
integer = bin
ENDIF
FOR i = 1 TO LENGTH(integer)
dec = dec + COPY(integer, i, 1) * POWER(2, LENGTH(integer) - i)
NEXT
ENDIF
RESULT = dec
FEND
//////////////////////////////////////////////////
// 【引数】
// bin : 2進数
// 【戻り値】
// 16進数に変換した値
//////////////////////////////////////////////////
FUNCTION binToHex(bin)
HASHTBL bh
bh["0000"] = "0"; bh["0001"] = "1"; bh["0010"] = "2"; bh["0011"] = "3";
bh["0100"] = "4"; bh["0101"] = "5"; bh["0110"] = "6"; bh["0111"] = "7";
bh["1000"] = "8"; bh["1001"] = "9"; bh["1010"] = "A"; bh["1011"] = "B";
bh["1100"] = "C"; bh["1101"] = "D"; bh["1110"] = "E"; bh["1111"] = "F";
// 小数ならば
IFB POS(".", bin) <> 0 THEN
DIM num = COPY(bin, 1, POS(".", bin) - 1)
DIM frac = COPY(bin, POS(".", bin) + 1)
num = strPad(num, CEIL(LENGTH(num) / 4) * 4, "0", LEFT)
frac = strPad(frac, CEIL(LENGTH(frac) / 4) * 4, "0", RIGHT)
DIM hex = ""
FOR i = 1 TO LENGTH(num) STEP 4
hex = hex + bh[COPY(num, i, 4)]
NEXT
hex = hex + "."
FOR i = 1 TO LENGTH(frac) STEP 4
hex = hex + bh[COPY(frac, i, 4)]
NEXT
RESULT = hex
ELSE
len = CEIL(LENGTH(bin) / 4) * 4
FOR i = 1 TO len - LENGTH(bin)
bin = "0" + bin
NEXT
bin = REPLACE(FORMAT(bin, len), " ", "0")
hex = ""
FOR i = 1 TO LENGTH(bin) / 4
str = COPY(bin, i * 4 - 3, 4)
hex = hex + bh[str]
NEXT
RESULT = hex
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// arg1 : 数値1（10進数）
// arg2 : 数値2（10進数）
// 【戻り値】
// 2つの数値のビット毎の論理積
//////////////////////////////////////////////////
FUNCTION bitAnd(arg1, arg2)
DIM args[1] = arg1, arg2
DIM bins[1]
DIM decimals[1]
DIM integers[1]
DIM keta[1]
IFB ABS(arg1) <> arg1 OR ABS(arg2) <> arg2 THEN
RESULT = ERR_VALUE
EXIT
ENDIF
FOR i = 0 TO 1
bins[i] = decToBin(args[i])
decimals[i] = 0
IFB POS(".", bins[i]) <> 0 THEN
integers[i] = COPY(bins[i], 1, POS(".", bins[i]) - 1)
decimals[i] = COPY(bins[i], POS(".", bins[i]) + 1)
ELSE
integers[i] = bins[i]
ENDIF
NEXT
keta[0] = IIF(LENGTH(integers[0]) > LENGTH(integers[1]), LENGTH(integers[0]), LENGTH(integers[1]))
integers[0] = strPad(integers[0], keta[0], "0", LEFT)
integers[1] = strPad(integers[1], keta[0], "0", LEFT)
keta[1] = IIF(LENGTH(decimals[0]) > LENGTH(decimals[1]), LENGTH(decimals[0]), LENGTH(decimals[1]))
decimals[0] = strPad(decimals[0], keta[1], "0", RIGHT)
decimals[1] = strPad(decimals[1], keta[1], "0", RIGHT)
DIM bin = ""
FOR i = 1 TO keta[0]
bin = bin + (VAL(COPY(integers[0], i, 1)) AND VAL(COPY(integers[1], i, 1)))
NEXT
bin = bin + "."
FOR i = 1 TO keta[1]
bin = bin + (VAL(COPY(decimals[0], i, 1)) AND VAL(COPY(decimals[1], i, 1)))
NEXT
RESULT = binToDec(bin)
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 10進数もしくは2進数の値
// bit : ビット
// 【戻り値】
// ビットを反転した値
//////////////////////////////////////////////////
FUNCTION bitNot(num, bit = EMPTY)
IFB isString(num) THEN
DIM res = ""
FOR i = 1 TO LENGTH(num)
DIM str = COPY(num, i, 1)
IFB str = "0" OR str = "1" THEN
res = res + (1 - VAL(str))
ELSE
res = res + str
ENDIF
NEXT
RESULT = res
ELSE
DIM exponent = IIF(bit = EMPTY, CEIL(LOGN(2, num + 1)), bit)
RESULT = POWER(2, exponent) - num - 1
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// arg1 : 数値1（10進数）
// arg2 : 数値2（10進数）
// 【戻り値】
// 2つの数値のビット毎の排他的論理和
//////////////////////////////////////////////////
FUNCTION bitXor(arg1, arg2)
DIM args[1] = arg1, arg2
DIM bins[1]
DIM decimals[1]
DIM integers[1]
DIM keta[1]
IFB ABS(arg1) <> arg1 OR ABS(arg2) <> arg2 THEN
RESULT = ERR_VALUE
EXIT
ENDIF
FOR i = 0 TO 1
bins[i] = decToBin(args[i])
decimals[i] = 0
IFB POS(".", bins[i]) <> 0 THEN
integers[i] = COPY(bins[i], 1, POS(".", bins[i]) - 1)
decimals[i] = COPY(bins[i], POS(".", bins[i]) + 1)
ELSE
integers[i] = bins[i]
ENDIF
NEXT
keta[0] = IIF(LENGTH(integers[0]) > LENGTH(integers[1]), LENGTH(integers[0]), LENGTH(integers[1]))
integers[0] = strPad(integers[0], keta[0], "0", LEFT)
integers[1] = strPad(integers[1], keta[0], "0", LEFT)
keta[1] = IIF(LENGTH(decimals[0]) > LENGTH(decimals[1]), LENGTH(decimals[0]), LENGTH(decimals[1]))
decimals[0] = strPad(decimals[0], keta[1], "0", RIGHT)
decimals[1] = strPad(decimals[1], keta[1], "0", RIGHT)
DIM bin = ""
FOR i = 1 TO keta[0]
bin = bin + (VAL(COPY(integers[0], i, 1)) XOR VAL(COPY(integers[1], i, 1)))
NEXT
bin = bin + "."
FOR i = 1 TO keta[1]
bin = bin + (VAL(COPY(decimals[0], i, 1)) XOR VAL(COPY(decimals[1], i, 1)))
NEXT
RESULT = binToDec(bin)
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 単位換算する数値
// before : 変換前の単位
// after : 変換後の単位
// 【戻り値】
// 指定した単位に変換した数値
//////////////////////////////////////////////////
FUNCTION convert(num, before, after)
HASHTBL unit
// 重量
unit["g,sg"] = "num * 6.85217658567918 * POWER(10, -5)"
unit["g,lbm"] = "num * 2.20462262184878 * POWER(10, -3)"
unit["g,u"] = "num * 6.02217 * POWER(10, +23)"
unit["g,ozm"] = "num * 3.52739619495804 * POWER(10, -2)"
unit["sg,g"] = "num * 1.45939029372064 * POWER(10, +4)"
unit["sg,lbm"] = "num * 3.21740485564304 * POWER(10, +1)"
unit["sg,u"] = "num * 8.78869644513561 * POWER(10, +27)"
unit["sg,ozm"] = "num * 5.14784776902887 * POWER(10, +2)"
unit["lbm,g"] = "num * 4.5359237 * POWER(10, +2)"
unit["lbm,sg"] = "num * 3.10809501715673 * POWER(10, -2)"
unit["lbm,u"] = "num * 2.7316103628429 * POWER(10, +26)"
unit["lbm,ozm"] = "num * 1.6 * POWER(10, +1)"
unit["u,g"] = "num * 1.66053100460465 * POWER(10, -24)"
unit["u,sg"] = "num * 1.13782516695463 * POWER(10, -28)"
unit["u,lbm"] = "num * 3.66084421703269 * POWER(10, -27)"
unit["u,ozm"] = "num * 5.8573507472523 * POWER(10, -26)"
unit["ozm,g"] = "num * 2.8349523125 * POWER(10, +1)"
unit["ozm,sg"] = "num * 1.94255938572295 * POWER(10, -3)"
unit["ozm,lbm"] = "num * 6.25 * POWER(10, -2)"
unit["ozm,u"] = "num * 1.70725647677681 * POWER(10, +25)"
// 距離
unit["m,mi"] = "num * 6.21371192237334 * POWER(10, -4)"
unit["m,Nmi"] = "num * 5.39956803455724 * POWER(10, -4)"
unit["m,in"] = "num * 3.93700787401575 * POWER(10, +1)"
unit["m,ft"] = "num * 3.28083989501312 * POWER(10, +0)"
unit["m,yd"] = "num * 1.09361329833771 * POWER(10, +0)"
unit["m,ang"] = "num * 1 * POWER(10, +10)"
unit["m,pica"] = "num * 2.36220472440945 * POWER(10, +2)"
unit["mi,m"] = "num * 1.609344 * POWER(10, +3)"
unit["mi,Nmi"] = "num * 8.68976241900648 * POWER(10, -1)"
unit["mi,in"] = "num * 6.336 * POWER(10, +4)"
unit["mi,ft"] = "num * 5.28 * POWER(10, +3)"
unit["mi,yd"] = "num * 1.76 * POWER(10, +3)"
unit["mi,ang"] = "num * 1.609344 * POWER(10, +13)"
unit["mi,pica"] = "num * 3.8016 * POWER(10, +5)"
unit["Nmi,m"] = "num * 1.852 * POWER(10, +3)"
unit["Nmi,mi"] = "num * 1.15077944802354 * POWER(10, +0)"
unit["Nmi,in"] = "num * 7.29133858267717 * POWER(10, +4)"
unit["Nmi,ft"] = "num * 6.0761154855643 * POWER(10, +3)"
unit["Nmi,yd"] = "num * 2.02537182852143 * POWER(10, +3)"
unit["Nmi,ang"] = "num * 1.852 * POWER(10, +13)"
unit["Nmi,pica"] = "num * 4.3748031496063 * POWER(10, +5)"
unit["in,m"] = "num * 2.54 * POWER(10, -2)"
unit["in,mi"] = "num * 1.57828282828283 * POWER(10, -5)"
unit["in,Nmi"] = "num * 1.37149028077754 * POWER(10, -5)"
unit["in,ft"] = "num * 8.33333333333333 * POWER(10, -2)"
unit["in,yd"] = "num * 2.77777777777778 * POWER(10, -2)"
unit["in,ang"] = "num * 2.54 * POWER(10, +8)"
unit["in,pica"] = "num * 6 * POWER(10, +0)"
unit["ft,m"] = "num * 3.048 * POWER(10, -1)"
unit["ft,mi"] = "num * 1.89393939393939 * POWER(10, -4)"
unit["ft,Nmi"] = "num * 1.64578833693305 * POWER(10, -4)"
unit["ft,in"] = "num * 1.2 * POWER(10, +1)"
unit["ft,yd"] = "num * 3.33333333333333 * POWER(10, -1)"
unit["ft,ang"] = "num * 3.048 * POWER(10, +9)"
unit["ft,pica"] = "num * 7.2 * POWER(10, +1)"
unit["yd,m"] = "num * 9.144 * POWER(10, -1)"
unit["yd,mi"] = "num * 5.68181818181818 * POWER(10, -4)"
unit["yd,Nmi"] = "num * 4.93736501079914 * POWER(10, -4)"
unit["yd,in"] = "num * 3.6 * POWER(10, +1)"
unit["yd,ft"] = "num * 3 * POWER(10, +0)"
unit["yd,ang"] = "num * 9.144 * POWER(10, +9)"
unit["yd,pica"] = "num * 2.16 * POWER(10, +2)"
unit["ang,m"] = "num * 1 * POWER(10, -10)"
unit["ang,mi"] = "num * 6.21371192237334 * POWER(10, -14)"
unit["ang,Nmi"] = "num * 5.39956803455724 * POWER(10, -14)"
unit["ang,in"] = "num * 3.93700787401575 * POWER(10, -9)"
unit["ang,ft"] = "num * 3.28083989501312 * POWER(10, -10)"
unit["ang,yd"] = "num * 1.09361329833771 * POWER(10, -10)"
unit["ang,pica"] = "num * 2.36220472440945 * POWER(10, -8)"
unit["pica,m"] = "num * 4.23333333333333 * POWER(10, -3)"
unit["pica,mi"] = "num * 2.63047138047138 * POWER(10, -6)"
unit["pica,Nmi"] = "num * 2.28581713462923 * POWER(10, -6)"
unit["pica,in"] = "num * 1.66666666666667 * POWER(10, -1)"
unit["pica,ft"] = "num * 1.38888888888889 * POWER(10, -2)"
unit["pica,yd"] = "num * 4.62962962962963 * POWER(10, -3)"
unit["pica,ang"] = "num * 4.23333333333333 * POWER(10, +7)"
// 時間
unit["yr,day"] = "num * 3.6525 * POWER(10, +2)"
unit["yr,hr"] = "num * 8.766 * POWER(10, +3)"
unit["yr,mn"] = "num * 5.2596 * POWER(10, +5)"
unit["yr,sec"] = "num * 3.15576 * POWER(10, +7)"
unit["day,yr"] = "num * 2.7378507871321 * POWER(10, -3)"
unit["day,hr"] = "num * 2.4 * POWER(10, +1)"
unit["day,mn"] = "num * 1.44 * POWER(10, +3)"
unit["day,sec"] = "num * 8.64 * POWER(10, +4)"
unit["hr,yr"] = "num * 1.14077116130504 * POWER(10, -4)"
unit["hr,day"] = "num * 4.16666666666667 * POWER(10, -2)"
unit["hr,mn"] = "num * 6 * POWER(10, +1)"
unit["hr,sec"] = "num * 3.6 * POWER(10, +3)"
unit["mn,yr"] = "num * 1.90128526884174 * POWER(10, -6)"
unit["mn,day"] = "num * 6.94444444444444 * POWER(10, -4)"
unit["mn,hr"] = "num * 1.66666666666667 * POWER(10, -2)"
unit["mn,sec"] = "num * 6 * POWER(10, +1)"
unit["sec,yr"] = "num * 3.16880878140289 * POWER(10, -8)"
unit["sec,day"] = "num * 1.15740740740741 * POWER(10, -5)"
unit["sec,hr"] = "num * 2.77777777777778 * POWER(10, -4)"
unit["sec,mn"] = "num * 1.66666666666667 * POWER(10, -2)"
// 圧力
unit["Pa,atm"] = "num * 9.86923266716013 * POWER(10, -6)"
unit["Pa,mmHg"] = "num * 7.5006168270417 * POWER(10, -3)"
unit["atm,Pa"] = "num * 1.01325 * POWER(10, +5)"
unit["atm,mmHg"] = "num * 7.6 * POWER(10, +2)"
unit["mmHg,Pa"] = "num * 1.33322368421053 * POWER(10, +2)"
unit["mmHg,atm"] = "num * 1.31578947368421 * POWER(10, -3)"
// 物理的な力
unit["N,dyn"] = "num * 1 * POWER(10, +5)"
unit["N,lbf"] = "num * 2.2480894309971 * POWER(10, -1)"
unit["dyn,N"] = "num * 1 * POWER(10, -5)"
unit["dyn,lbf"] = "num * 2.2480894309971 * POWER(10, -6)"
unit["lbf,N"] = "num * 4.4482216152605 * POWER(10, +0)"
unit["lbf,dyn"] = "num * 4.4482216152605 * POWER(10, +5)"
// エネルギー
unit["J,e"] = "num * 1 * POWER(10, +7)"
unit["J,cal"] = "num * 2.38845896627496 * POWER(10, -1)"
unit["J,eV"] = "num * 6.241457 * POWER(10, +18)"
unit["J,HPh"] = "num * 3.72506135998619 * POWER(10, -7)"
unit["J,Wh"] = "num * 2.77777777777778 * POWER(10, -4)"
unit["J,flb"] = "num * 7.37562149277265 * POWER(10, -1)"
unit["J,BTU"] = "num * 9.47817120313317 * POWER(10, -4)"
unit["J,c"] = "num * 2.39005736137667 * POWER(10, -1)"
unit["e,J"] = "num * 1 * POWER(10, -7)"
unit["e,cal"] = "num * 2.38845896627496 * POWER(10, -8)"
unit["e,eV"] = "num * 6.241457 * POWER(10, +11)"
unit["e,HPh"] = "num * 3.72506135998619 * POWER(10, -14)"
unit["e,Wh"] = "num * 2.77777777777778 * POWER(10, -11)"
unit["e,flb"] = "num * 7.37562149277265 * POWER(10, -8)"
unit["e,BTU"] = "num * 9.47817120313317 * POWER(10, -11)"
unit["e,c"] = "num * 2.39005736137667 * POWER(10, -8)"
unit["cal,J"] = "num * 4.1868 * POWER(10, +0)"
unit["cal,e"] = "num * 4.1868 * POWER(10, +7)"
unit["cal,eV"] = "num * 2.61317321676 * POWER(10, +19)"
unit["cal,HPh"] = "num * 1.55960869019902 * POWER(10, -6)"
unit["cal,Wh"] = "num * 1.163 * POWER(10, -3)"
unit["cal,flb"] = "num * 3.08802520659405 * POWER(10, +0)"
unit["cal,BTU"] = "num * 3.9683207193278 * POWER(10, -3)"
unit["cal,c"] = "num * 1.00066921606119 * POWER(10, +0)"
unit["eV,J"] = "num * 1.60219000146921 * POWER(10, -19)"
unit["eV,e"] = "num * 1.60219000146921 * POWER(10, -12)"
unit["eV,cal"] = "num * 3.82676507468522 * POWER(10, -20)"
unit["eV,HPh"] = "num * 5.96825606582916 * POWER(10, -26)"
unit["eV,Wh"] = "num * 4.45052778185891 * POWER(10, -23)"
unit["eV,flb"] = "num * 1.18171470103417 * POWER(10, -19)"
unit["eV,BTU"] = "num * 1.51858311338733 * POWER(10, -22)"
unit["eV,c"] = "num * 3.82932600733558 * POWER(10, -20)"
unit["HPh,J"] = "num * 2.68451953769617 * POWER(10, +6)"
unit["HPh,e"] = "num * 2.68451953769617 * POWER(10, +13)"
unit["HPh,cal"] = "num * 6.41186475995073 * POWER(10, +5)"
unit["HPh,eV"] = "num * 1.67553132601905 * POWER(10, +25)"
unit["HPh,Wh"] = "num * 7.4569987158227 * POWER(10, +2)"
unit["HPh,flb"] = "num * 1.98 * POWER(10, +6)"
unit["HPh,BTU"] = "num * 2.54443357764402 * POWER(10, +3)"
unit["HPh,c"] = "num * 6.41615568283024 * POWER(10, +5)"
unit["Wh,J"] = "num * 3.6 * POWER(10, +3)"
unit["Wh,e"] = "num * 3.6 * POWER(10, +10)"
unit["Wh,cal"] = "num * 8.59845227858985 * POWER(10, +2)"
unit["Wh,eV"] = "num * 2.24692452 * POWER(10, +22)"
unit["Wh,HPh"] = "num * 1.34102208959503 * POWER(10, -3)"
unit["Wh,flb"] = "num * 2.65522373739816 * POWER(10, +3)"
unit["Wh,BTU"] = "num * 3.41214163312794 * POWER(10, +0)"
unit["Wh,c"] = "num * 8.60420650095602 * POWER(10, +2)"
unit["flb,J"] = "num * 1.3558179483314 * POWER(10, +0)"
unit["flb,e"] = "num * 1.3558179483314 * POWER(10, +7)"
unit["flb,cal"] = "num * 3.23831553532865 * POWER(10, -1)"
unit["flb,eV"] = "num * 8.46227942433866 * POWER(10, +18)"
unit["flb,HPh"] = "num * 5.05050505050505 * POWER(10, -7)"
unit["flb,Wh"] = "num * 3.76616096758722 * POWER(10, -4)"
unit["flb,BTU"] = "num * 1.28506746345658 * POWER(10, -3)"
unit["flb,c"] = "num * 3.24048266809608 * POWER(10, -1)"
unit["BTU,J"] = "num * 1.05505585262 * POWER(10, +3)"
unit["BTU,e"] = "num * 1.05505585262 * POWER(10, +10)"
unit["BTU,cal"] = "num * 2.51995761111111 * POWER(10, +2)"
unit["BTU,eV"] = "num * 6.58508573672607 * POWER(10, +21)"
unit["BTU,HPh"] = "num * 3.93014778922204 * POWER(10, -4)"
unit["BTU,Wh"] = "num * 2.93071070172222 * POWER(10, -1)"
unit["BTU,flb"] = "num * 7.78169262265965 * POWER(10, +2)"
unit["BTU,c"] = "num * 2.52164400721797 * POWER(10, +2)"
unit["c,J"] = "num * 4.184 * POWER(10, +0)"
unit["c,e"] = "num * 4.184 * POWER(10, +7)"
unit["c,cal"] = "num * 9.99331231489443 * POWER(10, -1)"
unit["c,eV"] = "num * 2.6114256088 * POWER(10, +19)"
unit["c,HPh"] = "num * 1.55856567301822 * POWER(10, -6)"
unit["c,Wh"] = "num * 1.16222222222222 * POWER(10, -3)"
unit["c,flb"] = "num * 3.08596003257608 * POWER(10, +0)"
unit["c,BTU"] = "num * 3.96566683139092 * POWER(10, -3)"
// 仕事率
unit["HP,W"] = "num * 7.4569987158227 * POWER(10, +2)"
unit["W,HP"] = "num * 1.34102208959503 * POWER(10, -3)"
// 磁力
unit["T,ga"] = "num * 1 * POWER(10, +4)"
unit["ga,T"] = "num * 1 * POWER(10, -4)"
// 温度
unit["C,F"] = "num * (9/5) + 32"
unit["C,K"] = "num + 273.15"
unit["F,C"] = "(num - 32) * (9/5)"
unit["F,K"] = "(num - 32) * (5/9) + 273.15"
unit["K,C"] = "num - 23373.15"
unit["K,F"] = "(num - 273.15) * (9/5) + 32"
// 体積（容積）
unit["tsp,tbs"] = "num * 3.33333333333333 * POWER(10, -1)"
unit["tsp,oz"] = "num * 1.66666666666667 * POWER(10, -1)"
unit["tsp,cup"] = "num * 2.08333333333333 * POWER(10, -2)"
unit["tsp,us_pt"] = "num * 1.04166666666667 * POWER(10, -2)"
unit["tsp,uk_pt"] = "num * 8.67368942321863 * POWER(10, -3)"
unit["tsp,qt"] = "num * 5.20833333333333 * POWER(10, -3)"
unit["tsp,gal"] = "num * 1.30208333333333 * POWER(10, -3)"
unit["tbs,tsp"] = "num * 3 * POWER(10, +0)"
unit["tbs,oz"] = "num * 5 * POWER(10, -1)"
unit["tbs,cup"] = "num * 6.25 * POWER(10, -2)"
unit["tbs,us_pt"] = "num * 3.125 * POWER(10, -2)"
unit["tbs,uk_pt"] = "num * 2.60210682696559 * POWER(10, -2)"
unit["tbs,qt"] = "num * 1.5625 * POWER(10, -2)"
unit["tbs,gal"] = "num * 3.90625 * POWER(10, -3)"
unit["oz,tsp"] = "num * 6 * POWER(10, +0)"
unit["oz,tbs"] = "num * 2 * POWER(10, +0)"
unit["oz,cup"] = "num * 1.25 * POWER(10, -1)"
unit["oz,us_pt"] = "num * 6.25 * POWER(10, -2)"
unit["oz,uk_pt"] = "num * 5.20421365393118 * POWER(10, -2)"
unit["oz,qt"] = "num * 3.125 * POWER(10, -2)"
unit["oz,gal"] = "num * 7.8125 * POWER(10, -3)"
unit["cup,tsp"] = "num * 4.8 * POWER(10, +1)"
unit["cup,tbs"] = "num * 1.6 * POWER(10, +1)"
unit["cup,oz"] = "num * 8 * POWER(10, +0)"
unit["cup,us_pt"] = "num * 5 * POWER(10, -1)"
unit["cup,uk_pt"] = "num * 4.16337092314494 * POWER(10, -1)"
unit["cup,qt"] = "num * 2.5 * POWER(10, -1)"
unit["cup,gal"] = "num * 6.25 * POWER(10, -2)"
unit["us_pt,tsp"] = "num * 9.6 * POWER(10, +1)"
unit["us_pt,tbs"] = "num * 3.2 * POWER(10, +1)"
unit["us_pt,oz"] = "num * 1.6 * POWER(10, +1)"
unit["us_pt,cup"] = "num * 2 * POWER(10, +0)"
unit["us_pt,uk_pt"] = "num * 8.32674184628989 * POWER(10, -1)"
unit["us_pt,qt"] = "num * 5 * POWER(10, -1)"
unit["us_pt,gal"] = "num * 1.25 * POWER(10, -1)"
unit["uk_pt,tsp"] = "num * 1.15291192848466 * POWER(10, +2)"
unit["uk_pt,tbs"] = "num * 3.84303976161554 * POWER(10, +1)"
unit["uk_pt,oz"] = "num * 1.92151988080777 * POWER(10, +1)"
unit["uk_pt,cup"] = "num * 2.40189985100971 * POWER(10, +0)"
unit["uk_pt,us_pt"] = "num * 1.20094992550486 * POWER(10, +0)"
unit["uk_pt,qt"] = "num * 6.00474962752428 * POWER(10, -1)"
unit["uk_pt,gal"] = "num * 1.50118740688107 * POWER(10, -1)"
unit["qt,tsp"] = "num * 1.92 * POWER(10, +2)"
unit["qt,tbs"] = "num * 6.4 * POWER(10, +1)"
unit["qt,oz"] = "num * 3.2 * POWER(10, +1)"
unit["qt,cup"] = "num * 4 * POWER(10, +0)"
unit["qt,us_pt"] = "num * 2 * POWER(10, +0)"
unit["qt,uk_pt"] = "num * 1.66534836925798 * POWER(10, +0)"
unit["qt,gal"] = "num * 2.5 * POWER(10, -1)"
unit["gal,tsp"] = "num * 7.68 * POWER(10, +2)"
unit["gal,tbs"] = "num * 2.56 * POWER(10, +2)"
unit["gal,oz"] = "num * 1.28 * POWER(10, +2)"
unit["gal,cup"] = "num * 1.6 * POWER(10, +1)"
unit["gal,us_pt"] = "num * 8 * POWER(10, +0)"
unit["gal,uk_pt"] = "num * 6.66139347703191 * POWER(10, +0)"
unit["gal,qt"] = "num * 4 * POWER(10, +0)"
RESULT = EVAL(unit[before + "," + after])
FEND
//////////////////////////////////////////////////
// 【引数】
// folderspec : 作成するフォルダのパス
// 【戻り値】
//
//////////////////////////////////////////////////
PROCEDURE CreateFolders(folderspec)
WITH CREATEOLEOBJ("Scripting.FileSystemObject")
folderspec = .GetAbsolutePathName(folderspec)
IF !.DriveExists(.GetDriveName(folderspec)) THEN EXIT
DIM parentPath = .GetParentFolderName(folderspec)
IF !.FolderExists(parentPath) THEN CreateFolders(parentPath)
IF !.FolderExists(folderspec) THEN .CreateFolder(folderspec)
ENDWITH
FEND
//////////////////////////////////////////////////
// 【引数】
// interval : 加算する時間間隔を表す文字列式（yyyy：年、m：月、d：日、ww：週、h：時、n：分、s：秒）
// num : dateに加算する値。未来は正、過去は負で指定
// date : 時間間隔を加算する日付
// 【戻り値】
// 日時（date）に、指定した単位（interval）の時間（num）を加算して返します
//////////////////////////////////////////////////
FUNCTION dateAdd(interval, num, date)
DIM year, month, day, d
GETTIME(0, date)
DIM time = G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2
SELECT interval
CASE "yyyy"
d = (G_TIME_YY + num) + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
IF time <> "00:00:00" THEN d = d + " " + time
CASE "m"
IFB num > 0 THEN
year = G_TIME_YY + INT((G_TIME_MM + num) / 12)
month = REPLACE(FORMAT(((G_TIME_MM + num) MOD 12), 2), " ", "0")
ELSE
year = G_TIME_YY + CEIL((G_TIME_MM + num) / 12 - 1)
month = REPLACE(FORMAT(G_TIME_MM - (ABS(num) MOD 12), 2), " ", "0")
ENDIF
IF month = "00" THEN month = 12
day = G_TIME_DD2
d = "" + year + month + day
IFB !isDate(d) THEN
d = year + "/" + month + "/" + "01"
d = getEndOfMonth(d)
ELSE
d = year + "/" + month + "/" + day
ENDIF
IF time <> "00:00:00" THEN d = d + " " + time
CASE "d"
t = GETTIME(num, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "ww"
t = GETTIME(num * 7, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "h"
t = GETTIME(num / 24, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "n"
t = GETTIME(num / 1440, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "s"
t = GETTIME(num / 86400, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
// interval : 時間単位（yyyy︰年、q：四半期、m︰月、d︰日、w：週日、ww：週、h：時、n：分、s：秒）
// date1 : 日時1
// date2 : 日時2
// 【戻り値】
// date2からdate1を引いた時間間隔を求めます。
//////////////////////////////////////////////////
FUNCTION dateDiff(interval, date1, date2)
DIM y1, y2, m1, m2, d1, d2, d
SELECT interval
CASE "yyyy"
GETTIME(0, date1)
y1 = G_TIME_YY
GETTIME(0, date2)
y2 = G_TIME_YY
d = y2 - y1
CASE "q"
GETTIME(0, date1)
y1 = G_TIME_YY
m1 = G_TIME_MM
GETTIME(0, date2)
y2 = G_TIME_YY
m2 = G_TIME_MM
d = y2 * 4 + CEIL(m2/3) - (y1 * 4 + CEIL(m1/3))
CASE "m"
GETTIME(0, date1)
y1 = G_TIME_YY
m1 = G_TIME_MM
GETTIME(0, date2)
y2 = G_TIME_YY
m2 = G_TIME_MM
d = (y2 - y1) * 12 + m2 - m1
CASE "d"
d1 = GETTIME(0, date1)
d2 = GETTIME(0, date2)
d = (d2 - d1) / 86400
CASE "w"
d = INT(dateDiff("d", date1, date2) / 7)
CASE "ww"
date1 = dateAdd("d", -1 * getWeekday(date1), date1)
d = INT(dateDiff("d", date1, date2) / 7)
CASE "h"
d = dateDiff("d", date1, date2) * 24
CASE "n"
d = dateDiff("d", date1, date2) * 1440
CASE "s"
d = dateDiff("d", date1, date2) * 86400
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
// year : 年
// month : 月
// day : 日
// 【戻り値】
// シリアル値
//////////////////////////////////////////////////
FUNCTION dateSerial(year, month, day)
month = REPLACE(FORMAT(month, 2), " ", "0")
day = REPLACE(FORMAT(day, 2), " ", "0")
d = GETTIME(0, year + "/" + month + "/" + day)
RESULT = uwscToSerial(d)
FEND
//////////////////////////////////////////////////
// 【引数】
//
// 【戻り値】
//
//////////////////////////////////////////////////
MODULE Decimal
CONST BASE = 1E+7
CONST LOG_BASE = 7
CONST MAX_SAFE_INTEGER = 1E+15 - 1
CONST MAX_DIGITS = 1E+9
PUBLIC precision = 20
PUBLIC rounding = 4
PUBLIC minE = -9E+15
PUBLIC maxE = 9E+15
PUBLIC quadrant = EMPTY
PUBLIC modulo = 1
DIM inexact = FALSE
PUBLIC toExpNeg = -7
PUBLIC toExpPos = 21
CONST MathLN10 = 2.302585092994046
CONST LN10 = "2.3025850929940456840179914546843642076011014886287729760333279009675726096773524802359972050895982983" + _
"4196778404228624863340952546508280675666628736909878168948290720832555468084379989482623319852839350" + _
"5308965377732628846163366222287698219886746543667474404243274365155048934314939391479619404400222105" + _
"1017141748003688084012647080685567743216228355220114804663715659121373450747856947683463616792101806" + _
"4450706480002775026849167465505868569356734206705811364292245544057589257242082413146956890167589402" + _
"5677631135691929203337658714166023010570308963457207544037084746994016826928280848118428931484852494" + _
"8644871927809676271275775397027668605952496716674183485704422507197965004714951050492214776567636938" + _
"6629769795221107182645497347726624257094293225827985025855097852653832076067263171643095059950878075" + _
"2371033310119785754733154142180842754386359177811705430982748238504564801909561029929182431823752535" + _
"7709750539565187697510374970888692180205189339507238539205144634197265287286965110862571492198849978" + _
"748873771345686209167058"
CONST isBinary = "^0b([01]+(\.[01]*)?|\.[01]+)(p[+-]?\d+)?$"
CONST isHex = "^0x([0-9a-f]+(\.[0-9a-f]*)?|\.[0-9a-f]+)(p[+-]?\d+)?$"
CONST isOctal = "^0o([0-7]+(\.[0-7]*)?|\.[0-7]+)(p[+-]?\d+)?$"
CONST isDecimal = "^(\d+(\.\d*)?|\.\d+)(e[+-]?\d+)?$"
CONST LN10PRECISION = LENGTH(LN10) - 1
CONST PI = "3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679" + _
"8214808651328230664709384460955058223172535940812848111745028410270193852110555964462294895493038196" + _
"4428810975665933446128475648233786783165271201909145648566923460348610454326648213393607260249141273" + _
"7245870066063155881748815209209628292540917153643678925903600113305305488204665213841469519415116094" + _
"3305727036575959195309218611738193261179310511854807446237996274956735188575272489122793818301194912" + _
"9833673362440656643086021394946395224737190702179860943702770539217176293176752384674818467669405132" + _
"0005681271452635608277857713427577896091736371787214684409012249534301465495853710507922796892589235" + _
"4201995611212902196086403441815981362977477130996051870721134999999837297804995105973173281609631859" + _
"5024459455346908302642522308253344685035261931188171010003137838752886587533208381420617177669147303" + _
"5982534904287554687311595628638823537875937519577818577805321712268066130019278766111959092164201989" + _
"380952572010654858632789"
CONST PI_PRECISION = LENGTH(PI) - 1
DIM external = TRUE
DIM folderspec = "cache\decimal\"
//////////////////////////////
// メイン関数
//////////////////////////////
FUNCTION absoluteValue(x, isnumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IF x[0] < 0 THEN x[0] = 1
RESULT = finalise(x)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION ceil(x, isnumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = finalise(x, x[1] + 1, 2)
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION clampedTo(x, min, max, isNumeric = FALSE)
x = Constructor(x)
min = Constructor(min)
max = Constructor(max)
IFB !min[0] OR !max[0] THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
IFB gt(min, max) THEN
RESULT = ERR_VALUE
EXIT
ENDIF
k = cmp(x, min)
RESULT = IIF(k < 0, min, IIF(cmp(x, max) > 0, max, Constructor(x)))
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION comparedTo(x, y)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
y = IIF(VARTYPE(y) < 8192, Constructor(y), y)
xd = SLICE(x, 2)
yd = SLICE(IIF(VARTYPE(y) < 8192, Constructor(y), y), 2)
xs = x[0]
ys = y[0]
DIM xIsNum = CHKNUM(x[1])
DIM yIsNum = CHKNUM(y[1])
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// Either NaN or ±Infinity?
IFB (xIsNaN OR yIsNaN) OR(xIsInf OR yIsInf) THEN
IFB xIsNaN OR yIsNaN THEN
RESULT = "NaN"
ELSEIF xs <> ys THEN
RESULT = xs
ELSEIF JOIN(xd, "") = JOIN(yd, "") THEN
RESULT = 0
ELSEIF POWER(VARTYPE(!xd[0], VAR_INTEGER), IIF(xs < 0, 1, 0)) THEN
RESULT = 1
ELSE
RESULT = -1
ENDIF
EXIT
ENDIF
// Either zero?
IFB xIsZero OR yIsZero THEN
RESULT = IIF(xd[0], xs, IIF(yd[0], -1 * ys, 0))
EXIT
ENDIF
// Signs differ?
IFB xs <> ys THEN
RESULT = xs
EXIT
ENDIF
// Compare exponents.
IFB x[1] <> y[1] THEN
RESULT = IIF(bitXor(x[1] > y[1], xs < 0), 1, -1)
EXIT
ENDIF
xdL = LENGTH(xd)
ydL = LENGTH(yd)
// Compare digit by digit.
FOR i = 0 TO IIF(xdL < ydL, xdL, ydL) - 1
IFB xd[i] <> yd[i] THEN
RESULT = IIF(xd[i] > yd[i], 1, -1)
RESULT = IIF(xs < 0, -1 * RESULT, RESULT)
EXIT
ENDIF
NEXT
// Compare lengths.
RESULT = IIF(xdL = ydL, 0, IIF(xdL > POWER(ydL, xs) < 0, 1, -1))
FEND
FUNCTION cosine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("cosine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = Constructor(x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
xd = SLICE(x, 2)
IFB !LENGTH(xd) THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
// cos(0) = cos(-0) = 1
IFB !xd[0] THEN
RESULT = Constructor(1)
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = VAL(x[1]), sd(x)
precision = pr + large(array, 1) + LOG_BASE
rounding = 1
x = cosine2(Ctor, toLessThanHalfPi2(Ctor, x))
precision = pr
rounding = rm
RESULT = finalise(IIF(quadrant = 2 OR quadrant = 3, neg(x), x), pr, rm, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION cubeRoot(x, isnumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
rep = 0
IFB !isFinite(x) OR isZero(x) THEN
RESULT = Constructor(x)
EXIT
ENDIF
external = FALSE
// Initial estimate.
s = x[0] * POWER(x[0] * toString(x), 1/3)
// Math.cbrt underflow/overflow?
// Pass x to Math.pow as integer, then adjust the exponent of the result.
IFB !s OR ABS(s) = "INF" THEN
xd = SLICE(x, 2)
n = digitsToString(xd)
e = x[1]
// Adjust n exponent so it is a multiple of 3 away from x exponent.
s = e - LENGTH(n) + 1
IF s MOD 3 THEN n = n + IIF(s = 1 OR s = -2, "0", "00")
s = POWER(n, 1 / 3)
// Rarely, e may be one less than the result exponent value.
e = GLOBAL.floor((e + 1) / 3) - (e MOD 3 = IIF(e < 0, -1, 2))
IFB s = 1 / 0 THEN
n = "5e" + e
ELSE
n = toExponential(s)
n = COPY(n, 1, POS("e", n) + 1) + e
ENDIF
r = Constructor(n)
r[0] = x[0]
ELSE
r = Constructor(s)
ENDIF
e = precision
sd = e + 3
// Halley's method.
// TODO? Compare Newton's method.
m = NULL
WHILE TRUE
t = r
td = SLICE(t, 2)
t3 = times(times(t, t), t)
t3plusx = plus(t3, x)
r = divide(times(plus(t3plusx, x), t), plus(t3plusx, t3), sd + 2, 1)
rd = SLICE(r, 2)
// TODO? Replace with for-loop and checkRoundingDigits.
n = digitsToString(rd)
IFB COPY(digitsToString(td), 1, sd) = COPY(n, 1, sd) THEN
n = COPY(n, sd - 3 + 1, 4)
// The 4th rounding digit may be in error by -1 so if the 4 rounding digits are 9999 or 4999
// , i.e. approaching a rounding boundary, continue the iteration.
IFB n = "9999" OR !rep AND n = "4999" THEN
// On the first iteration only, check to see if rounding up gives the exact result as the
// nines may infinitely repeat.
IFB !rep THEN
t = finalise(t, e + 1, 0)
IFB eq(times(times(t, t), t), x) THEN
r = t
BREAK
ENDIF
ENDIF
sd = sd + 4
rep = 1
ELSE
// If the rounding digits are null, 0{0,4} or 50{0,3}, check for an exact result.
// If not, then there are further digits and m will be truthy.
IFB !n OR COPY(n, 2) AND COPY(n, 0) = "5" THEN
// Truncate to the first rounding digit.
finalise(r, e + 1, 1)
m = !eq(times(times(r, r), r), x)
ENDIF
BREAK
ENDIF
ENDIF
WEND
external = TRUE
RESULT = finalise(r, e, rounding, m)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION decimalPlaces(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
d = SLICE(x, 2)
n = "NaN"
IFB LENGTH(d) THEN
DIM w = LENGTH(d) - 1
n = (w - GLOBAL.floor(x[1] / LOG_BASE)) * LOG_BASE
// Subtract the number of trailing zeros of the last word.
w = d[w]
IFB w THEN
WHILE w MOD 10 = 0
n = n - 1
w = w / 10
WEND
ENDIF
IF n < 0 THEN n = 0
ENDIF
RESULT = n
FEND
FUNCTION dividedBy(dividend, divisor, pr = NULL, rm = NULL, dp = NULL, _base = NULL, isnumeric = FALSE)
x = IIF(VARTYPE(dividend) < 8192, Constructor(dividend), dividend)
y = IIF(VARTYPE(divisor) < 8192, Constructor(divisor), divisor)
DIM sign = IIF(x[0]=y[0], 1, -1)
xd = SLICE(x, 2)
yd = SLICE(y, 2)
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// Either NaN, Infinity or 0?
IFB xIsNaN OR yIsNaN OR xIsInf OR yIsInf OR xIsZero OR yIsZero THEN
// Return NaN if either NaN, or both Infinity or 0.
// x,yのどちらかNaNならばNaN、両方ともInfinityか0ならNaNを返す
IFB (xIsNaN OR yIsNaN) OR (xIsInf AND yIsInf) OR (xIsZero AND yIsZero) THEN
RESULT = "NaN"
// xが0、yが±∞ならば±0を返す
ELSEIF xIsZero OR yIsInf THEN
RESULT = 0
// yが0ならば±∞を返す
ELSEIF yIsZero THEN
RESULT = IIF(isNegative(x), "-", "") + "INF"
ENDIF
RESULT = Constructor(RESULT)
EXIT
ENDIF
IFB _base <> NULL THEN
logBase = 1
e = x[1] - y[1]
ELSE
_base = BASE
logBase = LOG_BASE
value1 = x[1] / logBase
value2 = y[1] / logBase
e = GLOBAL.floor(x[1] / logBase) - GLOBAL.floor(y[1] / logBase)
ENDIF
yL = LENGTH(yd)
xL = LENGTH(xd)
DIM q = SAFEARRAY(0, 1)
q[0] = sign
q[1] = 0
DIM qd[-1]
// Result exponent may be one less than e.
// The digit array of a Decimal from toStringBinary may have trailing zeros.
IFB LENGTH(yd) > LENGTH(xd) THEN
DIM tmp[LENGTH(yd)]
SETCLEAR(tmp, 0)
FOR i = 0 TO UBound(xd)
tmp[i] = xd[i]
NEXT
ELSE
tmp = xd
ENDIF
i = 0
WHILE yd[i] = tmp[i]
i = i + 1
IF i = LENGTH(yd) THEN BREAK
WEND
IFB UBound(xd) >= i AND UBound(yd) >= i THEN
bool = IIF(VAL(yd[i]) > VAL(xd[i]), TRUE, FALSE)
ELSE
bool = FALSE
ENDIF
IF bool THEN e = e - 1
IFB pr = NULL THEN
pr = precision
sd = pr
rm = rounding
ELSEIF dp <> NULL THEN
sd = pr + (x[1] - y[1]) + 1
ELSE
sd = pr
ENDIF
IFB sd < 0 THEN
arrayPush(qd, 1)
more = TRUE
ELSE
// Convert precision in number of base 10 digits to base 1e7 digits.
sd = INT(sd / logBase + 2)
i = 0
// divisor < 1e7
IFB yL = 1 THEN
k = 0
yd = yd[0]
sd = sd + 1
// k is the carry.
WHILE (i < xL OR k) AND VARTYPE(sd, VAR_BOOLEAN)
sd = sd - 1
IF sd < 0 THEN BREAK
IFB i > UBound(xd) THEN
t = k * _base + 0
ELSE
t = k * _base + VAL(xd[i])
ENDIF
RESIZE(qd, i)
qd[i] = INT(t / yd)
k = INT(t MOD yd)
i = i + 1
WEND
arrayMerge(q, qd)
more = k OR i < xL
ELSE
// Normalise xd and yd so highest order digit of yd is >= base/2
k = INT(base / (VAL(yd[0]) + 1))
IFB k > 1 THEN
yd = multiplyInteger(yd, k, base)
xd = multiplyInteger(xd, k, base)
yL = LENGTH(yd)
xL = LENGTH(xd)
ENDIF
xi = yl
rem = SLICE(xd, 0, yL - 1)
remL = LENGTH(rem)
// Add zeros to make remainder as long as divisor.
WHILE remL < yL
RESIZE(rem, remL)
rem[remL] = 0
remL = remL + 1
WEND
yz = SLICE(yd)
arrayUnshift(yz, 0)
yd0 = yd[0]
IF yd[1] >= base / 2 THEN yd0 = VAL(yd0) + 1
WHILE TRUE
k = 0
// Compare divisor and remainder.
cmp = compare(yd, rem, yL, remL)
// If divisor < remainder.
IFB cmp < 0 THEN
// Calculate trial digit, k.
rem0 = rem[0]
IF yL <> remL THEN rem0 = rem0 * _base + INT(rem[1])
// k will be how many times the divisor goes into the current remainder.
k = INT(rem0 / yd0)
IFB k > 1 THEN
IF k >= base THEN k = base - 1
// product = divisor * trial digit.
prod = multiplyInteger(yd, k, base)
prodL = LENGTH(prod)
remL = LENGTH(rem)
// Compare product and remainder.
cmp = compare(prod, rem, prodL, remL)
// product > remainder.
IFB cmp = 1 THEN
k = k - 1
// Subtract divisor from product.
subtract(prod, IIF(yL < prodL, yz, yd), prodL, base)
ENDIF
ELSE
IFB k = 0 THEN
k = 1
cmp = k
ENDIF
prod = SLICE(yd)
ENDIF
prodL = LENGTH(prod)
IF prodL < remL THEN arrayUnshift(prod, 0)
// Subtract product from remainder.
subtract(rem, prod, remL, base)
IFB cmp = -1 THEN
remL = LENGTH(rem)
cmp = compare(yd, rem, yL, remL)
IFB cmp < 1 THEN
k = k + 1
subtract(rem, IIF(yL < remL, yz, yd), remL, base)
ENDIF
ENDIF
remL = LENGTH(rem)
ELSEIF cmp = 0 THEN
k = k + 1
rem = SAFEARRAY(-1)
rem[0] = 0
ENDIF
IF LENGTH(qd) >= i THEN RESIZE(qd, i)
IF LENGTH(q) >= i+2 THEN RESIZE(q, i+2)
qd[i] = k
q[i+2] = k
i = i + 1
IFB VARTYPE(cmp, VAR_BOOLEAN) AND VARTYPE(rem[0], VAR_BOOLEAN) THEN
IF UBound(rem) < remL THEN RESIZE(rem, remL)
IFB xi > UBound(xd) THEN
rem[remL] = 0
ELSE
rem[remL] = xd[xi]
ENDIF
remL = remL + 1
ELSE
TRY
rem[0] = xd[xi]
EXCEPT
rem[0] = NULL
ENDTRY
remL = 1
ENDIF
IFB (xi < xL OR UBound(rem) > 0) AND VARTYPE(sd, VAR_BOOLEAN) THEN
xi = xi + 1
sd = sd - 1
ELSE
BREAK
ENDIF
WEND
more = IIF(rem[0]<>NULL, TRUE, FALSE)
ENDIF
IFB !qd[0] THEN
arrayShift(qd)
RESIZE(q, 1)
arrayMerge(q, qd)
ENDIF
ENDIF
// logBase is 1 when divide is being used for base conversion.
IFB logBase = 1 THEN
q[1] = e
inexact = more
RESULT = SLICE(q)
EXIT
ELSE
// To calculate q.e, first get the number of digits of qd[0].
i = 1
k = qd[0]
WHILE k >= 10
k = k / 10
i = i + 1
WEND
q[1] = i + e * logBase - 1
q = SLICE(q)
dp = IIF(dp = NULL, FALSE, dp)
RESULT = finalise(q, IIF(dp, pr + q[1] + 1, pr), rm, more)
IFB external THEN
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
ELSE
RESULT = SLICE(RESULT)
ENDIF
EXIT
ENDIF
FEND
FUNCTION dividedToIntegerBy(x, y, isNumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
y = IIF(VARTYPE(y) < 8192, Constructor(y), y)
RESULT = finalise(divide(x, y, 0, 1, 1), precision, rounding)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION equals(x, y)
RESULT = cmp(x, y) = 0
FEND
FUNCTION floor(x, isnumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = finalise(x, x[1] + 1, 3)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION greaterThan(x, y)
RESULT = cmp(x, y) > 0
FEND
FUNCTION greaterThanOrEqualTo(x, y)
k = cmp(x, y)
RESULT = VARTYPE(k = 1 OR k = 0, VAR_BOOLEAN)
FEND
FUNCTION hyperbolicCosine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("hyperbolicCosine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
one = Constructor(1)
IFB !isFinite(x) THEN
RESULT = IIF(x[0], "INF", "NaN")
EXIT
ENDIF
IFB isZero(x) THEN
RESULT = one
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = x[1], sd(x)
precision = pr + large(array, 1) + 4
rounding = 1
xd = SLICE(x, 2)
len = LENGTH(xd)
// Argument reduction: cos(4x) = 1 - 8cos^2(x) + 8cos^4(x) + 1
// i.e. cos(x) = 1 - cos^2(x/4)(8 - 8cos^2(x/4))
// Estimate the optimum number of times to use the argument reduction.
// TODO? Estimation reused from cosine() and may not be optimal here.
IFB len < 32 THEN
k = GLOBAL.CEIL(len / 3)
n = "" + (1 / tinyPow(4, k))
ELSE
k = 16
n = "2.3283064365386962890625e-10"
ENDIF
x = taylorSeries(Ctor, 1, times(x, n), Constructor(1), TRUE)
// Reverse argument reduction
i = k
d8 = Constructor(8)
WHILE i > 0
i = i - 1
cosh2x = times(x, x, NULL)
x = times(cosh2x, d8, NULL)
x = minus(d8, x, NULL)
x = times(cosh2x, x, NULL)
x = minus(one, x, NULL)
WEND
precision = pr
rounding = rm
RESULT = finalise(x, precision, rounding, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION hyperbolicSine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("hyperbolicSine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
IFB !isFinite(x) OR isZero(x) THEN
RESULT = Constructor(x)
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = x[1], sd(x)
precision = pr + large(array, 1) + 4
rounding = 1
xd = SLICE(x, 2)
len = LENGTH(xd)
IFB len < 3 THEN
x = taylorSeries(Ctor, 2, x, x, TRUE)
ELSE
// Alternative argument reduction: sinh(3x) = sinh(x)(3 + 4sinh^2(x))
// i.e. sinh(x) = sinh(x/3)(3 + 4sinh^2(x/3))
// 3 multiplications and 1 addition
// Argument reduction: sinh(5x) = sinh(x)(5 + sinh^2(x)(20 + 16sinh^2(x)))
// i.e. sinh(x) = sinh(x/5)(5 + sinh^2(x/5)(20 + 16sinh^2(x/5)))
// 4 multiplications and 2 additions
// Estimate the optimum number of times to use the argument reduction.
k = 1.4 * GLOBAL.SQRT(len)
k = IIF(k > 16, 16, INT(k))
x = times(x, 1 / tinyPow(5, k), NULL)
x = taylorSeries(2, x, x, TRUE)
// Reverse argument reduction
d5 = Constructor(5)
d16 = Constructor(16)
d20 = Constructor(20)
WHILE k > 0
k = k - 1
sinh2x = times(x, x)
x = times(x, plus(d5, times(sinh2x, plus(times(d16, sinh2x), d20))))
WEND
ENDIF
precision = pr
rounding = rm
RESULT = finalise(x, pr, rm, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION hyperbolicTangent(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("hyperbolicTangent,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB !isFinite(x) THEN
RESULT = Constructor(x[0])
EXIT
ENDIF
IFB isZero(x) THEN
RESULT = Constructor(x)
EXIT
ENDIF
pr = precision
rm = rounding
precision = pr + 7
rounding = 1
precision = pr
rounding = rm
RESULT = finalise(divide(sinh(x), cosh(x), pr, rm))
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION inverseCosine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("hyperbolicTangent,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
k = cmp(absoluteValue(x), 1)
pr = precision
rm = rounding
IFB k <> -1 THEN
RESULT = IIF(k = 0, IIF(isNeg(x), getPi(Ctor, pr, rm), Constructor(0)), Constructor("NaN"))
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
IFB isZero(x) THEN
RESULT = times(getPi(Ctor, pr + 4, rm), 0.5, NULL)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
// TODO? Special case acos(0.5) = pi/3 and acos(-0.5) = 2*pi/3
precision = pr + 6
rounding = 1
x = asin(x)
halfPi = times(getPi(Ctor, pr + 4, rm), 0.5)
precision = pr
rounding = rm
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
RESULT = minus(halfPi, x)
FEND
FUNCTION inverseHyperbolicCosine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("inverseHyperbolicCosine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB lte(x, 1) THEN
RESULT = Constructor(IIF(eq(x, 1), 0, "NaN"))
EXIT
ENDIF
IFB !isFinite(x) THEN
RESULT = Constructor(x)
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = absoluteValue(x[1]), sd(x)
precision = pr + large(array, 1) + 4
rounding = 1
external = FALSE
x = plus(squareRoot(minus(times(x, x, NULL), "1", NULL)), x, NULL)
external = TRUE
precision = pr
rounding = rm
RESULT = naturalLogarithm(x, NULL, NULL)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION inverseHyperbolicSine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("inverseHyperbolicSine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB !isFinite(x) OR isZero(x) THEN
RESULT = Constructor(x)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = absoluteValue(x[1]), sd(x)
precision = pr + 2 * large(array, 1) + 6
rounding = 1
external = FALSE
x = plus(squareRoot(plus(times(x, x), 1)), x)
external = TRUE
precision = pr
rounding = rm
RESULT = naturalLogarithm(x, NULL, NULL)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION inverseHyperbolicTangent(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("inverseHyperbolicTangent,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB !isFinite(x) THEN
RESULT = Constructor("NaN")
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
IFB x[1] >= 0 THEN
RESULT = Constructor(IIF(eq(absoluteValue(x), 1), x[0] + "INF", IIF(isZero(x), x, "NaN")))
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
pr = precision
rm = rounding
xsd = sd(x)
DIM array[] = xsd, pr
IFB large(array, 1) < 2 * (-1 * x[1]) - 1 THEN
RESULT = finalise(Constructor(x), pr, rm, TRUE)
EXIT
ENDIF
wpr = xsd - x[1]
precision = wpr
x = divide(plus(x, 1, NULL), minus(Constructor(1), x, NULL), wpr + pr, 1)
precision = pr + 4
rounding = 1
x = naturalLogarithm(Constructor(x))
precision = pr
rounding = rm
RESULT = times(x, 0.5, NULL)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION inverseSine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("inverseSine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
IFB isZero(x) THEN
RESULT = Constructor(x)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
k = cmp(THIS.abs(x), 1)
pr = precision
rm = rounding
IFB k <> -1 THEN
// |x| is 1
IFB k = 0 THEN
halfPi = times(getPi(Ctor, pr + 4, rm), 0.5)
halfPi[0] = x[0]
RESULT = halfPi
ELSE
// |x| > 1 or x is NaN
RESULT = Constructor("NaN")
EXIT
ENDIF
ENDIF
// TODO? Special case asin(1/2) = pi/6 and asin(-1/2) = -pi/6
precision = pr + 6
rounding = 1
tmp = squareRoot(minus(Constructor(1), times(x, x, NULL), NULL), NULL)
tmp = plus(tmp, 1, NULL)
x = div(x, tmp, NULL, NULL, NULL, NULL, NULL)
x = atan(x)
precision = pr
rounding = rm
RESULT = times(x, 2, NULL)
IF isNumeric = NULL THEN EXIT
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION inverseTangent(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("inverseTangent,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
pr = precision
rm = rounding
IFB !isFinite(x) THEN
IFB !x[0] THEN
RESULT = Constructor("NaN")
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
IFB pr + 4 <= PI_PRECISION THEN
r = times(getPi(Ctor, pr + 4, rm), 0.5)
r[0] = x[0]
RESULT = r
EXIT
ENDIF
ELSEIF isZero(x) THEN
RESULT = Constructor(x)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ELSEIF eq(absoluteValue(x), 1) AND pr + 4 <= PI_PRECISION THEN
r = times(getPi(Ctor, pr + 4, rm), 0.25)
RESULT = r
ENDIF
wpr = pr + 10
precision = wpr
rounding = 1
// TODO? if (x >= 1 && pr <= PI_PRECISION) atan(x) = halfPi * x.s - atan(1 / x);
// Argument reduction
// Ensure |x| < 0.42
// atan(x) = 2 * atan(x / (1 + sqrt(1 + x^2)))
DIM array[] = 28, INT(wpr / LOG_BASE + 2)
k = small(array, 1)
i = k
WHILE i > 0
i = i - 1
tmp = times(x, x, NULL)
tmp = plus(tmp, 1, NULL)
tmp = squareRoot(tmp, NULL)
tmp = plus(tmp, 1, NULL)
x = div(x, tmp, NULL, NULL, NULL, NULL, NULL)
WEND
external = FALSE
j = CEIL(wpr / LOG_BASE)
n = 1
x2 = times(x, x, NULL)
r = Constructor(x)
px = x
// atan(x) = x - x^3/3 + x^5/5 - x^7/7 + ...
WHILE i <> -1
px = times(px, x2)
n = n + 2
tmp = div(px, n, NULL, NULL, NULL, NULL, NULL)
t = minus(r, div(px, n, NULL, NULL, NULL, NULL, NULL), NULL)
td = SLICE(t, 2)
px = times(px, x2, NULL)
n = n + 2
r = plus(t, div(px, n, NULL, NULL, NULL, NULL, NULL), NULL)
rd = SLICE(r, 2)
IFB UBound(rd) >= j THEN
i = j
WHILE i >= 0 AND rd[i] = td[i]
i = i - 1
IF i = -1 THEN BREAK
WEND
ENDIF
WEND
IF k <> 0 THEN r = times(r, POWER(2, k))
external = TRUE
precision = pr
rounding = rm
RESULT = finalise(r, precision, rounding, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION isFinite(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = IIF(x[1] <> NULL, TRUE, FALSE)
FEND
FUNCTION isInteger(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = VARTYPE(LENGTH(x) >= 3 AND GLOBAL.floor(x[1] / LOG_BASE) > LENGTH(x) - 2 - 2, VAR_BOOLEAN)
FEND
FUNCTION isNaN(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = IIF(x[0] = NULL, TRUE, FALSE)
FEND
FUNCTION isNegative(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = IIF(x[0] < 0, TRUE, FALSE)
FEND
FUNCTION isPositive(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = IIF(x[0] > 0, TRUE, FALSE)
FEND
FUNCTION isZero(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = VARTYPE(VARTYPE(x[2]) = 5 AND x[2] = 0, VAR_BOOLEAN)
FEND
FUNCTION lessThan(x, y)
RESULT = cmp(x, y) < 0
FEND
FUNCTION lessThanOrEqualTo(x, y)
RESULT = cmp(x, y) < 1
FEND
FUNCTION logarithm(x, base = NULL, isNumeric = FALSE)
arg = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
pr = precision
rm = rounding
guard = 5
// Default base is 10.
IFB base = NULL THEN
base = Constructor(10)
isBase10 = TRUE
ELSE
base = Constructor(base)
d = SLICE(base, 2)
// Return NaN if base is negative, or non-finite, or is 0 or 1.
IFB VAL(base[0]) < 0 OR LENGTH(d) >= 2 OR eq(base, 1) THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
isBase10 = eq(base, 10)
ENDIF
d = SLICE(arg, 2)
// The result will have a non-terminating decimal expansion if base is 10 and arg is not an
// integer power of 10.
inf = FALSE
IFB isBase10 THEN
IFB LENGTH(d) > 1 THEN
inf = TRUE
ELSE
k = d[0]
WHILE k MOD 10 = 0
k = k / 10
WEND
inf = k <> 1
ENDIF
ENDIF
external = FALSE
sd = pr + guard
num = naturalLogarithm(arg, sd)
IFB isBase10 THEN
denominator = getLn10(Ctor, sd + 10)
ELSE
denominator = naturalLogarithm(base, sd)
ENDIF
// The result will have 5 rounding digits.
r = divide(num, denominator, sd, 1)
rd = SLICE(r, 2)
// If at a rounding boundary, i.e. the result's rounding digits are [49]9999 or [50]0000,
// calculate 10 further digits.
//
// If the result is known to have an infinite decimal expansion, repeat this until it is clear
// that the result is above or below the boundary. Otherwise, if after calculating the 10
// further digits, the last 14 are nines, round up and assume the result is exact.
// Also assume the result is exact if the last 14 are zero.
//
// Example of a result that will be incorrectly rounded:
// log[1048576](4503599627370502) = 2.60000000000000009610279511444746...
// The above result correctly rounded using ROUND_CEIL to 1 decimal place should be 2.7, but it
// will be given as 2.6 as there are 15 zeros immediately after the requested decimal place, so
// the exact result would be assumed to be 2.6, which rounded using ROUND_CEIL to 1 decimal
// place is still 2.6.
k = pr
IFB checkRoundingDigits(rd, pr, rm) THEN
REPEAT
sd = sd + 10
num = naturalLogarithm(arg, sd)
denominator = IIF(isBase10, getLn10(Ctor, sd + 10), naturalLogarithm(base, sd))
r = divide(num, denominator, sd, 1)
rd = SLICE(r, 2)
IFB !inf THEN
// Check for 14 nines from the 2nd rounding digit, as the first may be 4.
IFB VAL(COPY(digitsToString(rd), k + 2, 14)) + 1 = 1E+14 THEN
r = finalise(r, pr + 1, 0)
ENDIF
BREAK
ENDIF
k = k + 10
UNTIL !(checkRoundingDigits(rd, k, rm))
ENDIF
external = TRUE
RESULT = finalise(r, pr, rm)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION minus(minuend, subtrahend, isnumeric = FALSE)
x = IIF(VARTYPE(minuend) < 8192, Constructor(minuend), minuend)
y = IIF(VARTYPE(subtrahend) < 8192, Constructor(subtrahend), subtrahend)
DIM xIsNum = CHKNUM(x[1])
DIM yIsNum = CHKNUM(y[1])
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// If either is not finite...
IFB !xIsNum OR !yIsNum THEN
// Return NaN if either is NaN
// どちらかがNaNならばNaNを返す
IFB xIsNaN OR yIsNaN THEN
RESULT = "NaN"
// Return y negated if x is finite and y is ±Infinity.
// xが有限値でyが無限値ならばyを否定して返す
ELSEIF !xIsInf AND yIsInf THEN
y[0] = -1 * y[0]
RESULT = finiteToString(y)
// Return x if y is finite and x is ±Infinity.
// yが有限値でxが無限値ならばxを返す
ELSEIF yIsNum AND xIsInf THEN
RESULT = finiteToString(x)
// Return x if both are ±Infinity with different signs.
// 両方とも±∞で符号が違うならばxを返す
ELSEIF x[0] <> y[0] AND xIsInf AND yIsInf THEN
RESULT = finiteToString(x)
// Return NaN if both are ±Infinity with the same sign.
// 両方とも±∞で符号が同じならばNaNを返す
ELSEIF x[0] = y[0] AND xIsInf AND yIsInf THEN
RESULT = "NaN"
ENDIF
EXIT
ENDIF
// If signs differ...
IFB x[0] <> y[0] THEN
y[0] = -1 * y[0]
// x = finalise(x, pr, rm)
// y = finalise(y, pr, rm)
RESULT = Decimal.plus(x, y, isnumeric)
EXIT
ENDIF
xd = SLICE(x, 2)
yd = SLICE(y, 2)
pr = precision
rm = rounding
// If either is zero...
IFB !xd[0] OR !yd[0] THEN
// Return y negated if x is zero and y is non-zero.
IFB yd[0] THEN
y[0] = -1 * y[0]
// Return x if y is zero and x is non-zero.
ELSEIF xd[0] THEN
y = x
// Return zero if both are zero.
// From IEEE 754 (2008) 6.3: 0 - 0 = -0 - -0 = -0 when rounding to -Infinity.
ELSE
RESULT = 0
EXIT
ENDIF
RESULT = IIF(external, finalise(y, pr, rm), y)
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
// Calculate base 1e7 exponents.
e = GLOBAL.floor(y[1] / LOG_BASE)
xe = GLOBAL.floor(x[1] / LOG_BASE)
k = xe - e
// If base 1e7 exponents differ...
IFB k <> 0 THEN
xLTy = k < 0
IFB xLTy THEN
d = SLICE(xd)
k = -1 * k
len = LENGTH(yd)
ELSE
d = SLICE(yd)
e = xe
len = LENGTH(xd)
ENDIF
DIM tmp[] = CEIL(pr / LOG_BASE), len
i = CALCARRAY(tmp, CALC_MAX) + 2
IFB k > i THEN
k = i
RESIZE(d, 1)
ENDIF
// Prepend zeros to equalise exponents.
arrayReverse(d)
i = k - 1
WHILE i >= 0
arrayPush(d, 0)
i = i - 1
WEND
arrayReverse(d)
// copy
IFB xLTy THEN
xd = SLICE(d)
ELSE
yd = SLICE(d)
ENDIF
ELSE
// Check digits to determine which is the bigger number.
i = LENGTH(x) - 2
len = LENGTH(y) - 2
xLTy = i < len
IF xLTy <> 0 THEN len = i
FOR i = 0 TO len - 1
IFB VAL(xd[i]) <> VAL(yd[i]) THEN
xLTy = VAL(xd[i]) < VAL(yd[i])
BREAK
ENDIF
NEXT
k = 0
ENDIF
IFB xLTy <> 0 THEN
d = SLICE(xd)
xd = SLICE(yd)
yd = SLICE(d)
y[0] = -1 * y[0]
ENDIF
len = LENGTH(xd)
// Append zeros to `xd` if shorter.
// Don't add zeros to `yd` if shorter as subtraction only needs to start at `yd` length.
i = LENGTH(yd) - len
WHILE i > 0
arrayPush(xd, 0)
len = len + 1
i = i - 1
WEND
// Subtract yd from xd.
i = LENGTH(yd)
WHILE i > k
i = i - 1
IFB VAL(xd[i]) < VAL(yd[i]) THEN
j = i
j = j - 1
WHILE VARTYPE(j+1, VAR_BOOLEAN) AND VARTYPE(xd[j] = 0, VAR_BOOLEAN)
xd[j] = BASE - 1
j = j - 1
WEND
xd[j] = VAL(xd[j] )- 1
xd[i] = VAL(xd[i]) + BASE
ENDIF
xd[i] = VAL(xd[i]) - VAL(yd[i])
WEND
// Remove trailing zeros.
len = LENGTH(xd)
WHILE len > 0
IFB xd[len - 1] = 0 THEN
arrayPop(xd)
len = LENGTH(xd)
ELSE
BREAK
ENDIF
WEND
// Remove leading zeros and adjust exponent accordingly.
IFB LENGTH(xd) <> 0 THEN
WHILE xd[0] = 0
arrayShift(xd)
e = e - 1
WEND
ENDIF
// Zero?
IFB LENGTH(xd) = 0 THEN
RESULT = Constructor(IIF(rm=3, -0, 0))
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
RESIZE(y, 1)
arrayMerge(y, xd)
y[1] = getBase10Exponent(xd, e)
IFB external THEN
RESULT = finalise(y, pr, rm)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
ELSE
RESULT = SLICE(y)
ENDIF
FEND
FUNCTION modulo(x, y)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
y = IIF(VARTYPE(y) < 8192, Constructor(y), y)
DIM xIsNum = CHKNUM(x[1])
DIM yIsNum = CHKNUM(y[1])
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// Return NaN if x is ±Infinity or NaN, or y is NaN or ±0.
IFB (xIsInf OR xIsNaN) OR (yIsNaN OR yIsZero) THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
// Prevent rounding of intermediate calculations.
external = FALSE
IFB modulo = 9 THEN
// Euclidian division: q = sign(y) * floor(x / abs(y))
// result = x - q * y where 0 <= result < abs(y)
q = divide(x, absoluteValue(y), 0, 3, 1)
q[0] = q[0] * y[0]
ELSE
q = divide(x, y, 0, modulo, 1)
ENDIF
q = times(q, y)
external = TRUE
RESULT = minus(x, q)
FEND
FUNCTION negated(x, isNumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
x[0] = -1 * x[0]
RESULT = finalise(x)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION plus(augend, addend, isnumeric = FALSE)
x = IIF(VARTYPE(augend) < 8192, Constructor(augend), augend)
y = IIF(VARTYPE(addend) < 8192, Constructor(addend), addend)
DIM xIsNum = CHKNUM(x[1])
DIM yIsNum = CHKNUM(y[1])
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// If either is not finite...
IFB !xIsNum OR !yIsNum THEN
// Return NaN if either is NaN.
// どちらかがNaNならばNaNを返す
IFB xIsNaN OR yIsNaN THEN
RESULT = "NaN"
// Return x if y is finite and x is ±Infinity.
// yが有限でxが±∞ならばxを返す
ELSEIF yIsNum AND xIsInf THEN
RESULT = finiteToString(x)//IIF(isNegative(x), "-", "") + "INF"
// Return x if both are ±Infinity with the same sign.
// 両方とも±∞で符号が同じならばxを返す
ELSEIF x[0] = y[0] AND xIsInf AND yIsInf THEN
RESULT = finiteToString(x)//IIF(isNegative(x), "-", "") + "INF"
// Return NaN if both are ±Infinity with different signs.
// 両方とも±∞で符号が違うならばNaNを返す
ELSEIF x[0] <> y[0] AND xIsInf AND yIsInf THEN
RESULT = "NaN"
// Return y if x is finite and y is ±Infinity.
// xが有限でyが±∞ならばyを返す
ELSEIF xIsNum AND yIsInf THEN
RESULT = "INF"//finiteToString(y)//IIF(isNegative(y), "-", "") + "INF"//toString(finalise(y, pr, rm))
ENDIF
RESULT = Constructor(RESULT)
EXIT
ENDIF
// If signs differ...
IFB x[0] <> y[0] THEN
y[0] = -1 * y[0]
RESULT = Decimal.minus(x, y, isnumeric)
EXIT
ENDIF
xd = SLICE(x, 2)
yd = SLICE(y, 2)
pr = precision
rm = rounding
// If either is zero...
IFB !xd[0] OR !yd[0] THEN
IF !yd[0] THEN y = x
RESULT = IIF(external, finalise(y, pr, rm), y)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
// Calculate base 1e7 exponents.
// value = x[1]/LOG_BASE
// k = INT(value) + IIF(value<0 AND value <> INT(value), -1, 0)
// value = y[1]/LOG_BASE
// e = INT(value) + IIF(value<0 AND value- INT(value) <> 0, -1, 0)
k = GLOBAL.floor(x[1] / LOG_BASE)
e = GLOBAL.floor(y[1] / LOG_BASE)
i = k - e
// If base 1e7 exponents differ
IFB i <> 0 THEN
IFB i < 0 THEN
DIM d = SLICE(xd)
i = -1 * i
len = LENGTH(yd)
flg = TRUE
ELSE
d = SLICE(yd)
e = k
len = LENGTH(xd)
flg = FALSE
ENDIF
// Limit number of zeros prepended to max(ceil(pr / LOG_BASE), len) + 1.
k = CEIL(pr/LOG_BASE)
len = IIF(k > len, k + 1, len + 1)
// i = LENGTH(yd)
//TEXTBLOCK
IFB i > len THEN
i = len
RESIZE(d, 1)
ENDIF
//ENDTEXTBLOCK
// Prepend zeros to equalise exponents. Note: Faster to use reverse then do unshifts.
arrayReverse(d)
WHILE i > 0
arrayPush(d, 0)
i = i - 1
WEND
arrayReverse(d)
// copy
IFB flg THEN
xd = SLICE(d)
ELSE
yd = SLICE(d)
ENDIF
ENDIF
len = LENGTH(xd)
i = LENGTH(yd)
// If yd is longer than xd, swap xd and yd so xd points to the longer array.
IFB len - i < 0 THEN
i = len
d = SLICE(yd)
yd = SLICE(xd)
xd = SLICE(d)
ENDIF
// Only start adding at yd.length - 1 as the further digits of xd can be left as they are.
DIM carry = 0
WHILE i > 0
i = i - 1
xd[i] = VAL(xd[i]) + VAL(yd[i]) + carry
carry = INT(xd[i] / BASE)
xd[i] = xd[i] MOD BASE
WEND
IFB carry THEN
// xd.unshift(carry)
arrayUnshift(xd, carry)
e = e + 1
ENDIF
// Remove trailing zeros.
// No need to check for zero, as +x + +y != 0 && -x + -y != 0 RESULT = ERR_VALUE
len = LENGTH(xd)
WHILE len > 0
IFB xd[len - 1] = 0 THEN
arrayPop(xd)
len = LENGTH(xd)
ELSE
BREAK
ENDIF
WEND
RESIZE(y, 1)
arrayMerge(y, xd)
y[1] = getBase10Exponent(xd, e)
IFB external THEN
RESULT = finalise(y, pr, rm)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
ELSE
RESULT = SLICE(y)
ENDIF
FEND
FUNCTION precision(x, z = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
xd = SLICE(x, 2)
IFB LENGTH(xd) THEN
k = getPrecision(xd)
IFB z <> NULL THEN
IF z AND x[1] + 1 > k THEN k = x[1] + 1
ENDIF
ELSE
k = "NaN"
ENDIF
RESULT = k
FEND
FUNCTION round(x, isNumeric = FALSE)
x = Constructor(x)
RESULT = finalise(x, x[1] + 1, rounding)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION sine(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("sine,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
IFB !isFinite(x) THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
IFB isZero(x) THEN
RESULT = Constructor(x)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
pr = precision
rm = rounding
DIM array[] = x[1], sd(x)
precision = pr + CALCARRAY(array, CALC_MAX) + LOG_BASE
rounding = 1
x = sine2(Ctor, toLessThanHalfPi(Ctor, x))
precision = pr
rounding = rm
RESULT = finalise(IIF(quadrant > 2, neg(x), x), pr, rm, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION squareRoot(x, isNumeric = FALSE)
x = Constructor(x)
d = SLICE(x, 2)
e = x[1]
s = x[0]
DIM xIsNum = CHKNUM(x[1])
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
// Negative/NaN/Infinity/zero?
IFB s <> 1 OR xIsNaN OR xIsInf OR xIsZero THEN
RESULT = Constructor(IIF(!s OR s < 0 AND (!d OR d[0]), "NaN", IIF(d, x, 1 / 0)))
ENDIF
external = FALSE
// Initial estimate.
n = finiteToString(x)
// s = GLOBAL.SQRT(n)
DIM SC = CREATEOLEOBJ("ScriptControl")
SC.Language = "JScript"
s = SC.Eval("Math.sqrt(" + n + ").toPrecision(16)")
//s = 4.898979485566356//GLOBAL.SQRT(VAL(JOIN(d, "")))
// Math.sqrt underflow/overflow?
// Pass x to Math.sqrt as integer, then adjust the exponent of the result.
IFB s = 0 OR s = 1 / 0 THEN
n = digitsToString(d)
IF (LENGTH(n) + e) MOD 2 = 0 THEN n = n + "0"
s = GLOBAL.SQRT(n)
e = floor((e + 1) / 2) - (e < 0 OR e MOD 2)
IFB s = 1 / 0 THEN
n = "5E" + e
ELSE
n = toExponential(s)
n = SLICE(n, 1, POS("e", n) + 1) + e
ENDIF
r = Constructor(n)
ELSE
r = Constructor("" + s)
ENDIF
e = precision
sd = e + 3
// Newton-Raphson iteration.
rep = FALSE
WHILE TRUE
t = r
td = SLICE(t, 2)
// tmp = divide(x, t, sd + 2, 1)
// tmp = plus(t, tmp)
// r = times(tmp, 0.5)
r = times(plus(t, divide(x, t, sd + 2, 1)), 0.5)
rd = SLICE(r, 2)
// TODO? Replace with for-loop and checkRoundingDigits.
n = digitsToString(rd)
m = COPY(digitsToString(td), 1, sd)
IFB m = COPY(n, 1, sd) THEN
n = COPY(n, sd - 3 + 1, 4)
// The 4th rounding digit may be in error by -1 so if the 4 rounding digits are 9999 or
// 4999, i.e. approaching a rounding boundary, continue the iteration.
IFB n = "9999" OR !rep AND n = "4999" THEN
// On the first iteration only, check to see if rounding up gives the exact result as the
// nines may infinitely repeat.
IFB !rep THEN
finalise(t, e + 1, 0)
IFB eq(times(t, t), x) THEN
r = t
BREAK
ENDIF
ENDIF
sd = sd + 4
rep = 1
ELSE
// If the rounding digits are null, 0{0,4} or 50{0,3}, check for an exact result.
// If not, then there are further digits and m will be truthy.
IFB n <> 0 OR COPY(n, 2) <> "0" AND COPY(n, 1, 1) = "5" THEN
// Truncate to the first rounding digit.
finalise(r, e + 1, 1)
m = !eq(times(r, r), x)
ENDIF
BREAK
ENDIF
ENDIF
WEND
external = TRUE
RESULT = finalise(r, e, rounding, m)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION tangent(x, isNumeric = FALSE)
IFB isDecimalInstance(x) THEN
str = toString(x)
ELSE
str = x
ENDIF
DIM filename = Hash.sha256("tangent,x=" + str)
DIM path = folderspec + filename
IFB FOPEN(path, F_EXISTS) THEN
DIM FID = FOPEN(path, F_READ)
str = VARTYPE(FGET(FID, 1), 258)
RESULT = Constructor(str)
FCLOSE(FID)
ELSE
x = Constructor(x)
IFB !isFinite(x) THEN
RESULT = Constructor("NaN")
EXIT
ENDIF
IFB isZero(x) THEN
RESULT = Constructor(x)
EXIT
ENDIF
pr = precision
rm = rounding
precision = pr + 10
rounding = 1
x = sine(x, NULL)
x[0] = 1
tmp = times(x, x, NULL)
tmp = minus(1, tmp, NULL)
tmp = THIS.sqrt(tmp, NULL)
x = divide(x, tmp)
// x = divide(x, squareRoot(minus(Constructor(1), times(x, x))), pr + 10, 0)
precision = pr
rounding = rm
RESULT = finalise(IIF(quadrant = 2 OR quadrant = 4, neg(x), x), pr, rm, TRUE)
CreateFolders(folderspec)
FID = FOPEN(path, F_READ OR F_WRITE8)
FPUT(FID, toString(RESULT))
FCLOSE(FID)
ENDIF
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION times(multiplicand, multiplier, isnumeric = FALSE)
x = IIF(VARTYPE(multiplicand) < 8192, Constructor(multiplicand), multiplicand)
y = IIF(VARTYPE(multiplier) < 8192, Constructor(multiplier), multiplier)
xd = SLICE(x, 2)
yd = SLICE(y, 2)
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
IFB xIsNaN OR yIsNan THEN
y[0] = "NaN"
ELSE
y[0] = y[0] * x[0]
ENDIF
// If either is NaN, ±Infinity or ±0...
IFB (xIsNaN OR yIsNaN) OR (xIsInf OR yIsInf) OR (xIsZero OR yIsZero) THEN
// Return NaN if either is NaN.
// どちらかがNaNならばNaNを返す
IFB xIsNaN OR yIsNaN THEN
RESULT = "NaN"
// Return NaN if x is ±0 and y is ±Infinity, or y is ±0 and x is ±Infinity.
// xが±0、yが±無限大、もしくはyが±0、xが±無限大ならばNaNを返す
ELSEIF (xIsZero AND yIsInf) OR (yIsZero AND xIsInf) THEN
RESULT = "NaN"
// Return ±Infinity if either is ±Infinity.
// どちらかが±無限大ならば±無限大を返す
ELSEIF xIsInf OR yIsInf THEN
RESULT = "INF"
// Return ±0 if either is ±0.
// どちらかが±0ならば±0を返す
ELSEIF xIsZero OR yIsZero THEN
RESULT = "0"
ENDIF
RESULT = Constructor(RESULT)
IF isNumeric = NULL THEN EXIT
RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
e = GLOBAL.floor(x[1] / LOG_BASE) + GLOBAL.floor(y[1] / LOG_BASE)
xdL = LENGTH(xd)
ydL = LENGTH(yd)
// Ensure xd points to the longer array.
IFB xdL < ydL THEN
r = SLICE(xd)
xd = SLICE(yd)
yd = SLICE(r)
rL = xdL
xdL = ydL
ydL = rL
ENDIF
// Initialise the result array with zeros.
DIM r[-1]
rL = xdL + ydL
i = rL
WHILE i > 0
arrayPush(r, 0)
i = i - 1
WEND
// Multiply!
i = ydL
WHILE i > 0
i = i - 1
carry = 0
k = xdL + i
WHILE k > i
t = VAL(r[k]) + VAL(yd[i]) * VAL(xd[k-i-1]) + carry
r[k] = t MOD BASE
k = k - 1
carry = INT(t / BASE)
WEND
r[k] = (r[k] + carry) MOD BASE
WEND
// Remove trailing zeros.
rL = rL - 1
WHILE r[rL] = 0
arrayPop(r)
rL = rL - 1
WEND
IFB carry <> 0 THEN
e = e + 1
ELSE
arrayShift(r)
ENDIF
RESIZE(y, 1)
arrayMerge(y, r)
y[1] = getBase10Exponent(r, e)
IFB external THEN
RESULT = finalise(y, precision, rounding)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
ELSE
RESULT = SLICE(y)
ENDIF
FEND
FUNCTION toBinary(x, sd = NULL, rm = NULL)
RESULT = toStringBinary(x, 2, sd, rm)
FEND
FUNCTION toDecimalPlaces(x, dp = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB dp = NULL THEN
RESULT = SLICE(x)
RESULT = toString(RESULT)
EXIT
ENDIF
checkInt32(dp, 0, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
RESULT = finiteToString(finalise(x, dp + x[1] + 1, rm))
FEND
FUNCTION toExponential(x, dp = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB dp = NULL THEN
str = finiteToString(x, TRUE)
ELSE
checkInt32(dp, 0, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
x = finalise(Constructor(x), dp + 1, rm)
str = finiteToString(x, TRUE, dp + 1)
ENDIF
RESULT = IIF(isNeg(x) AND !isZero(x), "-" + str, str)
FEND
FUNCTION toFixed(x, dp = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB dp = NULL THEN
str = finiteToString(x)
ELSE
checkInt32(dp, 0, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
y = finalise(Constructor(x), dp + x[1] + 1, rm)
str = finiteToString(y, FALSE, dp + y[1] + 1)
ENDIF
// To determine whether to add the minus sign look at the value before it was rounded,
// i.e. look at `x` rather than `y`.
RESULT = IIF(isNeg(x) AND !isZero(x), "-" + str, str)
FEND
FUNCTION toFraction(x, maxD = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
xd = SLICE(x, 2)
IFB LENGTH(xd) = 0 THEN
RESULT = Constructor(x)
ENDIF
d0 = Constructor(1)
n1 = d0
n0 = Constructor(0)
d1 = n0
d = Constructor(d1)
d[1] = getPrecision(xd) - x[1] - 1
e = d[1]
k = e MOD LOG_BASE
d[2] = POW(10, IIF(k < 0, LOG_BASE + k, k))
IFB maxD = NULL THEN
// d is 10**e, the minimum max-denominator needed.
maxD = IIF(e > 0, d, n1)
ELSE
n = Constructor(maxD)
IFB !isInt(n) <> 0 OR lt(n, n1) THEN
RESULT = ERR_VALUE
EXIT
ENDIF
maxD = IIF(gt(n, d), IIF(e > 0, d, n1), n)
ENDIF
external = FALSE
n = Constructor(digitsToString(xd))
pr = precision
e = LENGTH(xd) * LOG_BASE * 2
precision = e
WHILE TRUE
q = divide(n, d, 0, 1, 1)
d2 = plus(d0, times(q, d1), NULL)
IF cmp(d2, maxD) = 1 THEN BREAK
d0 = d1
d1 = d2
d2 = n1
n1 = plus(n0, times(q, d2), NULL)
n0 = d2
d2 = d
d = minus(n, times(q, d2))
n = d2
WEND
d2 = divide(minus(maxD, d0), d1, 0, 1, 1)
n0 = plus(n0, times(d2, n1), NULL)
d0 = plus(d0, times(d2, d1), NULL)
n1[0] = x[0]
n0[0] = n1[0]
// Determine which fraction is closer to x, n0/d0 or n1/d1?
tmp1 = divide(n1, d1, e, 1)
tmp1 = minus(tmp1, x)
tmp1 = THIS.abs(tmp1)
tmp2 = divide(n0, d0, e, 1)
tmp2 = minus(tmp2, x)
tmp2 = THIS.abs(tmp2)
DIM r[-1]
IFB cmp(tmp1, tmp2) < 1 THEN
arrayPush(r, finiteToString(n1))
arrayPush(r, finiteToString(d1))
ELSE
arrayPush(r, finiteToString(n0))
arrayPush(r, finiteToString(d0))
ENDIF
precision = pr
external = TRUE
RESULT = SLICE(r)
FEND
FUNCTION toHexadecimal(x, sd = NULL, rm = NULL)
RESULT = toStringBinary(x, 16, sd, rm)
FEND
FUNCTION toNearest(x, y = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
xd = SLICE(x, 2)
IFB y = NULL THEN
// If x is not finite, return x.
IFB !LENGTH(xd) THEN
RESULT = SLICE(x)
EXIT
ENDIF
y = Constructor(1)
rm = rounding
ELSE
y = Constructor(y)
yd = SLICE(y, 2)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
// If x is not finite, return x if y is not NaN, else NaN.
IFB !LENGTH(xd) THEN
RESULT = IIF(y[0], x, y)
ENDIF
// If y is not finite, return Infinity with the sign of x if y is Infinity, else NaN.
IFB !LENGTH(yd) THEN
IF y[0] THEN y[0] = x[0]
RESULT = SLICE(y)
ENDIF
// If y is not zero, calculate the nearest multiple of y to x.
IFB yd[0] THEN
external = FALSE
x = times(divide(x, y, 0, rm, 1), y)
external = TRUE
finalise(x)
ELSE
// If y is zero, return zero with the sign of x.
y[0] = x[0]
x = y
ENDIF
ENDIF
RESULT = SLICE(x)
RESULT = .toNumber(RESULT)
FEND
FUNCTION toNumber(x)
str = finiteToString(x)
RESULT = VAL(IIF(isNegative(x), "-" + str, str))
FEND
FUNCTION toOctal(x, sd = NULL, rm = NULL)
RESULT = toStringBinary(x, 8, sd, rm)
FEND
FUNCTION toPower(base, exponent, isnumeric = FALSE)
DIM x = Constructor(base)
DIM y = Constructor(exponent)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
DIM yn = VAL(exponent)
DIM xIsZero = x[0] = 1 AND x[1] = 0 AND x[2] = 0
DIM yIsZero = y[0] = 1 AND y[1] = 0 AND y[2] = 0
DIM xIsInf = x[0] <> NULL AND x[1] = NULL AND !x[2]
DIM yIsInf = y[0] <> NULL AND y[1] = NULL AND !y[2]
DIM xIsNaN = x[0] = NULL AND x[1] = NULL AND x[2] = FALSE
DIM yIsNaN = y[0] = NULL AND y[1] = NULL AND y[2] = FALSE
// Either ±Infinity, NaN or ±0?
// どちらかが±Infinity、NaNもしくは±0
IFB (xIsInf OR yIsInf) OR (xIsNaN OR yIsNaN) OR (xIsZero OR yIsZero) THEN
RESULT = POWER(base, exponent)
EXIT
ENDIF
IFB base = "1" THEN
RESULT = x
EXIT
ENDIF
pr = precision
rm = rounding
IFB exponent = "1" THEN
RESULT = finalise(x, pr, rm)
EXIT
ENDIF
// y exponent
e = GLOBAL.floor(y[1]/LOG_BASE)
// If y is a small integer use the 'exponentiation by squaring' algorithm.
DIM k = IIF(yn < 0, -1 * yn, yn)
IFB e >= LENGTH(y) - 2 - 1 AND k <= MAX_SAFE_INTEGER THEN
DIM r = intPow(Ctor, x, k, pr)
RESULT = IIF(VAL(y[0]) < 0, dividedBy("1", r), toString(finalise(r, pr, rm)))
EXIT
ENDIF
DIM s = x[0]
// if x is negative
IFB s < 0 THEN
// if y is not an integer
IFB e < LENGTH(y) - 2 - 1 THEN
RESULT = "NaN"
EXIT
ENDIF
// Result is positive if x is negative and the last digit of integer y is even.
IF (y[e+2] AND 1) = 0 THEN s = 1
// if x.eq(-1)
IFB x[1] = 0 AND x[2] = 1 AND LENGTH(x) - 2 = 1 THEN
x[0] = s
RESULT = x
EXIT
ENDIF
ENDIF
// Estimate result exponent.
// x^y = 10^e, where e = y * log10(x)
// log10(x) = log10(x_significand) + x_exponent
// log10(x_significand) = ln(x_significand) / ln(10)
xd = SLICE(x, 2)
k = POWER(digitsToString(xd), yn)
IFB k = 0 OR !isFinite(Constructor(k)) THEN
e = floor(yn * (LN("0." + digitsToString(xd)) / VAL(LN10) + VAL(x[1]) + 1))
ELSE
e = Constructor(k)[1]
ENDIF
// Exponent estimate may be incorrect e.g. x: 0.999999999999999999, y: 2.29, e: 0, r.e: -1.
// Overflow/underflow?
IFB e > maxE + 1 OR e < minE - 1 THEN
IFB e > 0 THEN
RESULT = IIF(s >= 0, "INF", "-INF")
ELSE
RESULT = "0"
ENDIF
EXIT
ENDIF
external = FALSE
x[0] = 1
rounding = x[0]
// Estimate the extra guard digits needed to ensure five correct rounding digits from
// naturalLogarithm(x). Example of failure without these extra digits (precision: 10):
// new Decimal(2.32456).pow('2087987436534566.46411')
// should be 1.162377823e+764914905173815, but is 1.162355823e+764914905173815
DIM array[] = 12, LENGTH(e)
k = small(array, 1)
// r = x^y = exp(y*ln(x))
r = naturalExponential(times(y, naturalLogarithm(x, pr + k)), pr)
rd = SLICE(r, 2)
// r may be Infinity, e.g. (0.9999999999999999).pow(-1e+40)
IFB LENGTH(rd) THEN
// Truncate to the required precision plus five rounding digits.
r = finalise(r, pr + 5, 1)
// If the rounding digits are [49]9999 or [50]0000 increase the precision by 10 and recalculate
// the result.
IFB checkRoundingDigits(rd, pr, rm) THEN
e = pr + 10
// Truncate to the increased precision plus five rounding digits.
r = finalise(naturalExponential(times(y, naturalLogarithm(x, e + k)), e), e + 5, 1)
// Check for 14 nines from the 2nd rounding digit (the first rounding digit may be 4 or 9).
IFB COPY(digitsToString(rd), pr + 1 + 1, pr + 15 + 1) + 1 = 1E+14 THEN
r = finalise(r, pr + 1, 0)
ENDIF
ENDIF
ENDIF
r[0] = s
external = TRUE
rounding = rm
RESULT = finalise(r, pr, rm)
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION toPrecision(x, sd = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB sd = NULL THEN
str = finiteToString(x, x[1] <= toExpNeg OR x[1] >= toExpPos)
ELSE
checkInt32(sd, 1, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
x = finalise(Constructor(x), sd, rm)
str = finiteToString(x, sd <= x[1] OR x[1] <= toExpNeg, sd)
ENDIF
RESULT = IIF(isNeg(x) AND isZero(x), "-" + str, str)
FEND
FUNCTION toSignificantDigits(x, sd = NULL, rm = NULL)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
IFB sd = NULL THEN
sd = precision
rm = rounding
ELSE
checkInt32(sd, 1, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
ENDIF
RESULT = toString(finalise(Constructor(x), sd, rm))
FEND
FUNCTION toString(x)
str = finiteToString(x, x[1] <= toExpNeg OR x[1] >= toExpPos)
RESULT = IIF(isNegative(x) AND !isZero(x), "-" + str, str)
FEND
FUNCTION truncated(x, isNumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
RESULT = finalise(x, x[1] + 1, 1)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
FEND
FUNCTION valueOf(x)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
str = finiteToString(x, x[1] <= toExpNeg OR x[1] >= toExpPos)
RESULT = IIF(isNeg(x), "-" + str, str)
FEND
//////////////////////////////
// 短縮形
//////////////////////////////
FUNCTION abs(x)
RESULT = absoluteValue(x)
FEND
FUNCTION acos(x)
RESULT = inverseCosine(x)
FEND
FUNCTION acosh(x)
RESULT = inverseHyperbolicCosine(x)
FEND
FUNCTION asin(x)
RESULT = inverseSine(x)
FEND
FUNCTION asinh(x)
RESULT = inverseHyperbolicSine(x)
FEND
FUNCTION atan(x)
RESULT = inverseTangent(x)
FEND
FUNCTION atanh(x)
RESULT = inverseHyperbolicTangent(x)
FEND
FUNCTION add(augend, addend, isnumeric = FALSE)
RESULT = plus(augend, addend, isnumeric)
FEND
FUNCTION calc(str, pr = 20, rm = 4)
RESULT = calculate(str, pr, rm)
FEND
FUNCTION cbrt(x)
RESULT = cubeRoot(x)
FEND
FUNCTION clamp(x, min, max)
RESULT = clampedTo(x, min, max)
FEND
FUNCTION cmp(x, y)
RESULT = comparedTo(x, y)
FEND
FUNCTION cos(x)
RESULT = cosine(x)
FEND
FUNCTION cosh(x, isNumeric = FALSE)
RESULT = hyperbolicCosine(x, isNumeric)
FEND
FUNCTION divide(dividend, divisor, pr = 20, rm = 4, dp = NULL, _base = NULL, isnumeric = FALSE)
RESULT = dividedBy(dividend, divisor, pr, rm, dp, _base, isnumeric)
FEND
FUNCTION div(dividend, divisor, pr = 20, rm = 4, dp = NULL, _base = NULL, isnumeric = FALSE)
RESULT = dividedBy(dividend, divisor, pr, rm, dp, _base, isnumeric)
FEND
FUNCTION divToInt(x, y)
RESULT = dividedToIntegerBy(x, y)
FEND
FUNCTION dp(x)
RESULT = decimalPlaces(x)
FEND
FUNCTION eq(x, y)
RESULT = equals(x, y)
FEND
FUNCTION exp(x)
RESULT = naturalExponential(x)
FEND
FUNCTION gt(x, y)
RESULT = greaterThan(x, y)
FEND
FUNCTION gte(x, y)
RESULT = greaterThanOrEqualTo(x, y)
FEND
FUNCTION isInt(x)
RESULT = isInteger(x)
FEND
FUNCTION isNeg(x)
RESULT = isNegative(x)
FEND
FUNCTION isPos(x)
RESULT = isPositive(x)
FEND
FUNCTION ln(x)
RESULT = naturalLogarithm(x)
FEND
FUNCTION log(arg, base)
RESULT = logarithm(arg, base)
FEND
FUNCTION lt(x, y)
RESULT = lessThan(x, y)
FEND
FUNCTION lte(x, y)
RESULT = lessThanOrEqualTo(x, y)
FEND
FUNCTION mod(x, y)
RESULT = modulo(x, y)
FEND
FUNCTION mul(multiplicand, multiplier, isnumeric = FALSE)
RESULT = times(multiplicand, multiplier, isnumeric)
FEND
FUNCTION neg(x)
RESULT = negated(x)
FEND
FUNCTION pow(base, exponent)
RESULT = toPower(base, exponent)
FEND
FUNCTION sd(x, z = NULL)
RESULT = precision(x, z)
FEND
FUNCTION sin(x)
RESULT = sine(x)
FEND
FUNCTION sinh(x, isNumeric = FALSE)
RESULT = hyperbolicSine(x, isNumeric)
FEND
FUNCTION sqrt(x, isNumeric = FALSE)
RESULT = squareRoot(x, isNumeric)
FEND
FUNCTION sub(minuend, subtrahend, isnumeric = FALSE)
RESULT = minus(minuend, subtrahend, isnumeric)
FEND
FUNCTION tan(x)
RESULT = tangent(x)
FEND
FUNCTION tanh(x)
RESULT = hyperbolicTangent(x)
FEND
//////////////////////////////
// ヘルパー関数
//////////////////////////////
FUNCTION digitsToString(d)
indexOfLastWord = LENGTH(d) - 1
str = ""
w = d[0]
IFB indexOfLastWord > 0 THEN
str = str + w
DIM i = 1
WHILE i < indexOfLastWord
ws = d[i] + ""
k = LOG_BASE - LENGTH(ws)
IF k THEN str = str + getZeroString(k)
str = str + ws
i = i + 1
WEND
w = d[i]
ws = w + ""
k = LOG_BASE - LENGTH(ws)
IF k THEN str = str + getZeroString(k)
ELSEIF w = 0 THEN
RESULT = "0"
EXIT
ENDIF
// Remove trailing zeros of last w.
WHILE w MOD 10 = 0 AND w <> 0
w = w / 10
WEND
RESULT = str + w
FEND
FUNCTION checkInt32(i, min, max)
IF i <> VARTYPE(i, VAR_INTEGER) OR i < min OR i > max THEN RESULT = ERR_VALUE
FEND
FUNCTION checkRoundingDigits(d, i, rm, repeating = NULL)
// Get the length of the first word of the array d.
k = d[0]
WHILE k >= 10
i = i - 1
k = k / 10
WEND
// Is the rounding digit in the first word of d?
i = i - 1
IFB i < 0 THEN
i = i + LOG_BASE
di = 0
ELSE
di = VAL(CEIL((i + 1) / LOG_BASE))
i = i MOD LOG_BASE
ENDIF
// i is the index (0 - 6) of the rounding digit.
// E.g. if within the word 3487563 the first rounding digit is 5,
// then i = 4, k = 1000, rd = 3487563 % 1000 = 563 RESULT = ERR_VALUE
k = POWER(10, LOG_BASE - i)
IFB di > UBound(d) THEN
rd = 0
ELSE
rd = d[di] MOD k
ENDIF
IFB repeating = NULL THEN
IFB i < 3 THEN
IFB i = 0 THEN
rd = rd / 100
ELSEIF i = 1 THEN
rd = rd / 10
ENDIF
r = rm < 4 AND rd = 99999 OR rm > 3 AND rd = 49999 OR rd = 50000 OR rd = 0
ELSE
IFB di + 1 > UBound(d) THEN
n = 0
ELSE
n = d[di + 1]
ENDIF
r = (rm < 4 AND rd + 1 = k OR rm > 3 AND rd + 1 = k / 2) AND (n / k / 100) = POWER(10, i - 2) - 1 OR (rd = k / 2 OR rd = 0) AND (n / k / 100) = 0
ENDIF
ELSE
IFB i < 4 THEN
IFB i = 0 THEN
rd = rd / 1000
ELSEIF i = 1 THEN
rd = rd / 100
ELSEIF i = 2 THEN
rd = rd / 10
ENDIF
r = (repeating OR rm < 4) AND rd = 9999 OR !repeating AND rm > 3 AND rd = 4999
ELSE
IFB di + 1 > UBound(d) THEN
n = 0
ELSE
n = d[di + 1]
ENDIF
r = ((repeating OR rm < 4) AND rd + 1 = k OR (!repeating AND rm > 3) AND rd + 1 = k / 2) AND (n / k / 1000) = POWER(10, i - 3) - 1
ENDIF
ENDIF
RESULT = VARTYPE(r, VAR_BOOLEAN)
FEND
FUNCTION convertBase(str, baseIn, baseOut)
CONST NUMERALS = "0123456789abcdef"
DIM arr[0] = 0
DIM i = 0
DIM strL = LENGTH(str)
WHILE i < strL
arrL = LENGTH(arr)
WHILE TRUE
arrL = arrL - 1
IF arrL < 0 THEN BREAK
arr[arrL] = arr[arrL] * baseIn
WEND
arr[0] = arr[0] + (POS(COPY(str, i+1, 1), NUMERALS) - 1)
i = i + 1
j = 0
WHILE j < LENGTH(arr)
IFB arr[j] > baseOut - 1 THEN
IF j + 1 > UBound(arr) THEN
RESIZE(arr, j + 1)
arr[j+1] = 0
ENDIF
arr[j+1] = arr[j+1] + INT(arr[j] / baseOut)
arr[j] = arr[j] MOD baseOut
ENDIF
j = j + 1
WEND
WEND
arrayReverse(arr)
RESULT = SLICE(arr)
FEND
FUNCTION cosine2(Ctor, x)
IFB isZero(x) THEN
RESULT = SLICE(x)
EXIT
ENDIF
// Argument reduction: cos(4x) = 8*(cos^4(x) - cos^2(x)) + 1
// i.e. cos(x) = 8*(cos^4(x/4) - cos^2(x/4)) + 1
// Estimate the optimum number of times to use the argument reduction.
xd = x
xd = SLICE(xd, 2)
len = LENGTH(xd)
IFB len < 32 THEN
k = GLOBAL.CEIL(len / 3)
y = "" + (1 / tinyPow(4, k))
ELSE
k = 16
y = "2.3283064365386962890625e-10"
ENDIF
precision = precision + k
x = taylorSeries(Ctor, 1, times(x, y), Constructor(1))
// Reverse argument reduction
i = k
WHILE i > 0
i = i - 1
cos2x = times(x, x, NULL)
x = times(cos2x, cos2x, NULL)
x = minus(x, cos2x, NULL)
x = times(x, 8, NULL)
x = plus(x, 1, NULL)
WEND
precision = precision - k
RESULT = SLICE(x)
FEND
FUNCTION finalise(x, sd = NULL, rm = NULL, isTruncated = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
xd = SLICE(x, 2)
WHILE sd <> NULL
// Get the length of the first word of the digits array xd.
digits = 1
k = VAL(xd[0])
WHILE k >= 10
digits = digits + 1
k = k / 10
WEND
i = sd - digits
// Is the rounding digit in the first word of xd?
IFB i < 0 THEN
i = i + LOG_BASE
j = sd
xdi = 0
w = xd[xdi]
// Get the rounding digit at index j of w.
rd = w / POWER(10, digits - j - 1) MOD 10
ELSE
xdi = GLOBAL.CEIL((i+1)/LOG_BASE)
k = LENGTH(xd)
IFB xdi >= k THEN
IFB isTruncated THEN
// Needed by `naturalExponential`, `naturalLogarithm` and `squareRoot`.
WHILE k <= xdi
arrayPush(xd, 0)
k = k + 1
WEND
rd = 0
w = rd
digits = 1
i = i MOD LOG_BASE
j = i - LOG_BASE + 1
ELSE
BREAK
ENDIF
ELSE
k = xd[xdi]
w = k
// Get the number of digits of w.
digits = 1
WHILE k >= 10
digits = digits + 1
k = k / 10
WEND
// Get the index of rd within w.
i = i MOD LOG_BASE
// Get the index of rd within w, adjusted for leading zeros.
// The number of leading zeros of w is given by LOG_BASE - digits.
j = i - LOG_BASE + digits
// Get the rounding digit at index j of w.
rd = IIF(j < 0, 0, INT(w / POWER(10, digits - j - 1)) MOD 10)
ENDIF
ENDIF
// Are there any non-zero digits after the rounding digit?
// isTruncated =
//IF isTruncated OR sd < 0 OR x[xdi+3] = EMPTY THEN
//isTruncated = FALSE
IFB isTruncated THEN
ELSEIF sd < 0 THEN
isTruncated = TRUE
ELSEIF xdi > UBound(xd) THEN
isTruncated = TRUE
ELSEIF IIF(j < 0, w, w MOD POWER(10, digits - j - 1)) THEN
isTruncated = TRUE
ENDIF
// The expression `w % mathpow(10, digits - j - 1)` returns all the digits of w to the right
// of the digit at (left-to-right) index j, e.g. if w is 908714 and j is 2, the expression
// will give 714.
IFB i > 0 THEN
tmp = IIF(j > 0, w / POWER(10, digits - j), 0)
ELSE
IFB xdi = 0 THEN
tmp = 0
ELSE
tmp = xd[xdi - 1] MOD 10
ENDIF
ENDIF
IF isTruncated = NULL THEN isTruncated = FALSE
roundUp = IIF(rm < 4, _
// truepart
(VARTYPE(rd, VAR_BOOLEAN) OR VARTYPE(isTruncated, VAR_BOOLEAN)) AND (rm = 0 OR VARTYPE(rm = IIF(x[0] < 0, 3, 2), VAR_BOOLEAN)), _
// falsepart
rd > 5 OR rd = 5 AND (rm = 4 OR isTruncated OR rm = 6 AND _
// Check whether the digit to the left of the rounding digit is odd.
bitAnd(tmp, 1) OR rm = IIF(x[0] < 0, 8, 7) _
) _
)
IFB sd < 1 OR !xd[0] THEN
RESIZE(xd, 0)
IFB roundUp THEN
// Convert sd to decimal places.
sd = sd - (x[1] + 1)
// 1, 0.1, 0.01, 0.001, 0.0001 etc.
x[2] = POWER(10, (LOG_BASE - sd MOD LOG_BASE) MOD LOG_BASE)
x[1] = -1 * sd
ELSE
// Zero.
RESIZE(x, 2)
x[2] = 0
x[1] = 0
ENDIF
RESULT = SLICE(x)
EXIT
ENDIF
// Remove excess digits.
IFB i = 0 THEN
RESIZE(xd, xdi-1)
RESIZE(x, 1)
arrayMerge(x, xd)
k = 1
xdi = xdi - 1
ELSE
RESIZE(xd, xdi)
RESIZE(x, 1)
arrayMerge(x, xd)
k = POWER(10, LOG_BASE-i)
// E.g. 56700 becomes 56000 if 7 is the rounding digit.
// j > 0 means i > number of leading zeros of w.
IFB j > 0 THEN
RESIZE(x, xdi+2)
xd[xdi] = INT(INT(w / POWER(10, digits-j)) MOD POWER(10, j)) * k
x[xdi+2] = xd[xdi]
ELSE
RESIZE(x, xdi+2)
xd[xdi] = 0
x[xdi+2] = xd[xdi]
ENDIF
ENDIF
IFB roundUp THEN
WHILE TRUE
// Is the digit to be rounded up in the first word of xd?
IFB xdi = 0 THEN
// i will be the length of xd[0] before k is added.
i = 1
j = VAL(xd[0])
WHILE j >= 10
i = i + 1
j = j / 10
WEND
xd[0] = VAL(xd[0]) + k
x[2] = xd[0]
j = VAL(xd[0])
k = 1
WHILE j >= 10
k = k + 1
j = j / 10
WEND
// if i != k the length has increased.
IFB i <> k THEN
x[1] = x[1] + 1
IF x[2] = BASE THEN x[2] = 1
ENDIF
BREAK
ELSE
xd[xdi] = xd[xdi] + k
IF xd[xdi] <> BASE THEN BREAK
xd[xdi] = 0
xdi = xdi - 1
k = 1
ENDIF
WEND
ENDIF
// Remove trailing zeros.
FOR i = UBound(xd) TO 0 STEP -1
IFB xd[i] = 0 THEN
arrayPop(xd)
ELSE
BREAK
ENDIF
NEXT
BREAK
WEND
IFB external THEN
// Overflow?
IFB x[1] > maxE THEN
// Infinity
RESIZE(x, 1)
x[1] = EMPTY // 仮の値
// Underflow?
ELSEIF x[1] < minE THEN
x[1] = 0
RESIZE(x, 2)
x[2] = 0
ENDIF
ENDIF
RESIZE(x, 1)
arrayMerge(x, xd)
RESULT = SLICE(x)
FEND
FUNCTION finiteToString(x, isExp = FALSE, sd = EMPTY)
IFB !isFinite(x) THEN
RESULT = nonFiniteToString(x)
EXIT
ENDIF
e = x[1]
xd = SLICE(x, 2)
str = digitsToString(xd)
len = LENGTH(str)
IFB isExp THEN
k = sd - len
IFB sd AND k > 0 THEN
str = COPY(str, 1, 1) + "." + COPY(str, 2) + getZeroString(k)
ELSEIF len > 1 THEN
str = COPY(str, 1, 1) + "." + COPY(str, 2)
ENDIF
str = str + IIF(x[1] < 0, "e", "e+") + x[1]
ELSEIF e < 0 THEN
str = "0." + getZeroString(-1 * e - 1) + str
k = sd - len
IF sd AND k > 0 THEN str = str + getZeroString(k)
ELSEIF e >= len THEN
str = str + getZeroString(e + 1 - len)
k = sd - e - 1
IF sd AND k > 0 THEN str = str + "." + getZeroString(k)
ELSE
k = e + 1
IF k < len THEN str = COPY(str, 1, k) + "." + COPY(str, k+1)
k = sd - len
IFB sd AND k > 0 THEN
IF e + 1 = len THEN str = str + "."
str = str + getZeroString(k)
ENDIF
ENDIF
RESULT = str
FEND
FUNCTION getBase10Exponent(digits[], e)
DIM w = digits[0]
e = e * LOG_BASE
WHILE w >= 10
e = e + 1
w = w / 10
WEND
RESULT = e
FEND
FUNCTION getLN10(Ctor, sd, pr = NULL)
IFB sd > LN10PRECISION THEN
// Reset global state in case the exception is caught.
external = TRUE
IF pr THEN precision = pr
ENDIF
RESULT = finalise(Constructor(LN10), sd, 1, TRUE)
FEND
FUNCTION getPI(Ctor, sd, rm)
IFB sd > PI_PRECISION THEN
RESULT = ERR_VALUE
ELSE
RESULT = finalise(Constructor(PI), sd, rm, TRUE)
ENDIF
FEND
FUNCTION getPrecision(digits)
w = LENGTH(digits) - 1
len = w * LOG_BASE + 1
w = digits[w]
// If non-zero...
IFB w <> 0 THEN
// Subtract the number of trailing zeros of the last word.
WHILE w MOD 10 = 0
len = len - 1
w = w / 10
WEND
// Add the number of digits of the first word.
w = digits[0]
WHILE VAL(w) >= 10
len = len + 1
w = w / 10
WEND
ENDIF
RESULT = len
FEND
FUNCTION getZeroString(k)
zs = ""
WHILE k > 0
zs = zs + "0"
k = k - 1
WEND
RESULT = zs
FEND
FUNCTION intPow(Ctor, x, n, pr)
DIM isTruncated
DIM r = Constructor("1")
// Max n of 9007199254740991 takes 53 loop iterations.
// Maximum digits array length; leaves [28, 34] guard digits.
DIM k = CEIL(pr / LOG_BASE + 4)
external = FALSE
WHILE TRUE
IFB n MOD 2 THEN
r = times(r, x)
rd = SLICE(r, 2)
IF truncate(rd, k) THEN isTruncated = TRUE
ENDIF
n = GLOBAL.floor(n/2)
IFB n = 0 THEN
rd = SLICE(r, 2)
// To ensure correct rounding when r.d is truncated, increment the last word if it is zero.
n = LENGTH(rd) - 1
IF isTruncated AND rd[n] = 0 THEN rd[n] = rd[n] + 1
BREAK
ENDIF
x = times(x, x)
xd = SLICE(x, 2)
truncate(xd, k)
WEND
external = TRUE
RESULT = r
FEND
FUNCTION isOdd(n)
IFB !isInteger(n) THEN
RESULT = ERR_VALUE
EXIT
ENDIF
RESULT = IIF(modulo(n, 2) = "0", FALSE, TRUE)
FEND
FUNCTION maxOrMin(Ctor, args, ltgt)
RESULT = ERR_VALUE
FEND
FUNCTION naturalExponential(x, sd = NULL, isNumeric = FALSE)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
rep = 0
i = 0
k = 0
rm = rounding
pr = precision
// 0/NaN/Infinity
IFB (x[0] = 1 AND x[1] = 0 AND x[2] = 0) OR x[1] = NULL OR x[1] > 17 THEN
ENDIF
IFB sd = NULL THEN
external = FALSE
wpr = pr
ELSE
wpr = sd
ENDIF
t = Constructor(0.03125)
// while abs(x) >= 0.1
WHILE x[1] > -2
// x = x / 2^5
x = times(x, t)
k = k + 5
WEND
// Use 2 * log10(2^k) + 5 (empirically derived) to estimate the increase in precision
// necessary to ensure the first 4 rounding digits are correct.
guard = INT(GLOBAL.LN(POWER(2, k)) / MathLN10 * 2 + 5)
wpr = wpr + guard
sum = Constructor("1")
pow = sum
denominator = pow
precision = wpr
WHILE TRUE
pow = finalise(times(pow, x), wpr, 1)
i = i + 1
denominator = times(denominator, i)
t = plus(sum, divide(pow, denominator, wpr, 1))
td = SLICE(t, 2)
sumd = SLICE(sum, 2)
IFB COPY(digitsToString(td), 1, wpr) = COPY(digitsToString(sumd), 1, wpr) THEN
j = k
j = j - 1
WHILE j >= 0
sum = finalise(times(sum, sum), wpr, 1)
j = j - 1
WEND
// Check to see if the first 4 rounding digits are [49]999.
// If so, repeat the summation with a higher precision, otherwise
// e.g. with precision: 18, rounding: 1
// exp(18.404272462595034083567793919843761) = 98372560.1229999999 (should be 98372560.123)
// `wpr - guard` is the index of first rounding digit.
IFB sd = NULL THEN
sumd = SLICE(sum, 2)
IFB rep < 3 AND checkRoundingDigits(sumd, wpr - guard, rm, rep) THEN
precision = wpr = wpr + 10
t = Constructor(1)
pow = t
denominator = pow
i = 0
rep = rep + 1
ELSE
precision = pr
RESULT = finalise(sum, precision, rm, external = TRUE)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
ELSE
precision = pr
RESULT = sum
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
ENDIF
sum = t
WEND
FEND
FUNCTION naturalLogarithm(y, sd = NULL, isNumeric = FALSE)
y = IIF(VARTYPE(y) < 8192, Constructor(y), y)
n = 1
guard = 10
x = y
xd = SLICE(x, 2)
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
rm = rounding
pr = precision
// Is x negative or Infinity, NaN, 0 or 1?
IFB x[0] < 0 THEN
// RESULT = Constructor(0)
EXIT
ENDIF
IFB sd = NULL THEN
external = FALSE
wpr = pr
ELSE
wpr = sd
ENDIF
wpr = wpr + guard
precision = wpr
c = digitsToString(xd)
c0 = COPY(c, 1, 1)
e = x[1]
IFB .lessThan(GLOBAL.ABS(e), "1.5e+15") THEN
// Argument reduction.
// The series converges faster the closer the argument is to 1, so using
// ln(a^b) = b * ln(a), ln(a) = ln(a^b) / b
// multiply the argument by itself until the leading digits of the significand are 7, 8, 9,
// 10, 11, 12 or 13, recording the number of multiplications so the sum of the series can
// later be divided by this number, then separate out the power of 10 using
// ln(a*10^b) = ln(a) + b*ln(10).
// max n is 21 (gives 0.9, 1.0 or 1.1) (9e15 / 21 = 4.2e14).
//while (c0 < 9 && c0 != 1 || c0 == 1 && c.charAt(1) > 1) {
// max n is 6 (gives 0.7 - 1.3)
WHILE c0 < 7 AND c0 <> 1 OR c0 = 1 AND COPY(c, 1, 1) > 3
x = times(x, y)
xd = SLICE(x, 2)
c = digitsToString(xd)
c0 = COPY(c, 1, 1)
n = n + 1
WEND
e = x[1]
IFB c0 > 1 THEN
x = Constructor("0." + c)
e = e + 1
ELSE
x = Constructor(c0 + "." + COPY(c, 2))
ENDIF
ELSE
// The argument reduction method above may result in overflow if the argument y is a massive
// number with exponent >= 1500000000000000 (9e15 / 6 = 1.5e15), so instead recall this
// function using ln(x*10^e) = ln(x) + e*ln(10).
t = times(getLn10(Ctor, wpr + 2, pr), e)
x = plus(naturalLogarithm(Constructor(c0 + "." + COPY(c, 2)), wpr - guard), t)
precision = pr
external = TRUE
RESULT = IIF(sd = NULL, finalise(x, pr, rm, external), x)
EXIT
ENDIF
// x1 is x reduced to a value near 1.
x1 = x
// Taylor series.
// ln(y) = ln((1 + x)/(1 - x)) = 2(x + x^3/3 + x^5/5 + x^7/7 + ...)
// where x = (y - 1)/(y + 1) (|x| < 1)
x = divide(minus(x, "1"), plus(x, "1"), wpr, 1)
numerator = x
sum = numerator
sumd = SLICE(sum, 2)
x2 = finalise(times(x, x), wpr, 1)
denominator = 3
WHILE TRUE
numerator = finalise(times(numerator, x2), wpr, 1)
t = plus(sum, divide(numerator, constructor(denominator), wpr, 1, NULL, NULL, NULL), NULL)
td = SLICE(t, 2)
IFB COPY(digitsToString(td), 1, wpr) = COPY(digitstoString(sumd), 1, wpr) THEN
sum = times(sum, "2")
// Reverse the argument reduction. Check that e is not 0 because, besides preventing an
// unnecessary calculation, -0 + 0 = +0 and to ensure correct rounding -0 needs to stay -0.
IF e <> 0 THEN sum = plus(sum, times(getLn10(Ctor, wpr + 2, pr), e, NULL), NULL)
sum = divide(sum, Constructor(n), wpr, 1)
sumd = SLICE(sum, 2)
// Is rm > 3 and the first 4 rounding digits 4999, or rm < 4 (or the summation has
// been repeated previously) and the first 4 rounding digits 9999?
// If so, restart the summation with a higher precision, otherwise
// e.g. with precision: 12, rounding: 1
// ln(135520028.6126091714265381533) = 18.7246299999 when it should be 18.72463.
// `wpr - guard` is the index of first rounding digit.
IFB sd = NULL THEN
rep = 0
IFB checkRoundingDigits(sumd, wpr - guard, rm, rep) THEN
wpr = wpr + guard
precision = wpr
x = divide(minus(x1, "1"), plus(x1, "1"), wpr, 1)
numerator = x
t = numerator
x2 = finalise(times(x, x), wpr, 1)
rep = 1
denominator = wpr
ELSE
precision = pr
external = TRUE
RESULT = finalise(sum, precision, rm, external)
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
ELSE
precision = pr
RESULT = sum
IF isnumeric = NULL THEN EXIT
RESULT = IIF(isnumeric, toNumber(RESULT), toString(RESULT))
EXIT
ENDIF
ENDIF
sum = t
sumd = SLICE(sum, 2)
denominator = denominator + 2
WEND
FEND
FUNCTION nonFiniteToString(x[])
IFB x[0] = NULL AND x[1] = NULL AND x[2] = FALSE THEN
RESULT = "NaN"
ELSEIF CHKNUM(x[0]) AND x[1] = NULL AND x[2] = FALSE THEN
RESULT = IIF(x[0] > 0, "", "-") + "INF"
ENDIF
FEND
FUNCTION parseDecimal(x, str)
// Decimal point?
e = POS(".", str) - 1
IF e <> 0 THEN str = REPLACE(str, ".", "")
// Exponential form?
DIM i = POS("e", str)
IFB i <> 0 THEN
// Determine exponent.
IF e < 0 THEN e = i
e = VAL(COPY(str, i+1))
str = COPY(str, 1, i-1)
ELSEIF e < 0 THEN
// Integer
e = LENGTH(str)
ENDIF
// Determine leading zeros.
i = 0
WHILE COPY(str, i+1, 1) = "0"
i = i + 1
WEND
// Determine trailing zeros.
len = LENGTH(str)
WHILE COPY(str, len, 1) = "0"
len = len - 1
IF len = 0 THEN BREAK
WEND
str = COPY(str, i+1, len-i)
IFB str <> 0 AND str <> "" THEN
len = len - i
e = e - i - 1
RESIZE(x, 1)
x[1] = e
//x[2] = 0
// Transform base
// e is the base 10 exponent.
// i is where to slice str to get the first word of the digits array.
i = (e + 1) MOD LOG_BASE
IF e < 0 THEN i = i + LOG_BASE
IFB i < len THEN
IF i THEN arrayPush(x, VAL(COPY(str, 1, i)))
len = len - LOG_BASE
WHILE i < len
arrayPush(x, VAL(COPY(str, i+1, LOG_BASE)))
i = i + LOG_BASE
WEND
str = COPY(str, i+1)
i = LOG_BASE - LENGTH(str)
ELSE
i = i - len
ENDIF
WHILE i > 0
str = str + "0"
i = i - 1
WEND
arrayPush(x, VAL(str))
IFB external THEN
// Overflow?
IFB x[1] = maxE THEN
// Infinity.
x[2] = NULL
x[1] = NULL
// Underflow?
ELSEIF x[1] = minE THEN
// Zero.
x[1] = 0
x[2] = 0
ENDIF
ENDIF
ELSE
// Zero.
RESIZE(x, 2)
x[1] = 0
x[2] = 0
ENDIF
RESULT = SLICE(x)
FEND
FUNCTION parseOther(x, str)
IF POS("Infinity", str) THEN str = REPLACE(str, "Infinity", "INF")
IFB POS("_", str) <> 0 THEN
ELSEIF str = "INF" OR str = "NaN" THEN
IF str = "NaN" THEN x[0] = NULL
RESIZE(x, 2)
x[1] = NULL
x[2] = FALSE
RESULT = SLICE(x)
EXIT
ENDIF
IFB reTest(str, isHex) THEN
_base = 16
str = STRCONV(str, SC_LOWERCASE)
ELSEIF reTest(str, isBinary) THEN
_base = 2
ELSEIF reTest(str, isOctal) THEN
_base = 8
ELSE
EXIT
ENDIF
// Is there a binary exponent part?
i = POS("p", str)
IFB i > 0 THEN
p = COPY(str, (i+1)+1)
str = COPY(str, 2+1, i+1)
ELSE
p = NULL
str = COPY(str, 2+1)
ENDIF
// Convert `str` as an integer then divide the result by `base` raised to a power such that the
// fraction part will be restored.
i = POS(".", str)
isFloat = i >= 1
json = "{'precision':20, 'rounding':7}"
Ctor = JSON.Parse(REPLACE(json, "'", "<#DBL>"))
IFB isFloat THEN
str = REPLACE(str, ".", "")
len = LENGTH(str)
i = len - i
// log[10](16) = 1.2041... , log[10](88) = 1.9444....
divisor = intPow(Ctor, Constructor(base), i, i * 2)
ELSE
len = NULL
divisor = NULL
ENDIF
xd = convertBase(str, _base, base)
xe = LENGTH(xd) - 1
// Remove trailing zeros.
i = xe
WHILE xd[i] = 0
i = i - 1
arrayPop(xd)
WEND
IFB i < 0 THEN
// RESULT =
EXIT
ENDIF
RESIZE(x, 1)
x[1] = getBase10Exponent(xd, xe)
arrayMerge(x, xd)
external = FALSE
// At what precision to perform the division to ensure exact conversion?
// maxDecimalIntegerPartDigitCount = ceil(log[10](b) * otherBaseIntegerPartDigitCount)
// log[10](2) = 0.30103, log[10](8) = 0.90309, log[10](16) = 1.20412
// E.g. ceil(1.2 * 3) = 4, so up to 4 decimal digits are needed to represent 3 hex int digits.
// maxDecimalFractionPartDigitCount = {Hex:4|Oct:3|Bin:1} * otherBaseFractionPartDigitCount
// Therefore using 4 * the number of digits of str will always be enough.
IF isFloat THEN x = divide(x, divisor, len * 4)
// Multiply by the binary exponent part if present.
IF p <> NULL THEN x = times(x, POWER(2, p))
external = TRUE
RESULT = SLICE(x)
FEND
FUNCTION sine2(Ctor, x)
xd = x
xd = SLICE(xd, 2)
len = LENGTH(xd)
IFB len < 3 THEN
RESULT = IIF(isZero(x), x, taylorSeries(Ctor, 2, x, x))
EXIT
ENDIF
// Argument reduction: sin(5x) = 16*sin^5(x) - 20*sin^3(x) + 5*sin(x)
// i.e. sin(x) = 16*sin^5(x/5) - 20*sin^3(x/5) + 5*sin(x/5)
// and sin(x) = sin(x/5)(5 + sin^2(x/5)(16sin^2(x/5) - 20))
// Estimate the optimum number of times to use the argument reduction.
k = 1.4 * GLOBAL.SQRT(len)
k = INT(IIF(k > 16, 16, k))
x = times(x, 1 / tinyPow(5, k), NULL)
x = taylorSeries(Ctor, 2, x, x)
// Reverse argument reduction
d5 = Constructor(5)
d16 = Constructor(16)
d20 = Constructor(20)
WHILE k > 0
k = k - 1
sin2x = times(x, x, NULL)
x = times(x, plus(d5, times(sin2x, minus(times(d16, sin2x, NULL), d20, NULL), NULL), NULL), NULL)
WEND
RESULT = SLICE(x)
FEND
FUNCTION taylorSeries(Ctor, n, x, y, isHyperbolic = NULL)
i = 1
pr = precision
k = GLOBAL.CEIL(pr / LOG_BASE)
external = FALSE
x2 = times(x, x)
u = Constructor(y)
WHILE TRUE
multiplicand = times(u, x2)
multiplier = Constructor(n * (n + 1))
t = divide(multiplicand, multiplier, pr, 1)
n = n + 2
isHyperbolic = IIF(isHyperbolic = NULL, FALSE, isHyperbolic)
u = IIF(isHyperbolic, plus(y, t), minus(y, t))
y = divide(times(t, x2), Constructor(n * (n + 1)), pr, 1)
n = n + 2
t = plus(u, y)
td = SLICE(t, 2)
ud = SLICE(u, 2)
IFB !(UBound(td) < k) THEN
j = k
TRY
WHILE td[j] = ud[j] AND j >= 0
j = j - 1
IF j = 0 THEN BREAK 2
WEND
EXCEPT
ENDTRY
IF j = -1 THEN BREAK
ENDIF
j = u
u = y
y = t
t = j
i = i + 1
WEND
external = TRUE
RESIZE(td, k)
RESIZE(t, 1)
arrayMerge(t, td)
RESULT = SLICE(t)
FEND
FUNCTION tinyPow(b, e)
DIM n = b
e = e - 1
WHILE e > 0
n = n * b
e = e - 1
WEND
RESULT = n
FEND
FUNCTION toLessThanHalfPi(Ctor, x)
isNeg = x[0] < 0
_pi = getPi(Ctor, Ctor.precision, 1)
halfPi = times(_pi, "0.5", NULL)
x = absoluteValue(x, NULL)
IFB lte(x, halfPi) THEN
quadrant = IIF(isNeg, 4, 1)
RESULT = SLICE(x)
EXIT
ENDIF
t = divToInt(x, pi)
IFB isZero(t) THEN
quadrant = IIF(isNeg, 3, 2)
ELSE
x = minus(x, times(t, pi))
// 0 <= x <pi
IFB lte(x, halfPi) THEN
quadrant = IIF(isOdd(t), IIF(isNeg, 2, 3), IIF(isNeg, 4, 1))
RESULT = SLICE(x)
EXIT
ENDIF
quadrant = IIF(isOdd(t), IIF(isNeg, 1, 4), IIF(isNeg, 3, 2))
ENDIF
RESULT = abs(minus(x, pi))
FEND
FUNCTION toLessThanHalfPi2(Ctor, x)
isNeg = x[0] < 0
_pi = getPi(Ctor, precision, 1)
halfPi = times(_pi, "0.5", NULL)
x = absoluteValue(x, NULL)
IFB lte(x, halfPi) THEN
quadrant = IIF(isNeg, 4, 1)
RESULT = SLICE(x)
EXIT
ENDIF
t = divToInt(x, pi)
IFB isZero(t) THEN
quadrant = IIF(isNeg, 3, 2)
ELSE
x = minus(x, times(t, pi), NULL)
// 0 <= x <pi
IFB lte(x, halfPi) THEN
quadrant = IIF(isOdd(t), IIF(isNeg, 2, 3), IIF(isNeg, 4, 1))
RESULT = SLICE(x)
EXIT
ENDIF
quadrant = IIF(isOdd(t), IIF(isNeg, 1, 4), IIF(isNeg, 3, 2))
ENDIF
RESULT = abs(minus(x, pi))
FEND
FUNCTION toStringBinary(x, baseOut, sd, rm)
x = IIF(VARTYPE(x) < 8192, Constructor(x), x)
isExp = IIF(sd <> NULL, TRUE, FALSE)
IFB isExp THEN
checkInt32(sd, 1, MAX_DIGITS)
IFB rm = NULL THEN
rm = rounding
ELSE
checkInt32(rm, 0, 8)
ENDIF
ELSE
sd = precision
rm = rounding
ENDIF
IFB !isFinite(x) THEN
str = nonFiniteToString(x)
ELSE
str = finiteToString(x)
i = POS(".", str) - 1
// Use exponential notation according to `toExpPos` and `toExpNeg`? No, but if required:
// maxBinaryExponent = floor((decimalExponent + 1) * log[2](10))
// minBinaryExponent = floor(decimalExponent * log[2](10))
// log[2](10) = 3.321928094887362347870319429489390175864
IFB isExp THEN
_base = 2
IFB baseOut = 16 THEN
sd = sd * 4 - 3
ELSEIF baseOut = 8 THEN
sd = sd * 3 - 2
ENDIF
ELSE
_base = baseOut
ENDIF
ENDIF
// Convert the number as an integer then divide the result by its base raised to a power such
// that the fraction part will be restored.
// Non-integer.
IFB i >= 0 THEN
str = REPLACE(str, ".", "")
y = Constructor(1)
y[1] = LENGTH(str) - i
yd = convertBase(finiteToString(y), 10, _base)
RESIZE(y, 1)
arrayMerge(y, yd)
y[1] = LENGTH(yd)
ENDIF
xd = convertBase(str, 10, _base)
len = LENGTH(xd)
e = len
// Remove trailing zeros.
len = len - 1
WHILE xd[len] = 0
arrayPop(xd)
IF len = 0 THEN BREAK
len = len - 1
WEND
IFB !xd[0] THEN
str = IIF(isExp, "0p+0", "0")
ELSE
IFB i < 0 THEN
e = e - 1
roundUp = FALSE
ELSE
// 修正
x = Constructor(x)
x = RESIZE(x, 1)
arrayMerge(x, xd)
x[1] = e
x = divide(x, y, sd, rm, 0, base)
xd = SLICE(x)
e = x[1]
roundUp = inexact
ENDIF
// The rounding digit, i.e. the digit after the digit that may be rounded up.
IFB sd > UBound(xd) THEN
i = NULL
roundUp = roundUp OR FALSE
ELSE
i = xd[sd]
roundUp = roundUp OR xd[sd + 1] <> NULL
ENDIF
k = _base / 2
IFB rm < 4 THEN
// (i !== void 0 || roundUp) && (rm === 0 || rm === (x.s < 0 ? 3 : 2))
roundUp = (i = NULL OR roundUp) AND (rm = 0 OR rm = IIF(x[0] < 0, 3, 2))
ELSE
// i > k || i === k && (rm === 4 || roundUp || rm === 6 && xd[sd - 1] & 1 ||
// rm === (x.s < 0 ? 8 : 7));
bit = IIF(sd - 1 > UBound(xd), 0, 1)
roundUp = (i > k OR i = k AND (rm = 4 OR roundUp OR rm = 6 AND bitAnd(bit, 1)) OR rm = IIF(x[0] < 0, 8, 7))
ENDIF
// roundUp = IIF(rm < 4, _
// (i <> NULL OR roundUp) AND (rm = 0 OR rm = IIF(x[0] < 0, 3, 2)), _
// i > k OR i = k AND (rm = 4 OR roundUp OR rm = 6 AND xd[sd - 1] AND 1 OR rm = IIF(x[0] < 0, 8, 7))
RESIZE(xd, sd)
IFB roundUp THEN
// Rounding up may mean the previous digit has to be rounded up and so on.
sd = sd - 1
WHILE xd[sd] > base - 1
xd[sd] = 0
IFB !sd THEN
e = e + 1
arrayUnshift(xd)
ENDIF
WEND
ENDIF
// Determine trailing zeros.
len = LENGTH(xd)
WHILE !xd[len - 1]
len = len - 1
WEND
// E.g. [4, 11, 15] becomes 4bf.
str = ""
FOR i = 0 TO len - 1
str = str + COPY(NUMERALS, VAL(xd[i]) + 1, 1)
NEXT
// Add binary exponent suffix?
IFB isExp THEN
IFB len > 1 THEN
IFB baseOut = 16 OR baseOut = 8 THEN
i = IIF(baseOut = 16, 4, 3)
WHILE len MOD i
str = str + "0"
len = len + 1
WEND
xd = convertBase(str, base, baseOut)
len = xd
WHILE !xd[len - 1]
len = len - 1
WEND
// xd[0] will always be be 1
str = "1"
FOR i = 1 TO len
str = str + COPY(NUMERALS, xd[i], 1)
NEXT
ELSE
str = COPY(str, 1, 1) + "." + COPY(str, 2)
ENDIF
ENDIF
ELSEIF e < 0 THEN
WHILE e < 0
str = "'0" + str
e = e + 1
WEND
str = "0." + str
ELSE
e = e + 1
IFB e > len THEN
FOR e = e - len TO 1 STEP -1
str = str + "0"
NEXT
ELSEIF e < len THEN
str = COPY(str, 1, e) + "." + COPY(str, e)
ENDIF
ENDIF
str = IIF(baseOut = 16, "0x", IIF(baseOut = 2, "0b", IIF(baseOut = 8, "0o", ""))) + str
ENDIF
RESULT = IIF(x[0] < 0, "-" + str, str)
FEND
FUNCTION truncate(arr, len)
IFB LENGTH(arr) > len THEN
RESIZE(arr, len)
RESULT = TRUE
EXIT
ENDIF
FEND
//////////////////////////////
// その他
//////////////////////////////
FUNCTION compare(a, b, aL, bL)
IFB aL <> bL THEN
r = IIF(aL > bL, 1, -1)
ELSE
r = 0
i = r
WHILE i < aL
IFB a[i] <> b[i] THEN
r = IIF(a[i] > b[i], 1, -1)
BREAK
ENDIF
i = i + 1
WEND
ENDIF
RESULT = r
FEND
FUNCTION Constructor(v)
CONST number = 5
CONST string = 258
DIM x = SAFEARRAY(-1)
// Duplicate.
IFB isDecimalInstance(v) THEN
x[0] = v[0]
vd = SLICE(v, 2)
IFB external THEN
IFB !LENGTH(vd) OR v[1] > maxE THEN
// Infinity.
RESIZE(x, 2)
x[1] = NULL
x[2] = NULL
ELSEIF v[1] < minE THEN
// Zero.
RESIZE(x, 2)
x[1] = 0
x[2] = 0
ELSE
RESIZE(x, 1)
x[1] = v[1]
arrayMerge(x, vd)
ENDIF
ELSE
RESIZE(x, 1)
x[1] = v[1]
arrayMerge(x, vd)
ENDIF
RESULT = SLICE(x)
EXIT
ENDIF
t = VARTYPE(v)
IFB t = number THEN
IFB v = 0 THEN
RESIZE(x, 2)
x[0] = IIF(1/v<0, -1, 1)
x[1] = 0
x[2] = 0
RESULT = SLICE(x)
EXIT
ENDIF
IFB v < 0 THEN
v = -1 * v
x[0] = -1
ELSE
x[0] = 1
ENDIF
// Fast path for small integers.
IFB v < POWER(10, 7) THEN
IFB v = VARTYPE(v, VAR_INTEGER) THEN
e = 0
i = v
WHILE i >= 10
e = e + 1
i = i / 10
WEND
IFB external THEN
IFB e > maxE THEN
RESIZE(x, 2)
x[1] = NULL
x[2] = NULL
ELSEIF e < minE THEN
RESIZE(x, 2)
x[1] = 0
x[2] = 0
ELSE
RESIZE(x, 1)
x[1] = e
arrayPush(x, v)
ENDIF
ELSE
RESIZE(x, 1)
x[1] = e
DIM tmp[] = v
arrayMerge(x, tmp)
ENDIF
RESULT = SLICE(x)
EXIT
// Infinity, NaN
ELSEIF v * 0 <> 0 THEN
IF !v THEN x[0] = NULL
x[1] = NULL
x[2] = NULL
EXIT
ENDIF
ENDIF
RESULT = parseDecimal(x, v)
EXIT
ELSEIF v = "NaN" THEN
RESIZE(x, 2)
x[0] = NULL
x[1] = NULL
x[2] = FALSE
RESULT = SLICE(x)
EXIT
ELSEIF t <> string THEN
RESULT = ERR_VALUE
EXIT
ENDIF
// Minus sign?
i = COPY(v, 1, 1)
IFB i = "-" THEN
v = COPY(v, 2)
x[0] = -1
ELSE
// Plus sign?
IF i = "+" THEN v = COPY(v, 1)
x[0] = 1
ENDIF
RESULT = IIF(reTest(v, "^(\d+(\.\d*)?|\.\d+)(e[+-]?\d+)?$"), parseDecimal(x, v), parseOther(x, v))
FEND
FUNCTION isDecimalInstance(v)
RESULT = IIF(isArray(v), TRUE, FALSE)
FEND
FUNCTION multiplyInteger(x, k, base)
DIM carry = 0
DIM i = UBound(x)
WHILE i >= 0
temp = x[i] * k + carry
x[i] = INT(temp MOD base)
carry = INT(temp / base)
i = i - 1
WEND
IF carry <> 0 THEN arrayUnshift(x, carry)
RESULT = SLICE(x)
FEND
PROCEDURE subtract(Var a, b, aL, base)
DIM i = 0
// Subtract b from a.
WHILE aL > 0
aL = aL - 1
a[aL] = a[aL] - i
i = IIF(a[aL] < b[aL], 1, 0)
a[aL] = i * base + a[aL] - b[aL]
WEND
// Remove leading zeros.
WHILE !a[0] AND LENGTH(a) > 1
arrayShift(a)
WEND
FEND
//////////////////////////////
// 自作関数
//////////////////////////////
FUNCTION calculate(str, pr = 20, rm = 4)
RESULT = tokenize(str)
RESULT = toRPN(RESULT)
RESULT = calcRPN(RESULT, pr, rm)
FEND
FUNCTION calcRPN(tokens, pr, rm)
DIM denominator[-1]
DIM numerator[-1]
FOR token IN tokens
IFB reTest(token, "[0-9.]+") THEN
arrayPush(denominator, "" + 1)
arrayPush(numerator, "" + token)
ELSEIF token = "u-" THEN
arrayPush(numerator, times("-1", arrayPop(numerator)))
ELSEIF token = "floor" THEN
bottom = arrayPop(denominator)
top = arrayPop(numerator)
arrayPush(denominator, "1")
arrayPush(numerator, floor(dividedBy(top, bottom)))
ELSEIF token = "ceil" THEN
bottom = arrayPop(denominator)
top = arrayPop(numerator)
arrayPush(denominator, "1")
arrayPush(numerator, THIS.ceil(dividedBy(top, bottom)))
ELSE
IFB token = "+" OR token = "-" THEN
DIM du = UBound(denominator)
DIM nu = UBound(numerator)
bottom = times(denominator[du], denominator[du-1])
top = EVAL(denominator[du] * numerator[nu-1] + token + numerator[nu] * denominator[du-1])
arrayPop(denominator)
arrayPop(denominator)
arrayPop(numerator)
arrayPop(numerator)
arrayPush(denominator, bottom)
arrayPush(numerator, top)
ELSEIF token = "*" THEN
arrayPush(denominator, times(arrayPop(denominator), arrayPop(denominator)))
arrayPush(numerator, times(arrayPop(numerator), arrayPop(numerator)))
ELSEIF token = "/" THEN
swap(denominator[UBound(denominator)], numerator[UBound(numerator)])
arrayPush(denominator, times(arrayPop(denominator), arrayPop(denominator)))
arrayPush(numerator, times(arrayPop(numerator), arrayPop(numerator)))
ELSEIF token = "//" THEN
swap(denominator[UBound(denominator)], numerator[UBound(numerator)])
arrayPush(denominator, times(arrayPop(denominator), arrayPop(denominator)))
arrayPush(numerator, times(arrayPop(numerator), arrayPop(numerator)))
bottom = arrayPop(denominator)
top = arrayPop(numerator)
arrayPush(denominator, "1")
arrayPush(numerator, THIS.floor(dividedBy(top, bottom)))
ELSEIF token = "%" THEN
bottom = dividedBy(arrayPop(numerator), arrayPop(denominator))
top = dividedBy(arrayPop(numerator), arrayPop(denominator))
arrayPush(denominator, "1")
arrayPush(numerator, modulo(top, bottom ))
ENDIF
ENDIF
IFB COPY(denominator[UBound(denominator)], 1, 1) = "-" THEN
denominator[UBound(denominator)] = times("-1", denominator[UBound(denominator)])
numerator[UBound(numerator)] = times("-1", numerator[UBound(numerator)])
ENDIF
NEXT
DIM x = SAFEARRAY(-1)
DIM n = dividedBy(numerator[0], denominator[0])
x = Constructor(n)
RESULT = toString(finalise(x, pr, rm))
FEND
FUNCTION cmpPrecedence(token1, token2)
DIM operators[] = "+", 0, LEFT, "-", 0, LEFT, "*", 5, LEFT, "/", 5, LEFT, "%", 5, LEFT, "^", 10, RIGHT
IFB isOperator(token1) AND isOperator(token2) THEN
RESULT = operators[arraySearch(token1, operators)+1] - operators[arraySearch(token2, operators)+1]
ELSE
RESULT = ERR_VALUE
ENDIF
FEND
FUNCTION isOperator(token)
RESULT = reTest(token, "[+\-*/%^]")
FEND
FUNCTION tokenize(expr)
DIM tokens[-1]
DIM i = 1
DIM str = ""
WHILE i <= LENGTH(expr)
char = COPY(expr, i, 1)
IFB reTest(char, "\s") THEN
i = i + 1
CONTINUE
ENDIF
IFB reTest(char, "[0-9.]") THEN
num = char
i = i + 1
WHILE i <= LENGTH(expr) AND reTest(COPY(expr, i, 1), "[0-9.]")
num = num + COPY(expr, i, 1)
i = i + 1
WEND
arrayPush(tokens, VAL(num))
CONTINUE
ENDIF
IFB reTest(char, "[+\-*/^%]") THEN
IFB COPY(expr, i, 2) = "//" THEN
arrayPush(tokens, "//")
i = i + 2
ELSE
DIM prev = ""
IF LENGTH(tokens) >= 1 THEN prev = tokens[LENGTH(tokens)-1]
IFB char = "-" AND (LENGTH(tokens) = 0 OR (VARTYPE(prev) = 258 AND (isOperator(prev) OR prev = "(")))
arrayPush(tokens, "u-")
ELSE
arrayPush(tokens, char)
ENDIF
i = i + 1
ENDIF
CONTINUE
ENDIF
IFB reTest(char, "[A-Za-z0-9]") THEN
str = str + char
i = i + 1
WHILE i <= LENGTH(expr) AND reTest(COPY(expr, i, 1), "[A-Za-z0-9]")
str = str + COPY(expr, i, 1)
i = i + 1
WEND
arrayPush(tokens, str)
str = ""
CONTINUE
ENDIF
IFB reTest(char, "[()]") THEN
IFB str <> "" THEN
arrayPush(tokens, str)
str = ""
ENDIF
arrayPush(tokens, char)
i = i + 1
CONTINUE
ENDIF
WEND
RESULT = SLICE(tokens)
FEND
FUNCTION toRPN(tokens, pr = 20, rm = 4, isnumeric = FALSE)
HASHTBL precedence
precedence["^"] = 4
precedence["u-"] = 3
precedence["*"] = 2
precedence["/"] = 2
precedence["%"] = 2
precedence["+"] = 1
precedence["-"] = 1
HASHTBL rightAssociative
rightAssociative["u-"] = TRUE
rightAssociative["^"] = TRUE
DIM output[-1]
DIM stack[-1]
FOR token IN tokens
IFB reTest(token, "[0-9]+") THEN
arrayPush(output, token)
ELSEIF token = "floor" OR token = "ceil" THEN
arrayPush(stack, token)
ELSEIF token ="(" THEN
arrayPush(stack, token)
ELSEIF token = ")" THEN
WHILE LENGTH(stack) <> 0 AND stack[LENGTH(stack)-1] <> "("
arrayPush(output, arrayPop(stack))
WEND
arrayPop(stack)
IFB LENGTH(stack) <> 0 THEN
IF stack[LENGTH(stack) - 1] = "floor" OR stack[LENGTH(stack) - 1] = "ceil" THEN arrayPush(output, arrayPop(stack))
ENDIF
ELSE
WHILE LENGTH(stack)
IFB stack[LENGTH(stack)-1] <> "(" AND _
( _
precedence[token] < precedence[stack[LENGTH(stack)-1]] OR _
( _
precedence[token] = precedence[stack[LENGTH(stack)-1]] AND _
!rightAssociative[token] _
) _
) THEN
arrayPush(output, arrayPop(stack))
ELSE
BREAK
ENDIF
WEND
arrayPush(stack, token)
ENDIF
NEXT
WHILE LENGTH(stack)
arrayPush(output, arrayPop(stack))
WEND
RESULT = SLICE(output)
FEND
ENDMODULE
//////////////////////////////////////////////////
// 【引数】
// num : 数値
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION decimalDigits(num)
DIM str = fixed(num)
RESULT = IIF(POS(".", str), LENGTH(BETWEENSTR(str, ".")), 0)
FEND
//////////////////////////////////////////////////
// 【引数】
// dec : 10進数
// signFlg : 符号付きならばTrueを指定
// digits : 変換した2進数の桁数合わせを自動で行うかを示すブール値、もしくは桁数を表す数値（8,16,24,32,64のいずれか）を指定
// errorMsg : エラーメッセージを出力するかを示すブール値
// 【戻り値】
// 2進数に変換した値
//////////////////////////////////////////////////
FUNCTION decToBin(dec, signFlg = FALSE, digits = FALSE, errorMsg = FALSE)
// 負数で符号なしならばエラー値を返す
IFB dec < 0 AND signFlg = FALSE THEN
PRINT "負数の場合signFlgにTrueを指定してください"
RESULT = ERR_VALUE
EXIT
ENDIF
// digitsのビット数が足りなければエラー値を返す、負数なら1桁多く取る
IFB VARTYPE(digits) <> VAR_BOOLEAN AND digits < CEIL(LOGN(2, ABS(dec))) + IIF(dec < 0, 1, 0) THEN
PRINT "ビット数が足りません"
RESULT = ERR_VALUE
EXIT
ENDIF
// signFlgがTrueかつdigitsがFalseならばエラー値を返す
IFB signFlg AND !digits THEN
PRINT "signFlgがTrueのときdigitsはFalse以外を選択してください"
RESULT = ERR_VALUE
EXIT
ENDIF
// bin：2進数に変換した結果を代入する変数
DIM bin = ""
DIM msg = ""
DIM isError = FALSE
DIM decimalFlg = IIF(POS(".", dec) <> 0, TRUE, FALSE)
DIM negativeFlg = IIF(dec < 0, TRUE, FALSE)
dec = ABS(dec)
// (1) 10進数を整数部と小数部に分ける
DIM integer = IIF(decimalFlg, COPY(dec, 1, POS(".", dec) - 1), dec)
DIM decimal = IIF(decimalFlg, "0." + COPY(dec, POS(".", dec) + 1), 0)
// (2) 10進数（整数部）を2進数に変換する。
REPEAT
bin = (integer MOD 2) + bin
integer = INT(integer / 2)
UNTIL integer = 0
// (3) 10進数（小数部）を2進数に変換する。
IFB decimalFlg THEN
bin = bin + "."
DIM loop = 0
REPEAT
loop = loop + 1
decimal = decimal * 2
bin = bin + IIF(decimal >= 1, "1", "0")
IF decimal > 1 THEN decimal = decimal - 1
UNTIL decimal = 1 OR loop > 64
ENDIF
// digitsがFALSE以外なら
IFB digits THEN
// (4) 2進数の桁合わせを行う
DIM tmp = bin
DIM binInteger = TOKEN(".", tmp)
DIM binDecimal = TOKEN(".", tmp)
// 整数部、小数部を4bit単位になるまで拡張
// 整数部、4の倍数になるまで整数部の先頭に'0'を追加
IF LENGTH(binInteger) MOD 4 <> 0 THEN binInteger = strRepeat("0", 4 - LENGTH(binInteger) MOD 4) + binInteger
// 小数部、4の倍数になるまで小数部の末尾に'0'を追加
IF LENGTH(binDecimal) MOD 4 <> 0 THEN binDecimal = binDecimal + strRepeat("0", 4 - LENGTH(binDecimal) MOD 4)
DIM digit = LENGTH(binInteger + binDecimal)
// 10進数の場合、一旦自動調整を行う
integer = INT(dec)
IF signFlg AND COPY(binInteger, 1, 1) = "1" THEN binInteger = strRepeat("0", 4) + binInteger
IFB signFlg THEN
IFB integer >= -128 AND integer <= 127 THEN // -2^7〜2^7-1
binInteger = strRepeat("0", 8 - LENGTH(binInteger)) + binInteger
ELSEIF integer >= -32768 AND integer <= 32767 THEN // -2^15〜2^15-1
binInteger = strRepeat("0", 16 - LENGTH(binInteger)) + binInteger
ELSEIF integer >= -8388608 AND integer <= 8388607 THEN // -2^23〜2^23-1
binInteger = strRepeat("0", 24 - LENGTH(binInteger)) + binInteger
ELSEIF integer >= -2147783648 AND integer <= 2147483647 THEN // -2^31〜2^31-1
binInteger = strRepeat("0", 32 - LENGTH(binInteger)) + binInteger
ELSE
binInteger = strRepeat("0", 64 - LENGTH(binInteger)) + binInteger
ENDIF
ELSE
IFB integer <= 255 THEN // 2^8-1
binInteger = strRepeat("0", 8 - LENGTH(binInteger)) + binInteger
ELSEIF integer <= 65535 THEN // 2^16-1
binInteger = strRepeat("0", 16 - LENGTH(binInteger)) + binInteger
ELSEIF integer <= 16777215 THEN // 2^24-1
binInteger = strRepeat("0", 24 - LENGTH(binInteger)) + binInteger
ELSEIF integer <= 4294967295 THEN // 2^32-1
binInteger = strRepeat("0", 32 - LENGTH(binInteger)) + binInteger
ELSE
binInteger = strRepeat("0", 64 - LENGTH(binInteger)) + binInteger
ENDIF
ENDIF
totalDigits = LENGTH(binInteger + binDecimal)
IFB totalDigits > 64 THEN
DIM del32 = totalDigits - 32
DIM del64 = totalDigits - 64
IFB del32 = LENGTH(binDecimal) AND digits <> 64 THEN
binDecimal = ""
msg = "32bitを超えたため、小数点以下を削除しました"
ELSEIF del32 < LENGTH(binDecimal) AND digits <> 64 THEN
binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - del32)
msg = "32bitを超えたため、小数点以下の一部を削除しました"
ELSEIF del64 = LENGTH(binDecimal) AND del64 <> 0 THEN
binDecimal = ""
msg = "64bitを超えたため、小数点以下を削除しました"
ELSEIF del64 < LENGTH(binDecimal) THEN
binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - del64)
msg = "64bitを超えたため、小数点以下の一部を削除しました"
ELSE
msg = "64bitを超えるため、変換できません"
isError = TRUE
ENDIF
ENDIF
// 整数部、小数部の合計桁数を8,16,24,32,64bit単位になるまで拡張
digit = LENGTH(binInteger + binDecimal)
DIM array[] = 8, 16, 24, 32, 64
FOR item IN array
IFB digit <= item THEN
binInteger = strRepeat("0", item - digit) + binInteger
BREAK
ENDIF
NEXT
// 指定ビットに調整
// 合計桁数の再設定
totalDigits = LENGTH(binInteger + binDecimal)
IFB digits = TRUE THEN
// 桁合わせを自動調整
IFB totalDigits > 64 THEN
len = LENGTH(binInteger + binDecimal)
WHILE LENGTH(binInteger) > 8 AND len > digits
IFB COPY(binInteger, 1, 4) = "0000" THEN
binInteger = COPY(binInteger, 5)
len = len - 4
ELSE
BREAK
ENDIF
WEND
WHILE LENGTH(binDecimal) > 4 AND LENGTH(binInteger + binDecimal) > digits
IFB COPY(binDecimal, LENGTH(binDecimal) - 4) = "0000" THEN
binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - 4)
ELSE
BREAK
ENDIF
WEND
tmp = binInteger + "." + binDecimal
binInteger = COPY(tmp, 1, POS(".", tmp) - 1)
binDecimal = COPY(tmp, POS(".", tmp) + 1)
totalDigits = LENGTH(binInteger + binDecimal)
IFB totalDigits > 64 THEN
isError = TRUE
msg = "64bitを超えたため変換できません"
ENDIF
ENDIF
ELSE
// 指定ビットに調整
IFB totalDigits <= digits THEN
binInteger = strPad(binInteger, digits - LENGTH(binDecimal), "0", LEFT)
ELSE
// 桁あふれ調整
totalDigits = LENGTH(binInteger + binDecimal)
len = LENGTH(binInteger + binDecimal)
WHILE LENGTH(binInteger) > 8 AND len > digits
IFB COPY(binInteger, 1, 4) = "0000" THEN
binInteger = COPY(binInteger, 5)
len = len - 4
ELSE
BREAK
ENDIF
WEND
WHILE LENGTH(binDecimal) > 4 AND LENGTH(binInteger + binDecimal) > digits
IFB COPY(binDecimal, LENGTH(binDecimal) - 4) = "0000" THEN
binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - 4)
ELSE
BREAK
ENDIF
WEND
tmp = binInteger + "." + binDecimal
binInteger = COPY(tmp, 1, POS(".", tmp) - 1)
binDecimal = COPY(tmp, POS(".", tmp) + 1)
len = LENGTH(binInteger + binDecimal)
IFB len > digits THEN
DIM deleteLength = len - digits
IFB deleteLength = LENGTH(binDecimal) THEN
binDecimal = ""
msg = "指定ビット数にするため小数点以下を削除しました"
ELSEIF deleteLength < LENGTH(binDecimal) THEN
binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - deleteLength)
msg = "指定ビット数にするため小数点以下の一部を削除しました"
ELSE
isError = TRUE
msg = "指定ビット数では変換できません"
ENDIF
ENDIF
ENDIF
ENDIF
bin = binInteger + IIF(binDecimal <> "", "." + binDecimal, "")
// (5) 入力値がマイナスのため、2進数をマイナス値に変換する
IFB negativeFlg THEN
// 1の補数
bin = bitNot(bin)
// 2の補数
DIM res = ""
DIM carry = "1"
FOR i = LENGTH(bin) TO 1 STEP -1
IFB carry = "1" THEN
SELECT COPY(bin, i, 1)
CASE "0"
res = "1" + res
carry = 0
CASE "1"
res = "0" + res
DEFAULT
res = COPY(bin, i, 1) + res
SELEND
ELSE
res = COPY(bin, i, 1) + res
ENDIF
NEXT
bin = res
ENDIF
ENDIF
IF errorMsg AND msg <> "" THEN PRINT msg
RESULT = IIF(isError, ERR_VALUE, bin)
FEND
//////////////////////////////////////////////////
// 【引数】
// dec : 10進数
// signFlg : 符号付きならばTrue
// digits : 変換した16進数の桁数合わせを自動で行うかを示すブール値、もしくは桁数を表す数値（8,16,24,32,64のいずれか）を指定
// errorMsg : エラーメッセージを出力するかを示すブール値
// 【戻り値】
// 16進数に変換した値
//////////////////////////////////////////////////
FUNCTION decToHex(dec, signFlg = FALSE, digits = FALSE, errorMsg = FALSE)
DIM hex = ""
DIM msg = ""
DIM isError = FALSE
DIM dec2hex[] = "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F"
DIM decimalFlg = IIF(POS(".", dec) <> 0, TRUE, FALSE)
DIM negativeFlg = IIF(dec < 0, TRUE, FALSE)
dec = Decimal.absoluteValue(dec)//dec = ABS(dec)
// (1) 10進数を整数部と小数部に分ける
DIM integer = Decimal.floor(dec)
DIM decimal = Decimal.modulo(dec, "1")
// (2) 10進数（整数部）を16進数に変換する。
REPEAT
hex = dec2hex[Decimal.modulo(integer, 16)] + hex
integer = Decimal.truncated(Decimal.dividedBy(integer, 16))
UNTIL Decimal.equals(integer, 0)
// (3) 10進数（小数部）を16進数に変換する。
IFB decimalFlg THEN
hex = hex + "."
DIM loop = 0
REPEAT
loop = loop + 1
decimal = Decimal.times(decimal, 16)
hex = hex + dec2hex[decimal]
offset = Decimal.toPower(10, LENGTH(decimal) - POS(".", decimal))
decimal = Decimal.dividedBy(Decimal.minus(Decimal.times(decimal, offset), Decimal.times(Decimal.truncated(decimal), offset)), offset)
UNTIL Decimal.equals(decimal, 0) OR loop > 16
ENDIF
// digitsがFALSE以外ならば
IFB digits THEN
// (4) 16進数の桁合わせを行う
DIM tmp = hex
DIM hexInteger = TOKEN(".", tmp)
DIM hexDecimal = TOKEN(".", tmp)
// 整数部、小数部を4bit単位になるまで拡張
// 整数部、4の倍数になるまで整数部の先頭に'0'を追加
// ※16進数は4bit単位なのでこの処理は不要
DIM digit = LENGTH(hexInteger + hexDecimal)
integer = Decimal.truncated(dec)
IF signFlg AND COPY(hexToBin(hexInteger), 1, 1) = "1" THEN hexInteger = "0" + hexInteger
IFB signFlg THEN
WITH Decimal
IFB .greaterThanOrEqualTo(integer, -128) AND .lessThanOrEqualTo(integer, 127) THEN // -2^7〜2^7-1
hexInteger = strRepeat("0", 2 - LENGTH(hexInteger)) + hexInteger
ELSEIF .greaterThanOrEqualTo(integer, -32768) AND .lessThanOrEqualTo(integer, 32767) THEN // -2^15〜2^15-1
hexInteger = strRepeat("0", 4 - LENGTH(hexInteger)) + hexInteger
ELSEIF .greaterThanOrEqualTo(integer, -8388608) AND .lessThanOrEqualTo(integer, 8388607) THEN // -2^23〜2^23-1
hexInteger = strRepeat("0", 6 - LENGTH(hexInteger)) + hexInteger
ELSEIF .greaterThanOrEqualTo(integer, -2147783648) AND .lessThanOrEqualTo(integer, 2147483647) THEN // -2^31〜2^31-1
hexInteger = strRepeat("0", 8 - LENGTH(hexInteger)) + hexInteger
ELSE
hexInteger = strRepeat("0", 16 - LENGTH(hexInteger)) + hexInteger
ENDIF
ENDWITH
ELSE
WITH Decimal
IFB .lessThanOrEqualTo(integer, 255) THEN // 2^8-1
hexInteger = strRepeat("0", 2 - LENGTH(hexInteger)) + hexInteger
ELSEIF .lessThanOrEqualTo(integer, 65535) THEN // 2^16-1
hexInteger = strRepeat("0", 4 - LENGTH(hexInteger)) + hexInteger
ELSEIF .lessThanOrEqualTo(integer, 16777215) THEN // 2^24-1
hexInteger = strRepeat("0", 6 - LENGTH(hexInteger)) + hexInteger
ELSEIF .lessThanOrEqualTo(integer, 4294967295) THEN // 2^32-1
hexInteger = strRepeat("0", 8 - LENGTH(hexInteger)) + hexInteger
ELSE
hexInteger = strRepeat("0", 16 - LENGTH(hexInteger)) + hexInteger
ENDIF
ENDWITH
ENDIF
totalDigits = LENGTH(hexInteger + hexDecimal) * 4
// 64bitを超えたら
IFB totalDigits > 64 THEN
DIM del32 = totalDigits - 32
DIM del64 = totalDigits - 64
IFB del32 = LENGTH(hexDecimal) * 4 AND digits <> 64 THEN
hexDecimal = ""
msg = "32bitを超えたため、小数点以下を削除しました"
ELSEIF del32 < LENGTH(hexDecimal) * 4 AND digits <> 64 THEN
hexDecimal = COPY(hexDecimal, 1, (LENGTH(hexDecimal) * 4 - del32) / 4)
msg = "32bitを超えたため、小数点以下の一部を削除しました"
ELSEIF del64 = LENGTH(hexDecimal) * 4 AND del64 <> 0 THEN
hexDecimal = ""
msg = "64bitを超えたため、小数点以下を削除しました"
ELSEIF del64 < LENGTH(hexDecimal) * 4 THEN
hexDecimal = COPY(hexDecimal, 1, (LENGTH(hexDecimal) * 4 - del64) / 4)
msg = "64bitを超えたため、小数点以下の一部を削除しました"
ELSE
isError = TRUE
msg = "64bitを超えるため、変換できません"
ENDIF
ENDIF
// 整数部、小数部の合計桁数を8,16,24,32,64bit単位になるまで拡張
digit = LENGTH(hexInteger + hexDecimal) * 4
DIM array[] = 8, 16, 24, 32, 64
FOR item IN array
IFB digit <= item THEN
hexInteger = strRepeat("0", (item - digit) / 4) + hexInteger
BREAK
ENDIF
NEXT
totalDigits = LENGTH(hexInteger + hexDecimal) * 4
IFB digits = TRUE THEN
// 桁合わせを自動調整
IFB totalDigits > 64 THEN
digit = LENGTH(hexInteger + hexDecimal)
WHILE LENGTH(hexInteger) > 8 AND digit > digits
IFB COPY(hexInteger, 1, 1) = "0" THEN
digit = digit - 1
ELSE
BREAK
ENDIF
WEND
WHILE LENGTH(hexDecimal) * 4 > 4 AND LENGTH(hexInteger + hexDecimal) > digits
IFB COPY(hexDecimal, LENGTH(hexDecimal) - 1) = "0" THEN
hexDecimal = COPY(hexDecimal, 1, LENGTH(hexDecimal) - 1)
ELSE
BREAK
ENDIF
WEND
tmp = hexInteger + "." + hexDecimal
hexInteger = COPY(tmp, 1, POS(".", tmp) - 1)
hexDecimal = COPY(tmp, POS(".", tmp) + 1)
totalDigits = LENGTH(hexInteger + hexDecimal)
IFB totalDigits > 64 THEN
isError = TRUE
msg = "64bitを超えたため変換できません"
ENDIF
ENDIF
ELSE
// 指定ビットに調整
IFB totalDigits <= digits THEN
hexInteger = strPad(hexInteger, digits / 4 - LENGTH(hexDecimal), "0", LEFT)
ELSE
// 桁あふれ調整
totalDigits = LENGTH(hexInteger + hexDecimal)
digit = LENGTH(hexInteger + hexDecimal)
WHILE LENGTH(hexInteger) * 4 > 8 AND digit > digits
IFB COPY(hexInteger, 1, 1) = "0" THEN
hexInteger = COPY(hexInteger, 2)
digit = digit - 4 / 4
ELSE
BREAK
ENDIF
WEND
WHILE LENGTH(hexDecimal) * 4 > 4 AND LENGTH(hexInteger + hexDecimal) > digits
IFB COPY(hexDecimal, LENGTH(hexDecimal) - 1) = "0" THEN
hexDecimal = COPY(hexDecimal, 1, LENGTH(hexDecimal) - 1)
ELSE
BREAK
ENDIF
WEND
tmp = hexInteger + "." + hexDecimal
hexInteger = COPY(tmp, 1, POS(".", tmp) - 1)
hexDecimal = COPY(tmp, POS(".", tmp) + 1)
digit = LENGTH(hexInteger + hexDecimal) * 4
IFB digit > digits THEN
DIM deleteLength = digit - digits
IFB deleteLength = LENGTH(hexDecimal) * 4 THEN
hexDecimal = ""
msg = "指定ビット数にするため小数点以下を削除しました"
ELSEIF deleteLength < LENGTH(hexDecimal) * 4 THEN
hexDecimal = COPY(hexDecimal, 1, LENGTH(hexDecimal) - deleteLength / 4)
msg = "指定ビット数にするため小数点以下の一部を削除しました"
ELSE
isError = TRUE
msg = "指定ビット数では変換できません"
ENDIF
ENDIF
ENDIF
ENDIF
hex = hexInteger + IIF(hexDecimal <> "", "." + hexDecimal, "")
// (5) 入力値がマイナスのため、16進数をマイナス値に変換する
IFB negativeFlg THEN
bin = hexToBin(hex)
// 1の補数
bin = bitNot(bin)
// 2の補数
DIM res = ""
DIM carry = "1"
FOR i = LENGTH(bin) TO 1 STEP -1
IFB carry = "1" THEN
SELECT COPY(bin, i, 1)
CASE "0"
res = "1" + res
carry = 0
CASE "1"
res = "0" + res
DEFAULT
res = COPY(bin, i, 1) + res
SELEND
ELSE
res = COPY(bin, i, 1) + res
ENDIF
NEXT
hex = binToHex(res)
ENDIF
ENDIF
IF errorMsg AND msg <> "" THEN PRINT msg
RESULT = IIF(isError, ERR_VALUE, hex)
FEND
//////////////////////////////////////////////////
// 【引数】
// dividend : 被除数
// divisor : 除数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION division(dividend, divisor)
DIM array[] = dividend, divisor
DIM g = GCD(array)
DIM tmp = divisor / g
DIM dat[] = 10, 5, 2
DIM position = 0
FOR i = 0 TO UBound(dat)
WHILE tmp MOD dat[i] = 0
tmp = INT(tmp / dat[i])
position = position + 1
WEND
NEXT
DIM repetend = ""
DIM res = ""
tmp = 0
i = 0
WHILE TRUE
DIM quotient = INT(dividend/divisor)
DIM remainder = dividend MOD divisor
IF i = position THEN tmp = remainder
IFB i > position THEN
repetend = repetend + quotient
ELSE
res = res + quotient
IF i = 0 THEN res = res + "."
ENDIF
IF i > position AND tmp = remainder THEN BREAK
dividend = remainder * 10
i = i + 1
WEND
RESULT = res + IIF(repetend<>0, "[" + repetend + "]", "")
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 数値
// digits : 小数点以下の桁数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION fixed(num, digits = EMPTY)
num = VAL(num) // 指数表記を整える
IFB POS("E-", num) THEN
DIM mantissa = BETWEENSTR(num,, "E")
DIM exponent = BETWEENSTR(num, "E")
RESULT = "0." + strRepeat("0", VAL(ABS(exponent) - 1)) + REPLACE(mantissa, ".", "")
ELSEIF POS("E", num) THEN
RESULT = ROUND(num, -1 *digits)
mantissa = BETWEENSTR(num,, "E")
exponent = BETWEENSTR(num, "E")
RESULT = REPLACE(mantissa, ".", "") + strRepeat("0", VAL(exponent) - decimalDigits(mantissa))
ELSEIF LENGTH(BETWEENSTR(num, ".")) < digits THEN
DIM keta = digits - LENGTH(BETWEENSTR(num, "."))
RESULT = num + IIF(POS(".", num) OR keta = 0, "", ".") + strRepeat("0", keta)
ELSE
IF digits = EMPTY THEN digits = LENGTH(BETWEENSTR(num, "."))
RESULT = "" + roundOff(num, digits)
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 丸め処理を行う値
// 【戻り値】
// 負の方向に丸めた値
//////////////////////////////////////////////////
FUNCTION floor(num)
RESULT = INT(num) + IIF(num < 0 AND num <> INT(num), -1, 0)
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 最大公約数を求める数値を格納した配列
// 【戻り値】
// 最大公約数
//////////////////////////////////////////////////
FUNCTION GCD(array[])
DIM c = LENGTH(array)
DIM rem = array[c-1] MOD array[c-2]
IFB rem = 0 THEN
IFB LENGTH(array) = 2 THEN
RESULT = array[c-2]
EXIT
ENDIF
RESIZE(array, c-2)
RESULT = GCD(array)
EXIT
ENDIF
array[c-1] = array[c-2]
array[c-2] = rem
RESULT = GCD(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）
// m : 第一引数の指定日からプラスマイナスm月とする
// 【戻り値】
// dateからm月後の月末の日付
//////////////////////////////////////////////////
FUNCTION getEndOfMonth(date, m = 0)
date = dateAdd("m", m + 1, date)
GETTIME(0, date)
GETTIME(-G_TIME_DD, date)
RESULT = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付文字列（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）もしくはシリアル値
// type : 取得する曜日番号の種類を示す0〜3または11〜17の値。1と17は日曜日を1、2と11は月曜日を1とカウントします。11以降はExcel2010で追加された値で、互換性を保つために重複した値があります。
// 【戻り値】
// typeで指定した種類によって以下の値を返します。 : （0 : 0(日曜)〜6(土曜)、1 : 1(日曜)～7(土曜)、2 : 1(月曜)～7(日曜)、3 : 0(月曜)〜6(日曜)、11 : 1(月曜)～7(日曜)、12 : 1(火曜)～7(月曜)、13 : 1(水曜)～7(火曜)、14 : 1(木曜)～7(水曜)、15 : 1(金曜)～7(木曜)、16 : 1(土曜)～7(金曜)、17 : 1(日曜)～7(土曜)）
//////////////////////////////////////////////////
FUNCTION getWeekday(date, type = 1)
IF VARTYPE(date) <> 258 THEN date = text(date, "yyyy/mm/dd")
GETTIME(0, date)
DIM w = G_TIME_WW
SELECT TRUE
CASE type = 0
RESULT = w
CASE type = 1
RESULT = w + 1
CASE type = 2
RESULT = IIF(w=0, 7, w)
CASE type = 3
RESULT = (w+6) MOD 7
CASE type >= 11
RESULT = ((getWeekday(date, 2) + 17 - type) MOD 7) + 1
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// str : ハッシュ化する文字列
// 【戻り値】
// ハッシュ化した文字列
//////////////////////////////////////////////////
MODULE Hash
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM path
PROCEDURE Hash()
CONST TemporaryFolder = 2
DIM Folder = FSO.GetSpecialFolder(TemporaryFolder)
DIM folderspec = Folder.Path
DIM filename = FSO.GetTempName
path = FSO.BuildPath(folderspec, filename)
FEND
FUNCTION md2(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD2 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION md4(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD4 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION md5(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD5 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha1(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA1 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha256(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA256 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha384(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA384 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha512(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA512 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
ENDMODULE
//////////////////////////////////////////////////
// 【引数】
// hex : 16進数
// 【戻り値】
// 2進数に変換した値
//////////////////////////////////////////////////
FUNCTION hexToBin(hex)
HASHTBL hb
hb["0"] = "0000"; hb["1"] = "0001"; hb["2"] = "0010"; hb["3"] = "0011";
hb["4"] = "0100"; hb["5"] = "0101"; hb["6"] = "0110"; hb["7"] = "0111";
hb["8"] = "1000"; hb["9"] = "1001"; hb["A"] = "1010"; hb["B"] = "1011";
hb["C"] = "1100"; hb["D"] = "1101"; hb["E"] = "1110"; hb["F"] = "1111";
DIM bin = ""
IFB POS(".", hex) <> 0 THEN
FOR i = 1 TO LENGTH(hex)
DIM str = COPY(hex, i, 1)
IF str = "." THEN bin = bin + "."
bin = bin + hb[str]
NEXT
ELSE
FOR i = 1 TO LENGTH(hex)
bin = bin + hb[COPY(hex, i, 1)]
NEXT
ENDIF
RESULT = bin
FEND
//////////////////////////////////////////////////
// 【引数】
// hex : 16進数
// signFlg : 符号付きならばTrue
// 【戻り値】
// 10進数に変換した値
//////////////////////////////////////////////////
FUNCTION hexToDec(hex, signFlg = TRUE)
hex = STRCONV(hex, SC_UPPERCASE)
DIM dec = 0
DIM decimalFlg = IIF(POS(".", hex) <> 0, TRUE, FALSE)
hex = IIF(LENGTH(REPLACE(hex,".", "" )) MOD 2 <> 0, "0", "") + hex
DIM negativeFlg = IIF(COPY(hexToBin(hex), 1, 1) = "1", TRUE, FALSE)
DIM sign = 1
IF negativeFlg AND signFlg THEN sign = -1
IFB negativeFlg AND signFlg THEN
DIM bin = hexToBin(hex)
DIM msb = IIF(decimalFlg, POS(".", bin) - 1, LENGTH(bin))
DIM lsb = IIF(decimalFlg, POS(".", bin) - LENGTH(bin), 0)
DIM a = hexToDec(hex, FALSE)
DIM b = POWER(2, msb) - 1
FOR i = -1 TO lsb STEP -1
b = b + POWER(2, i)
NEXT
DIM dec2 = bitXor(a, b) + POWER(2, lsb)
hex = decToHex(dec2)
ENDIF
integer = IIF(decimalFlg, COPY(hex, 1, POS(".", hex) - 1), hex)
decimal = IIF(decimalFlg, COPY(hex, POS(".", hex) + 1), "0")
FOR i = 1 TO LENGTH(integer)
s = COPY(hex, i, 1)
num = IIF(CHKNUM(s), s, ASC(s) - (ASC("A") - 10))
dec = dec + num * POWER(16, LENGTH(integer) - i)
NEXT
FOR i = 1 TO LENGTH(decimal)
s = COPY(decimal, i, 1)
num = IIF(CHKNUM(s), s, ASC(s) - (ASC("A") - 10))
dec = dec + num * POWER(16, -1 * i)
NEXT
RESULT = sign * dec
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : シリアル値もしくは時刻文字列
// 【戻り値】
// 時刻から時間を表す0〜23の範囲の値
//////////////////////////////////////////////////
FUNCTION Hour(serial)
IF VARTYPE(serial) = 258 THEN serial = timeValue(serial)
RESULT = INT(serial * 24) MOD 24
FEND
//////////////////////////////////////////////////
// 【引数】
// expr : 評価する式
// truepart : 評価した式がTrueのときに返す値
// falsepart : 評価した式がFalseのときに返す値
// 【戻り値】
// truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき
//////////////////////////////////////////////////
FUNCTION IIF(expr, truepart, falsepart)
IFB EVAL(expr) THEN
RESULT = truepart
ELSE
RESULT = falsepart
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// variable : 型を調べる変数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION isArray(variable[])
RESULT = IIF(VARTYPE(variable) AND 8192, TRUE, FALSE)
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 存在するかを調べる日付文字列。YYYYMMDD or YYYY/MM/DD or YYYY-MM-DDのいずれかの形式。
// 【戻り値】
// TRUE : 日付として認識できる、FALSE : 日付として認識できない
//////////////////////////////////////////////////
FUNCTION isDate(date)
TRY
GETTIME(0, date)
RESULT = TRUE
EXCEPT
RESULT = FALSE
ENDTRY
FEND
//////////////////////////////////////////////////
// 【引数】
// variable : 型を調べる変数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION isFloat(variable)
IFB VAL(variable) <> ERR_VALUE THEN
RESULT = IIF((VARTYPE(variable) = VAR_SINGLE OR VARTYPE(variable) = VAR_DOUBLE) AND INT(variable) <> variable, TRUE, FALSE)
ELSE
RESULT = FALSE
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// variable : 型を調べる変数
// 【戻り値】
// : TRUE : 与えられた変数が文字列型である、
// FALSE : 与えられた変数が文字列型でない、 :
//////////////////////////////////////////////////
FUNCTION isString(variable)
RESULT = IIF(VARTYPE(variable) = VAR_ASTR OR VARTYPE(variable) = VAR_USTR, TRUE, FALSE)
FEND
//////////////////////////////////////////////////
// 【引数】
// text : JSONとして解析する文字列
// value : JSON文字列に変換する値
// reviver : 使用不可
// replacer : 使用不可
// space : 出力するJSON文字列に空白を挿入するための文字列もしくは数値
// 【戻り値】
// : Parse : JSON文字列をオブジェクトに変換、
// Stringify : オブジェクトをJSON文字列に変換、 :
//////////////////////////////////////////////////
MODULE JSON
DIM SC, CodeObject
PROCEDURE JSON
SC = CREATEOLEOBJ("ScriptControl")
WITH SC
.Language = "JScript"
.ExecuteStatement(json2)
.ExecuteStatement(statement)
CodeObject = .CodeObject
ENDWITH
FEND
FUNCTION Parse(text, reviver = NULL)
RESULT = CodeObject.JSON.parse(text, reviver)
FEND
FUNCTION Stringify(value, replacer = "", space = FALSE)
RESULT = CodeObject.JSON.stringify(value, NULL, replacer)
IF space THEN RESULT = REPLACE(RESULT, CHR(10), "<#CR>")
FEND
ENDMODULE
TEXTBLOCK statement
Array.prototype.Item = function(i, value){
if(value === undefined) return this[i]; this[i] = value;
}
Array.prototype.item = Array.prototype.Item;
ENDTEXTBLOCK
TEXTBLOCK json2
// json2.js
// 2023-05-10
// Public Domain.
// NO WARRANTY EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
// USE YOUR OWN COPY. IT IS EXTREMELY UNWISE TO LOAD CODE FROM SERVERS YOU DO
// NOT CONTROL.
// This file creates a global JSON object containing two methods: stringify
// and parse. This file provides the ES5 JSON capability to ES3 systems.
// If a project might run on IE8 or earlier, then this file should be included.
// This file does nothing on ES5 systems.
// JSON.stringify(value, replacer, space)
// value any JavaScript value, usually an object or array.
// replacer an optional parameter that determines how object
// values are stringified for objects. It can be a
// function or an array of strings.
// space an optional parameter that specifies the indentation
// of nested structures. If it is omitted, the text will
// be packed without extra whitespace. If it is a number,
// it will specify the number of spaces to indent at each
// level. If it is a string (such as "\t" or " "),
// it contains the characters used to indent at each level.
// This method produces a JSON text from a JavaScript value.
// When an object value is found, if the object contains a toJSON
// method, its toJSON method will be called and the result will be
// stringified. A toJSON method does not serialize: it returns the
// value represented by the name/value pair that should be serialized,
// or undefined if nothing should be serialized. The toJSON method
// will be passed the key associated with the value, and this will be
// bound to the value.
// For example, this would serialize Dates as ISO strings.
// Date.prototype.toJSON = function (key) {
// function f(n) {
// // Format integers to have at least two digits.
// return (n < 10)
// ? "0" + n
// : n;
// }
// return this.getUTCFullYear() + "-" +
// f(this.getUTCMonth() + 1) + "-" +
// f(this.getUTCDate()) + "T" +
// f(this.getUTCHours()) + ":" +
// f(this.getUTCMinutes()) + ":" +
// f(this.getUTCSeconds()) + "Z";
// };
// You can provide an optional replacer method. It will be passed the
// key and value of each member, with this bound to the containing
// object. The value that is returned from your method will be
// serialized. If your method returns undefined, then the member will
// be excluded from the serialization.
// If the replacer parameter is an array of strings, then it will be
// used to select the members to be serialized. It filters the results
// such that only members with keys listed in the replacer array are
// stringified.
// Values that do not have JSON representations, such as undefined or
// functions, will not be serialized. Such values in objects will be
// dropped; in arrays they will be replaced with null. You can use
// a replacer function to replace those with JSON values.
// JSON.stringify(undefined) returns undefined.
// The optional space parameter produces a stringification of the
// value that is filled with line breaks and indentation to make it
// easier to read.
// If the space parameter is a non-empty string, then that string will
// be used for indentation. If the space parameter is a number, then
// the indentation will be that many spaces.
// Example:
// text = JSON.stringify(["e", {pluribus: "unum"}]);
// // text is '["e",{"pluribus":"unum"}]'
// text = JSON.stringify(["e", {pluribus: "unum"}], null, "\t");
// // text is '[\n\t"e",\n\t{\n\t\t"pluribus": "unum"\n\t}\n]'
// text = JSON.stringify([new Date()], function (key, value) {
// return this[key] instanceof Date
// ? "Date(" + this[key] + ")"
// : value;
// });
// // text is '["Date(---current time---)"]'
// JSON.parse(text, reviver)
// This method parses a JSON text to produce an object or array.
// It can throw a SyntaxError exception.
// The optional reviver parameter is a function that can filter and
// transform the results. It receives each of the keys and values,
// and its return value is used instead of the original value.
// If it returns what it received, then the structure is not modified.
// If it returns undefined then the member is deleted.
// Example:
// // Parse the text. Values that look like ISO date strings will
// // be converted to Date objects.
// myData = JSON.parse(text, function (key, value) {
// var a;
// if (typeof value === "string") {
// a =
// /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2}(?:\.\d*)?)Z$/.exec(value);
// if (a) {
// return new Date(Date.UTC(
// +a[1], +a[2] - 1, +a[3], +a[4], +a[5], +a[6]
// ));
// }
// return value;
// }
// });
// myData = JSON.parse(
// "[\"Date(09/09/2001)\"]",
// function (key, value) {
// var d;
// if (
// typeof value === "string"
// && value.slice(0, 5) === "Date("
// && value.slice(-1) === ")"
// ) {
// d = new Date(value.slice(5, -1));
// if (d) {
// return d;
// }
// }
// return value;
// }
// );
// This is a reference implementation. You are free to copy, modify, or
// redistribute.
/*jslint
eval, for, this
*/
/*property
JSON, apply, call, charCodeAt, getUTCDate, getUTCFullYear, getUTCHours,
getUTCMinutes, getUTCMonth, getUTCSeconds, hasOwnProperty, join,
lastIndex, length, parse, prototype, push, replace, slice, stringify,
test, toJSON, toString, valueOf
*/
// Create a JSON object only if one does not already exist. We create the
// methods in a closure to avoid creating global variables.
if (typeof JSON !== "object") {
JSON = {};
}
(function () {
"use strict";
var rx_one = /^[\],:{}\s]*$/;
var rx_two = /\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g;
var rx_three = /"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g;
var rx_four = /(?:^|:|,)(?:\s*\[)+/g;
var rx_escapable = /[\\"\u0000-\u001f\u007f-\u009f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g;
var rx_dangerous = /[\u0000\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g;
function f(n) {
// Format integers to have at least two digits.
return (n < 10)
? "0" + n
: n;
}
function this_value() {
return this.valueOf();
}
if (typeof Date.prototype.toJSON !== "function") {
Date.prototype.toJSON = function () {
return isFinite(this.valueOf())
? (
this.getUTCFullYear()
+ "-"
+ f(this.getUTCMonth() + 1)
+ "-"
+ f(this.getUTCDate())
+ "T"
+ f(this.getUTCHours())
+ ":"
+ f(this.getUTCMinutes())
+ ":"
+ f(this.getUTCSeconds())
+ "Z"
)
: null;
};
Boolean.prototype.toJSON = this_value;
Number.prototype.toJSON = this_value;
String.prototype.toJSON = this_value;
}
var gap;
var indent;
var meta;
var rep;
function quote(string) {
// If the string contains no control characters, no quote characters, and no
// backslash characters, then we can safely slap some quotes around it.
// Otherwise we must also replace the offending characters with safe escape
// sequences.
rx_escapable.lastIndex = 0;
return rx_escapable.test(string)
? "\"" + string.replace(rx_escapable, function (a) {
var c = meta[a];
return typeof c === "string"
? c
: "\\u" + ("0000" + a.charCodeAt(0).toString(16)).slice(-4);
}) + "\""
: "\"" + string + "\"";
}
function str(key, holder) {
// Produce a string from holder[key].
var i; // The loop counter.
var k; // The member key.
var v; // The member value.
var length;
var mind = gap;
var partial;
var value = holder[key];
// If the value has a toJSON method, call it to obtain a replacement value.
if (
value
&& typeof value === "object"
&& typeof value.toJSON === "function"
) {
value = value.toJSON(key);
}
// If we were called with a replacer function, then call the replacer to
// obtain a replacement value.
if (typeof rep === "function") {
value = rep.call(holder, key, value);
}
// What happens next depends on the value's type.
switch (typeof value) {
case "string":
return quote(value);
case "number":
// JSON numbers must be finite. Encode non-finite numbers as null.
return (isFinite(value))
? String(value)
: "null";
case "boolean":
case "null":
// If the value is a boolean or null, convert it to a string. Note:
// typeof null does not produce "null". The case is included here in
// the remote chance that this gets fixed someday.
return String(value);
// If the type is "object", we might be dealing with an object or an array or
// null.
case "object":
// Due to a specification blunder in ECMAScript, typeof null is "object",
// so watch out for that case.
if (!value) {
return "null";
}
// Make an array to hold the partial results of stringifying this object value.
gap += indent;
partial = [];
// Is the value an array?
if (Object.prototype.toString.apply(value) === "[object Array]") {
// The value is an array. Stringify every element. Use null as a placeholder
// for non-JSON values.
length = value.length;
for (i = 0; i < length; i += 1) {
partial[i] = str(i, value) || "null";
}
// Join all of the elements together, separated with commas, and wrap them in
// brackets.
v = partial.length === 0
? "[]"
: gap
? (
"[\n"
+ gap
+ partial.join(",\n" + gap)
+ "\n"
+ mind
+ "]"
)
: "[" + partial.join(",") + "]";
gap = mind;
return v;
}
// If the replacer is an array, use it to select the members to be stringified.
if (rep && typeof rep === "object") {
length = rep.length;
for (i = 0; i < length; i += 1) {
if (typeof rep[i] === "string") {
k = rep[i];
v = str(k, value);
if (v) {
partial.push(quote(k) + (
(gap)
? ": "
: ":"
) + v);
}
}
}
} else {
// Otherwise, iterate through all of the keys in the object.
for (k in value) {
if (Object.prototype.hasOwnProperty.call(value, k)) {
v = str(k, value);
if (v) {
partial.push(quote(k) + (
(gap)
? ": "
: ":"
) + v);
}
}
}
}
// Join all of the member texts together, separated with commas,
// and wrap them in braces.
v = partial.length === 0
? "{}"
: gap
? "{\n" + gap + partial.join(",\n" + gap) + "\n" + mind + "}"
: "{" + partial.join(",") + "}";
gap = mind;
return v;
}
}
// If the JSON object does not yet have a stringify method, give it one.
if (typeof JSON.stringify !== "function") {
meta = { // table of character substitutions
"\b": "\\b",
"\t": "\\t",
"\n": "\\n",
"\f": "\\f",
"\r": "\\r",
"\"": "\\\"",
"\\": "\\\\"
};
JSON.stringify = function (value, replacer, space) {
// The stringify method takes a value and an optional replacer, and an optional
// space parameter, and returns a JSON text. The replacer can be a function
// that can replace values, or an array of strings that will select the keys.
// A default replacer method can be provided. Use of the space parameter can
// produce text that is more easily readable.
var i;
gap = "";
indent = "";
// If the space parameter is a number, make an indent string containing that
// many spaces.
if (typeof space === "number") {
for (i = 0; i < space; i += 1) {
indent += " ";
}
// If the space parameter is a string, it will be used as the indent string.
} else if (typeof space === "string") {
indent = space;
}
// If there is a replacer, it must be a function or an array.
// Otherwise, throw an error.
rep = replacer;
if (replacer && typeof replacer !== "function" && (
typeof replacer !== "object"
|| typeof replacer.length !== "number"
)) {
throw new Error("JSON.stringify");
}
// Make a fake root object containing our value under the key of "".
// Return the result of stringifying the value.
return str("", {"": value});
};
}
// If the JSON object does not yet have a parse method, give it one.
if (typeof JSON.parse !== "function") {
JSON.parse = function (text, reviver) {
// The parse method takes a text and an optional reviver function, and returns
// a JavaScript value if the text is a valid JSON text.
var j;
function walk(holder, key) {
// The walk method is used to recursively walk the resulting structure so
// that modifications can be made.
var k;
var v;
var value = holder[key];
if (value && typeof value === "object") {
for (k in value) {
if (Object.prototype.hasOwnProperty.call(value, k)) {
v = walk(value, k);
if (v !== undefined) {
value[k] = v;
} else {
delete value[k];
}
}
}
}
return reviver.call(holder, key, value);
}
// Parsing happens in four stages. In the first stage, we replace certain
// Unicode characters with escape sequences. JavaScript handles many characters
// incorrectly, either silently deleting them, or treating them as line endings.
text = String(text);
rx_dangerous.lastIndex = 0;
if (rx_dangerous.test(text)) {
text = text.replace(rx_dangerous, function (a) {
return (
"\\u"
+ ("0000" + a.charCodeAt(0).toString(16)).slice(-4)
);
});
}
// In the second stage, we run the text against regular expressions that look
// for non-JSON patterns. We are especially concerned with "()" and "new"
// because they can cause invocation, and "=" because it can cause mutation.
// But just to be safe, we want to reject all unexpected forms.
// We split the second stage into 4 regexp operations in order to work around
// crippling inefficiencies in IE's and Safari's regexp engines. First we
// replace the JSON backslash pairs with "@" (a non-JSON character). Second, we
// replace all simple value tokens with "]" characters. Third, we delete all
// open brackets that follow a colon or comma or that begin the text. Finally,
// we look to see that the remaining characters are only whitespace or "]" or
// "," or ":" or "{" or "}". If that is so, then the text is safe for eval.
if (
rx_one.test(
text
.replace(rx_two, "@")
.replace(rx_three, "]")
.replace(rx_four, "")
)
) {
// In the third stage we use the eval function to compile the text into a
// JavaScript structure. The "{" operator is subject to a syntactic ambiguity
// in JavaScript: it can begin a block or an object literal. We wrap the text
// in parens to eliminate the ambiguity.
j = eval("(" + text + ")");
// In the optional fourth stage, we recursively walk the new structure, passing
// each name/value pair to a reviver function for possible transformation.
return (typeof reviver === "function")
? walk({"": j}, "")
: j;
}
// If the text is not JSON parseable, then a SyntaxError is thrown.
throw new SyntaxError("JSON.parse");
};
}
}());
ENDTEXTBLOCK
//////////////////////////////////////////////////
// 【引数】
// array : 配列
// rank : 抽出する値の大きい方から数えた順位
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION large(array[], rank)
IFB rank >= 1 AND rank <= LENGTH(array) THEN
shellSort(array)
RESULT = array[LENGTH(array) - rank]
ELSE
RESULT = ERR_VALUE
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 正規表現による検索の対象となる文字列
// Pattern : 正規表現で使用するパターンを設定
// IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse
// Global : 文字列全体を検索する場合はTrue、しない場合はFalse
// 【戻り値】
// 正規表現で検索した結果をMatchesコレクションとして返します。
//////////////////////////////////////////////////
FUNCTION reExecute(str, Pattern, IgnoreCase = TRUE, Global = TRUE)
DIM re = CREATEOLEOBJ("VBScript.RegExp")
re.Pattern = Pattern
re.IgnoreCase = IgnoreCase
re.Global = Global
RESULT = re.Execute(str)
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 正規表現による検索の対象となる文字列
// Pattern : 正規表現で使用するパターンを設定
// IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse
// Global : 文字列全体を検索する場合はTrue、しない場合はFalse
// 【戻り値】
// 正規表現にマッチするかどうかを示すブール値
//////////////////////////////////////////////////
FUNCTION reTest(str, Pattern, IgnoreCase = TRUE, Global = TRUE)
DIM re = CREATEOLEOBJ("VBScript.RegExp")
re.Pattern = Pattern
re.IgnoreCase = IgnoreCase
re.Global = Global
RESULT = re.Test(str)
FEND
//////////////////////////////////////////////////
// 【引数】
// r : 赤成分もしくは#RRGGBB形式の文字列
// g : 緑成分。rで#RRGGBB形式の文字列を指定した場合は省略。
// b : 青成分。rで#RRGGBB形式の文字列を指定した場合は省略。
// 【戻り値】
// Color値
//////////////////////////////////////////////////
FUNCTION RGBToColor(r, g = EMPTY, b = EMPTY)
IFB COPY(r, 1, 1) = "#" THEN
DIM color = 0
FOR i = 1 TO 3
color = color + VAL(hexToDec(COPY(r, i * 2, 2), FALSE)) * POWER(256, i - 1)
NEXT
RESULT = color
ELSE
RESULT = r + g * 256 + b * 65536
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 数値
// digit : 四捨五入する位置（マイナスで整数方向）
// 【戻り値】
// 四捨五入した値
//////////////////////////////////////////////////
FUNCTION roundOff(num, digit = 0)
DIM sign = sign(num)
num = ABS(num)
DIM offset = POWER(10, digit)
DIM n = num * offset - INT(num * offset)
RESULT = sign * IIF(n >= 0.5, CEIL(num * offset) / offset, INT(num * offset) / offset)
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : 時間を表すシリアル値を指定
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION Second(serial)
RESULT = REPLACE(FORMAT(INT(serial * 86400) MOD 60, 2), " ", "0")
FEND
//////////////////////////////////////////////////
// 【引数】
// array : ソートする数値を格納した配列。参照引数。
// 【戻り値】
//
//////////////////////////////////////////////////
PROCEDURE shellSort(Var array[])
DIM i, j, inc, temp
inc = 4
WHILE INT(inc) > 0
FOR i = 0 TO UBound(array)
j = i
temp = array[i]
WHILE j >= inc AND array[zcut(j-inc)] > temp
array[j] = array[j-inc]
j = j - inc
WEND
array[j] = temp
NEXT
IFB inc / 2 <> 0 THEN
inc = inc / 2
ELSEIF inc = 1 THEN
inc = 0
ELSE
inc = 1
ENDIF
WEND
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 符号を求める数値
// 【戻り値】
// 1 : 正の数、0 : ゼロ、-1 : 負の数、ERR_VALUE : それ以外
//////////////////////////////////////////////////
FUNCTION sign(num)
SELECT TRUE
CASE !CHKNUM(num)
RESULT = ERR_VALUE
CASE num > 0
RESULT = 1
CASE num = 0
RESULT = 0
CASE num < 0
RESULT = -1
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 配列
// rank : 抽出する値の小さい方から数えた順位
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION small(array[], rank)
IFB rank >= 1 AND rank <= LENGTH(array) THEN
shellSort(array)
RESULT = array[rank-1]
ELSE
RESULT = ERR_VALUE
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// input : 入力文字列
// length : 埋めたあとの長さ
// str : 埋める文字
// type : 埋める方向
// 【戻り値】
// 指定文字で埋めた文字列
//////////////////////////////////////////////////
FUNCTION strPad(input, length, str = " ", type = RIGHT)
DIM s = ""
SELECT type
CASE LEFT
FOR i = 1 TO CEIL((length - LENGTH(input)) / LENGTH(str))
s = s + str
NEXT
input = COPY(s, 1, length - LENGTH(input)) + input
CASE RIGHT
FOR i = 1 TO CEIL((length - LENGTH(input)) / LENGTH(str))
s = s + str
NEXT
input = input + COPY(s, 1, length - LENGTH(input))
SELEND
RESULT = input
FEND
//////////////////////////////////////////////////
// 【引数】
// inputs : 繰り返す文字列
// multiplier : inputsを繰り返す回数
// 【戻り値】
// inputsをmultiplier回を繰り返した文字列を返します
//////////////////////////////////////////////////
FUNCTION strRepeat(inputs, multiplier)
DIM res = ""
FOR n = 1 TO multiplier
res = res + inputs
NEXT
RESULT = res
FEND
//////////////////////////////////////////////////
// 【引数】
// a : bと交換する値。参照引数。
// b : aと交換する値。参照引数。
// 【戻り値】
//
//////////////////////////////////////////////////
PROCEDURE swap(Var a, Var b)
DIM tmp = a
a = b
b = tmp
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : シリアル値
// format : フォーマット
// 【戻り値】
// 数値を表示書式に基づいて変換した文字列
//////////////////////////////////////////////////
FUNCTION text(serial, format, hour12 = FALSE)
HASHTBL startDate
startDate["明治"] = "1868/01/25"
startDate["大正"] = "1912/07/30"
startDate["昭和"] = "1926/12/25"
startDate["平成"] = "1989/01/08"
startDate["令和"] = "2019/05/01"
DIM baseDate = "1899/12/30"
serial = VAL(serial)
SELECT TRUE
CASE reTest(format, "\[h+\]")
Matches = reExecute(format, "\[(h+)\]")
DIM hour = iif(hour12, Hour(serial) MOD 12, Hour(serial))
RESULT = text(hour, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE reTest(format, "^h+$")
Matches = reExecute(format, "^(h+)$")
hour = iif(hour12, Hour(serial) MOD 12, Hour(serial))
RESULT = text(hour MOD 24, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE reTest(format, "\[m+\]")
Matches = reExecute(format, "\[(m+)\]")
RESULT = text(serial * 1440, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE format = "m"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_MM, "0")
CASE format = "mm"
GETTIME(serial, baseDate)
RESULT = G_TIME_MM2
CASE format = "n"
GETTIME(serial, baseDate)
RESULT = G_TIME_NN
CASE format = "nn"
GETTIME(serial, baseDate)
RESULT = G_TIME_NN2
CASE format = "s"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_SS, "0")
CASE format = "ss"
GETTIME(serial, baseDate)
RESULT = G_TIME_SS2
CASE format = "yyyy"
GETTIME(serial, baseDate)
RESULT = G_TIME_YY4
CASE format = "yy"
GETTIME(serial, baseDate)
RESULT = COPY(G_TIME_YY4, 3, 2)
CASE format = "e"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 2018
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1988
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1925
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1911
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1867
SELEND
CASE format = "ee"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 2018, "00")
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1988, "00")
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1925, "00")
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1911, "00")
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1867, "00")
SELEND
CASE format = "g"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "R"
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "H"
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "S"
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "T"
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "M"
SELEND
CASE format = "gg"
RESULT = COPY(text(serial, "ggg"), 1, 1)
CASE format = "ggg"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "令和"
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "平成"
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "昭和"
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "大正"
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "明治"
SELEND
CASE format = "mmmmm"
RESULT = COPY(text(serial, "mmmm"), 1, 1)
CASE format = "mmmm"
DIM month[] = "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"
RESULT = month[text(serial, "m") - 1]
CASE format = "mmm"
RESULT = COPY(text(serial, "mmmm"), 1, 3)
CASE format = "dd"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_DD2, "00")
CASE format = "d"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_DD, "0")
CASE reTest(format, "^[ad]{3,4}$")
Matches = reExecute(format, "([ad]{3,4})")
GETTIME(serial, baseDate)
DIM aaa[] = "日", "月", "火", "水", "木", "金", "土"
DIM aaaa[] = "日曜日", "月曜日", "火曜日", "水曜日", "木曜日", "金曜日", "土曜日"
DIM ddd[] = "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"
DIM dddd[] = "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday";
RESULT = EVAL(Matches.Item(0).SubMatches(0) + "[" + getWeekday(G_TIME_WW, 1) + "]")
CASE reTest(format, "(0+\.?0+)?%")
Matches = reExecute(format, "(0+\.?0+)?%")
RESULT = text(serial * 100, Matches.Item(0).SubMatches(0)) + "%"
CASE reTest(format, "^\[DBNum\d{1,4}\](.*?)$")
Matches = reExecute(format, "^\[DBNum(\d{1,4})\](.*?)$")
DIM value = VAL(Matches.Item(0).SubMatches(0))
DIM sss = text(serial, Matches.Item(0).SubMatches(1))
Matches = reExecute(sss, "(\D+)?(\d+)(\D+)?")
DIM res = ""
FOR m = 0 TO Matches.Count - 1
serial = Matches.Item(m).SubMatches(1)
SELECT value
CASE 1, 2
DIM n[][9] = "〇", "一", "二", "三", "四", "五", "六", "七", "八", "九", + _
"", "壱", "弐", "参", "四", "伍", "六", "七", "八", "九"
DIM a[][3] = "", "十", "百", "千", + _
"", "拾", "百", "阡"
DIM b[][3] = "", "万", "億", "兆", + _
"", "萬", "億", "兆"
DIM r = ""
DIM j = 0
type = value - 1
REPEAT
DIM str = ""
DIM n4 = serial MOD 10000
FOR i = LENGTH(n4) TO 1 STEP -1
s = COPY(n4, i, 1)
IFB s = 1 AND a[type][LENGTH(n4)-i] <> "" THEN
str = IIF(s, a[type][LENGTH(n4)-i], "") + str
ELSE
str = n[type][s] + IIF(s, a[type][LENGTH(n4)-i], "") + str
ENDIF
NEXT
IF str <> "" THEN r = str + b[type][j] + r
j = j + 1
serial = INT(serial / 10000)
UNTIL serial = 0
res = res + Matches.Item(m).SubMatches(0) + r + Matches.Item(m).SubMatches(2)
CASE 3
res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_FULLWIDTH) + Matches.Item(m).SubMatches(2)
CASE 4
res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_HALFWIDTH) + Matches.Item(m).SubMatches(2)
SELEND
NEXT
RESULT = res
CASE reTest(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$")
Matches = reExecute(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$")
DIM array = SPLIT(Matches.Item(0).SubMatches(1), "/")
ampm = array[IIF(serial - INT(serial) >= 0.5, 1, 0)]
hour12 = TRUE
res = ""
WITH Matches.Item(0)
res = text(serial, .SubMatches(0), hour12) + ampm + text(serial, .SubMatches(2), hour12)
ENDWITH
RESULT = res
CASE reTest(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?")
Matches = reExecute(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?")
FOR n = 0 TO Matches.Count - 1
IF n = 0 THEN res = Matches.Item(n).SubMatches(0)
NEXT
FOR n = 0 TO Matches.Count - 1
WITH Matches.Item(n)
res = res + text(serial, .SubMatches(1), hour12) + .SubMatches(3)
ENDWITH
NEXT
RESULT = res
CASE format = "0/0"
DIM separator = POS(".", serial)
DIM g = 0
IFB separator <> 0 THEN
DIM keta = LENGTH(serial)
DIM shift = POWER(10, keta - separator)
IFB shift >= POWER(10, 15) THEN
DIM position = 0
FOR i = 0 TO 14
IFB serial * POWER(10, i) - serial >= 1 THEN
position = i
BREAK
ENDIF
NEXT
tmp = serial * POWER(10, position)
FOR i = 1 TO 15
r = (tmp * POWER(10, i)) / serial - (tmp / serial)
a1 = tmp * POWER(10, i) - tmp
IF a1 = INT(a1) THEN BREAK
NEXT
DIM frac[] = a1, r
g = GCD(frac)
RESULT = (a1/g) + "/" + (r/g)
ELSE
DIM molecule = serial * shift // 分子
DIM denominator = shift // 分母
DIM nums[] = molecule, denominator
g = GCD(nums)
molecule = molecule / g
denominator = denominator / g
RESULT = molecule + "/" + denominator
ENDIF
ELSE
RESULT = serial + "/1"
ENDIF
CASE reTest(format, "(0+)\.?(0+)?") AND UBound(SPLIT(format, ".")) <= 1
Matches = reExecute(format, "(0+)\.?(0+)?")
len1 = LENGTH(Matches.Item(0).SubMatches(0))
len2 = LENGTH(Matches.Item(0).SubMatches(1))
DIM arr[] = LENGTH(INT(serial)), len1
IFB POS(".", format) THEN
RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX) + len2 + 1, len2), " ", "0")
ELSE
RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX)), " ", "0")
ENDIF
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 時刻文字列。hh:nn:ss AM/PM、hh:nn AM/PM、hh AM/PM、hh:nn:ss、hh:nn、hh時nn分ss秒、hh時nn分のいずれかの形式を指定。
// 【戻り値】
// シリアル値 （例）0…00:00:00、0.5…12:00:00、0.999988425925926…23:59:59
//////////////////////////////////////////////////
FUNCTION timeValue(str)
DIM serial = 0
DIM Matches
DIM pattern = "(\d+)"
DIM hh = "(0?[0-9]|1[0-2])"
DIM ampm = "([AP]M|[ap]m)"
SELECT TRUE
CASE reTest(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b")
WITH Matches.Item(0)
serial = timeValue(.SubMatches(0) + " " + .SubMatches(3)) + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + hh + ":" + pattern + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + ":" + pattern + " " + ampm + "\b")
WITH Matches.Item(0)
serial = timeValue(.SubMatches(0) + " " + .SubMatches(2)) + VAL(.SubMatches(1)) / 1440
ENDWITH
CASE reTest(str, "\b" + hh + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + " " + ampm + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0) MOD 12) + IIF(reTest(.SubMatches(1), "AM|am"), 0, 12)
serial = serial / 24
ENDWITH
CASE reTest(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b")
Matches = reExecute(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + pattern + ":" + pattern + "\b")
Matches = reExecute(str, "\b" + pattern + ":" + pattern + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440
ENDWITH
CASE reTest(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒")
Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + pattern + "時" + pattern + "分")
Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440
ENDWITH
DEFAULT
serial = ERR_VALUE
SELEND
RESULT = serial - INT(serial)
FEND
//////////////////////////////////////////////////
// 【引数】
// arrayname : 上限値を求める配列の名前
// dimension : 返す次元を示す整数
// 【戻り値】
// 配列の上限値
//////////////////////////////////////////////////
FUNCTION UBound(arrayname[], dimension = 1)
RESULT = EVAL("RESIZE(arrayname" + strRepeat("[0]", dimension - 1) + ")")
FEND
//////////////////////////////////////////////////
// 【引数】
// uwscTime : UWSC時間
// 【戻り値】
// シリアル値
//////////////////////////////////////////////////
FUNCTION uwscToSerial(uwscTime)
uwscDate = uwscTime / 86400
RESULT = 36526 + uwscDate
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 丸め処理を行う値
// 【戻り値】
// 負の方向に丸めた値
//////////////////////////////////////////////////
FUNCTION floor(num)
RESULT = INT(num) + IIF(num < 0 AND num <> INT(num), -1, 0)
FEND
//////////////////////////////////////////////////
// 【引数】
// expr : 評価する式
// truepart : 評価した式がTrueのときに返す値
// falsepart : 評価した式がFalseのときに返す値
// 【戻り値】
// truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき
//////////////////////////////////////////////////
FUNCTION IIF(expr, truepart, falsepart)
IFB EVAL(expr) THEN
RESULT = truepart
ELSE
RESULT = falsepart
ENDIF
FEND使用関数
ファイルの最終アクセス日時を取得（FSO）
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM File = FSO.GetFile("D:\Desktop\log.txt")
PRINT File.DateLastAccessed()結果
2022/12/13 14:34:00使用関数
ファイルの最終更新日時を取得（FSO）
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM File = FSO.GetFile("D:\Desktop\log.txt")
PRINT File.DateLastModified()結果
2022/06/22 12:49:59使用関数
8.3形式のパスを取得します
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM File = FSO.GetFile("C:\Program Files (x86)\UWSC\DbgScript\Info_Under_MouseCursor.uws")
PRINT File.ShortPath()結果
C:\PROGRA~2\UWSC\DBGSCR~1\INFO_U~1.UWS使用関数
8.3形式のファイル名を取得します
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM File = FSO.GetFile("C:\Program Files (x86)\UWSC\DbgScript\Info_Under_MouseCursor.uws")
PRINT File.ShortName()結果
INFO_U~1.UWS使用関数
指定したファイルがショートカットかを取得
DIM Shell = CREATEOLEOBJ("Shell.Application")
DIM Folder = Shell.NameSpace("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\UWSC Pro\")
DIM FolderItem = Folder.ParseName("UWSC Pro.lnk")
PRINT FolderItem.IsLink()結果
True使用関数
Twitterをアプリモードで起動（Chrome）
Twitterをアプリモードで起動します。
DIM WebDriver = CREATEOLEOBJ("Selenium.WebDriver")
WITH WebDriver
.AddArgument("--app=https://twitter.com")
.Start("chrome")
.Wait(10000)
ENDWITH使用関数
Twitterをアプリモード・ユーザーエージェントをスマホにして起動（Chrome）
起動オプションを追加して起動します。起動オプションを複数指定する場合は、AddArgumentを繰り返し実行します。
DIM WebDriver = CREATEOLEOBJ("Selenium.WebDriver")
WITH WebDriver
.AddArgument("--app=https://twitter.com")
.AddArgument("--user-agent='Mozilla/5.0 (Linux; Android 13; SOG06) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/109.0.0.0 Mobile Safari/537.36'")
.AddArgument("--window-position=0,0")
.AddArgument("--window-size=432,768")
.Start("chrome")
.Wait(10000)
ENDWITH使用関数
Internet ExplorerからMicrosoft Edgeにリダイレクトされるのを無効化
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
DIM name = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\Main\TabProcGrowth"
DIM value = 0
DIM type = "REG_DWORD"
WshShell.RegWrite(name, value, type)結果
使用関数
既定フォルダの最新のメールを取得
既定フォルダで受信した最新のメールを取得し、差出人名、件名、受信日時を出力します。
CONST olFolderInbox = 6
DIM Outlook = CREATEOLEOBJ("Outlook.Application")
DIM NameSpace = Outlook.GetNameSpace("MAPI")
DIM Folder = NameSpace.GetDefaultFolder(olFolderInbox)
DIM Items = Folder.Items
Items.Sort("[ReceivedTime]", FALSE)
DIM MailItem = Items.GetLast
WITH MailItem
PRINT "差出人名," + .SenderName
PRINT "件名," + .Subject
PRINT "受信日時," + .ReceivedTime
ENDWITH使用関数
特殊フォルダに含まれるファイルの数を取得
Tempフォルダにあるファイルの数を出力します。
CONST TemporaryFolder = 2
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM Folder = FSO.GetSpecialFolder(TemporaryFolder)
DIM Files = Folder.Files
PRINT Files.Count結果
191使用関数
Cドライブの空き容量を割合で取得
Cドライブの空き容量を小数点以下第2位までの百分率（単位：％）で出力します。
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM Drive = FSO.GetDrive("C")
WITH Drive
PRINT ROUND(.FreeSpace / .TotalSize * 100, -2) + "％"
ENDWITH結果
19.47％使用関数
デスクトップのアイコン名に影を付ける
パフォーマンス-視覚効果のパフォーマンスオプションの「デスクトップのアイコン名に影を付ける」をオンにします。
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
DIM name = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ListviewShadow"
DIM value = 1
DIM type = "REG_DWORD"
WshShell.RegWrite(name, value, type)使用関数
デスクトップのアイコン名に影を付けない
パフォーマンス-視覚効果のパフォーマンスオプションの「デスクトップのアイコン名に影を付ける」をオフにします。
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
DIM name = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ListviewShadow"
DIM value = 0
DIM type = "REG_DWORD"
WshShell.RegWrite(name, value, type)使用関数
コトバンクで指定した熟語の読みを調べる
4行目のwordに指定した単語の読み方をコトバンクで調べます。
コトバンクに掲載のない単語は取得できません。
DIM WebDriver = CREATEOLEOBJ("Selenium.WebDriver")
WebDriver.Start("chrome")
DIM word = "東京"
WebDriver.Get("https://kotobank.jp/word/" + word)
COM_ERR_IGN
DIM WebElement = WebDriver.FindElementByXPath("//div[@id='mainTitle']//span")
COM_ERR_RET
IFB WebElement <> ERR_VALUE THEN
PRINT REPLACE(WebElement.text, "（読み）", "")
ELSE
PRINT "読みを取得できませんでした。"
ENDIF
WebDriver.Close
//////////////////////////////////////////////////
// 【引数】
// interval : 加算する時間間隔を表す文字列式（yyyy：年、m：月、d：日、ww：週、h：時、n：分、s：秒）
// num : dateに加算する値。未来は正、過去は負で指定
// date : 時間間隔を加算する日付
// 【戻り値】
// 日時（date）に、指定した単位（interval）の時間（num）を加算して返します
//////////////////////////////////////////////////
FUNCTION dateAdd(interval, num, date)
DIM year, month, day, d
GETTIME(0, date)
DIM time = G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2
SELECT interval
CASE "yyyy"
d = (G_TIME_YY + num) + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
IF time <> "00:00:00" THEN d = d + " " + time
CASE "m"
IFB num > 0 THEN
year = G_TIME_YY + INT((G_TIME_MM + num) / 12)
month = REPLACE(FORMAT(((G_TIME_MM + num) MOD 12), 2), " ", "0")
ELSE
year = G_TIME_YY + CEIL((G_TIME_MM + num) / 12 - 1)
month = REPLACE(FORMAT(G_TIME_MM - (ABS(num) MOD 12), 2), " ", "0")
ENDIF
IF month = "00" THEN month = 12
day = G_TIME_DD2
d = "" + year + month + day
IFB !isDate(d) THEN
d = year + "/" + month + "/" + "01"
d = getEndOfMonth(d)
ELSE
d = year + "/" + month + "/" + day
ENDIF
IF time <> "00:00:00" THEN d = d + " " + time
CASE "d"
t = GETTIME(num, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "ww"
t = GETTIME(num * 7, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "h"
t = GETTIME(num / 24, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "n"
t = GETTIME(num / 1440, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "s"
t = GETTIME(num / 86400, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
// interval : 時間単位（yyyy︰年、q：四半期、m︰月、d︰日、w：週日、ww：週、h：時、n：分、s：秒）
// date1 : 日時1
// date2 : 日時2
// 【戻り値】
// date2からdate1を引いた時間間隔を求めます。
//////////////////////////////////////////////////
FUNCTION dateDiff(interval, date1, date2)
DIM y1, y2, m1, m2, d1, d2, d
SELECT interval
CASE "yyyy"
GETTIME(0, date1)
y1 = G_TIME_YY
GETTIME(0, date2)
y2 = G_TIME_YY
d = y2 - y1
CASE "q"
GETTIME(0, date1)
y1 = G_TIME_YY
m1 = G_TIME_MM
GETTIME(0, date2)
y2 = G_TIME_YY
m2 = G_TIME_MM
d = y2 * 4 + CEIL(m2/3) - (y1 * 4 + CEIL(m1/3))
CASE "m"
GETTIME(0, date1)
y1 = G_TIME_YY
m1 = G_TIME_MM
GETTIME(0, date2)
y2 = G_TIME_YY
m2 = G_TIME_MM
d = (y2 - y1) * 12 + m2 - m1
CASE "d"
d1 = GETTIME(0, date1)
d2 = GETTIME(0, date2)
d = (d2 - d1) / 86400
CASE "w"
d = INT(dateDiff("d", date1, date2) / 7)
CASE "ww"
date1 = dateAdd("d", -1 * getWeekday(date1), date1)
d = INT(dateDiff("d", date1, date2) / 7)
CASE "h"
d = dateDiff("d", date1, date2) * 24
CASE "n"
d = dateDiff("d", date1, date2) * 1440
CASE "s"
d = dateDiff("d", date1, date2) * 86400
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 最大公約数を求める数値を格納した配列
// 【戻り値】
// 最大公約数
//////////////////////////////////////////////////
FUNCTION GCD(array[])
DIM c = LENGTH(array)
DIM rem = array[c-1] MOD array[c-2]
IFB rem = 0 THEN
IFB LENGTH(array) = 2 THEN
RESULT = array[c-2]
EXIT
ENDIF
RESIZE(array, c-2)
RESULT = GCD(array)
EXIT
ENDIF
array[c-1] = array[c-2]
array[c-2] = rem
RESULT = GCD(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）
// m : 第一引数の指定日からプラスマイナスm月とする
// 【戻り値】
// dateからm月後の月末の日付
//////////////////////////////////////////////////
FUNCTION getEndOfMonth(date, m = 0)
date = dateAdd("m", m + 1, date)
GETTIME(0, date)
GETTIME(-G_TIME_DD, date)
RESULT = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付文字列（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）もしくはシリアル値
// type : 取得する曜日番号の種類を示す0〜3または11〜17の値。1と17は日曜日を1、2と11は月曜日を1とカウントします。11以降はExcel2010で追加された値で、互換性を保つために重複した値があります。
// 【戻り値】
// typeで指定した種類によって以下の値を返します。 : （0 : 0(日曜)〜6(土曜)、1 : 1(日曜)～7(土曜)、2 : 1(月曜)～7(日曜)、3 : 0(月曜)〜6(日曜)、11 : 1(月曜)～7(日曜)、12 : 1(火曜)～7(月曜)、13 : 1(水曜)～7(火曜)、14 : 1(木曜)～7(水曜)、15 : 1(金曜)～7(木曜)、16 : 1(土曜)～7(金曜)、17 : 1(日曜)～7(土曜)）
//////////////////////////////////////////////////
FUNCTION getWeekday(date, type = 1)
IF VARTYPE(date) <> 258 THEN date = text(date, "yyyy/mm/dd")
GETTIME(0, date)
DIM w = G_TIME_WW
SELECT TRUE
CASE type = 0
RESULT = w
CASE type = 1
RESULT = w + 1
CASE type = 2
RESULT = IIF(w=0, 7, w)
CASE type = 3
RESULT = (w+6) MOD 7
CASE type >= 11
RESULT = ((getWeekday(date, 2) + 17 - type) MOD 7) + 1
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : シリアル値もしくは時刻文字列
// 【戻り値】
// 時刻から時間を表す0〜23の範囲の値
//////////////////////////////////////////////////
FUNCTION Hour(serial)
IF VARTYPE(serial) = 258 THEN serial = timeValue(serial)
RESULT = INT(serial * 24) MOD 24
FEND
//////////////////////////////////////////////////
// 【引数】
// expr : 評価する式
// truepart : 評価した式がTrueのときに返す値
// falsepart : 評価した式がFalseのときに返す値
// 【戻り値】
// truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき
//////////////////////////////////////////////////
FUNCTION IIF(expr, truepart, falsepart)
IFB EVAL(expr) THEN
RESULT = truepart
ELSE
RESULT = falsepart
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 存在するかを調べる日付文字列。YYYYMMDD or YYYY/MM/DD or YYYY-MM-DDのいずれかの形式。
// 【戻り値】
// TRUE : 日付として認識できる、FALSE : 日付として認識できない
//////////////////////////////////////////////////
FUNCTION isDate(date)
TRY
GETTIME(0, date)
RESULT = TRUE
EXCEPT
RESULT = FALSE
ENDTRY
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 正規表現による検索の対象となる文字列
// Pattern : 正規表現で使用するパターンを設定
// IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse
// Global : 文字列全体を検索する場合はTrue、しない場合はFalse
// 【戻り値】
// 正規表現で検索した結果をMatchesコレクションとして返します。
//////////////////////////////////////////////////
FUNCTION reExecute(str, Pattern, IgnoreCase = TRUE, Global = TRUE)
DIM re = CREATEOLEOBJ("VBScript.RegExp")
re.Pattern = Pattern
re.IgnoreCase = IgnoreCase
re.Global = Global
RESULT = re.Execute(str)
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 正規表現による検索の対象となる文字列
// Pattern : 正規表現で使用するパターンを設定
// IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse
// Global : 文字列全体を検索する場合はTrue、しない場合はFalse
// 【戻り値】
// 正規表現にマッチするかどうかを示すブール値
//////////////////////////////////////////////////
FUNCTION reTest(str, Pattern, IgnoreCase = TRUE, Global = TRUE)
DIM re = CREATEOLEOBJ("VBScript.RegExp")
re.Pattern = Pattern
re.IgnoreCase = IgnoreCase
re.Global = Global
RESULT = re.Test(str)
FEND
//////////////////////////////////////////////////
// 【引数】
// inputs : 繰り返す文字列
// multiplier : inputsを繰り返す回数
// 【戻り値】
// inputsをmultiplier回を繰り返した文字列を返します
//////////////////////////////////////////////////
FUNCTION strRepeat(inputs, multiplier)
DIM res = ""
FOR n = 1 TO multiplier
res = res + inputs
NEXT
RESULT = res
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : シリアル値
// format : フォーマット
// 【戻り値】
// 数値を表示書式に基づいて変換した文字列
//////////////////////////////////////////////////
FUNCTION text(serial, format, hour12 = FALSE)
HASHTBL startDate
startDate["明治"] = "1868/01/25"
startDate["大正"] = "1912/07/30"
startDate["昭和"] = "1926/12/25"
startDate["平成"] = "1989/01/08"
startDate["令和"] = "2019/05/01"
DIM baseDate = "1899/12/30"
serial = VAL(serial)
SELECT TRUE
CASE reTest(format, "\[h+\]")
Matches = reExecute(format, "\[(h+)\]")
DIM hour = iif(hour12, Hour(serial) MOD 12, Hour(serial))
RESULT = text(hour, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE reTest(format, "^h+$")
Matches = reExecute(format, "^(h+)$")
hour = iif(hour12, Hour(serial) MOD 12, Hour(serial))
RESULT = text(hour MOD 24, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE reTest(format, "\[m+\]")
Matches = reExecute(format, "\[(m+)\]")
RESULT = text(serial * 1440, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE format = "m"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_MM, "0")
CASE format = "mm"
GETTIME(serial, baseDate)
RESULT = G_TIME_MM2
CASE format = "n"
GETTIME(serial, baseDate)
RESULT = G_TIME_NN
CASE format = "nn"
GETTIME(serial, baseDate)
RESULT = G_TIME_NN2
CASE format = "s"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_SS, "0")
CASE format = "ss"
GETTIME(serial, baseDate)
RESULT = G_TIME_SS2
CASE format = "yyyy"
GETTIME(serial, baseDate)
RESULT = G_TIME_YY4
CASE format = "yy"
GETTIME(serial, baseDate)
RESULT = COPY(G_TIME_YY4, 3, 2)
CASE format = "e"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 2018
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1988
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1925
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1911
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1867
SELEND
CASE format = "ee"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 2018, "00")
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1988, "00")
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1925, "00")
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1911, "00")
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1867, "00")
SELEND
CASE format = "g"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "R"
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "H"
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "S"
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "T"
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "M"
SELEND
CASE format = "gg"
RESULT = COPY(text(serial, "ggg"), 1, 1)
CASE format = "ggg"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "令和"
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "平成"
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "昭和"
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "大正"
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "明治"
SELEND
CASE format = "mmmmm"
RESULT = COPY(text(serial, "mmmm"), 1, 1)
CASE format = "mmmm"
DIM month[] = "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"
RESULT = month[text(serial, "m") - 1]
CASE format = "mmm"
RESULT = COPY(text(serial, "mmmm"), 1, 3)
CASE format = "dd"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_DD2, "00")
CASE format = "d"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_DD, "0")
CASE reTest(format, "^[ad]{3,4}$")
Matches = reExecute(format, "([ad]{3,4})")
GETTIME(serial, baseDate)
DIM aaa[] = "日", "月", "火", "水", "木", "金", "土"
DIM aaaa[] = "日曜日", "月曜日", "火曜日", "水曜日", "木曜日", "金曜日", "土曜日"
DIM ddd[] = "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"
DIM dddd[] = "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday";
RESULT = EVAL(Matches.Item(0).SubMatches(0) + "[" + getWeekday(G_TIME_WW, 1) + "]")
CASE reTest(format, "(0+\.?0+)?%")
Matches = reExecute(format, "(0+\.?0+)?%")
RESULT = text(serial * 100, Matches.Item(0).SubMatches(0)) + "%"
CASE reTest(format, "^\[DBNum\d{1,4}\](.*?)$")
Matches = reExecute(format, "^\[DBNum(\d{1,4})\](.*?)$")
DIM value = VAL(Matches.Item(0).SubMatches(0))
DIM sss = text(serial, Matches.Item(0).SubMatches(1))
Matches = reExecute(sss, "(\D+)?(\d+)(\D+)?")
DIM res = ""
FOR m = 0 TO Matches.Count - 1
serial = Matches.Item(m).SubMatches(1)
SELECT value
CASE 1, 2
DIM n[][9] = "〇", "一", "二", "三", "四", "五", "六", "七", "八", "九", + _
"", "壱", "弐", "参", "四", "伍", "六", "七", "八", "九"
DIM a[][3] = "", "十", "百", "千", + _
"", "拾", "百", "阡"
DIM b[][3] = "", "万", "億", "兆", + _
"", "萬", "億", "兆"
DIM r = ""
DIM j = 0
type = value - 1
REPEAT
DIM str = ""
DIM n4 = serial MOD 10000
FOR i = LENGTH(n4) TO 1 STEP -1
s = COPY(n4, i, 1)
IFB s = 1 AND a[type][LENGTH(n4)-i] <> "" THEN
str = IIF(s, a[type][LENGTH(n4)-i], "") + str
ELSE
str = n[type][s] + IIF(s, a[type][LENGTH(n4)-i], "") + str
ENDIF
NEXT
IF str <> "" THEN r = str + b[type][j] + r
j = j + 1
serial = INT(serial / 10000)
UNTIL serial = 0
res = res + Matches.Item(m).SubMatches(0) + r + Matches.Item(m).SubMatches(2)
CASE 3
res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_FULLWIDTH) + Matches.Item(m).SubMatches(2)
CASE 4
res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_HALFWIDTH) + Matches.Item(m).SubMatches(2)
SELEND
NEXT
RESULT = res
CASE reTest(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$")
Matches = reExecute(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$")
DIM array = SPLIT(Matches.Item(0).SubMatches(1), "/")
ampm = array[IIF(serial - INT(serial) >= 0.5, 1, 0)]
hour12 = TRUE
res = ""
WITH Matches.Item(0)
res = text(serial, .SubMatches(0), hour12) + ampm + text(serial, .SubMatches(2), hour12)
ENDWITH
RESULT = res
CASE reTest(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?")
Matches = reExecute(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?")
FOR n = 0 TO Matches.Count - 1
IF n = 0 THEN res = Matches.Item(n).SubMatches(0)
NEXT
FOR n = 0 TO Matches.Count - 1
WITH Matches.Item(n)
res = res + text(serial, .SubMatches(1), hour12) + .SubMatches(3)
ENDWITH
NEXT
RESULT = res
CASE format = "0/0"
DIM separator = POS(".", serial)
DIM g = 0
IFB separator <> 0 THEN
DIM keta = LENGTH(serial)
DIM shift = POWER(10, keta - separator)
IFB shift >= POWER(10, 15) THEN
DIM position = 0
FOR i = 0 TO 14
IFB serial * POWER(10, i) - serial >= 1 THEN
position = i
BREAK
ENDIF
NEXT
tmp = serial * POWER(10, position)
FOR i = 1 TO 15
r = (tmp * POWER(10, i)) / serial - (tmp / serial)
a1 = tmp * POWER(10, i) - tmp
IF a1 = INT(a1) THEN BREAK
NEXT
DIM frac[] = a1, r
g = GCD(frac)
RESULT = (a1/g) + "/" + (r/g)
ELSE
DIM molecule = serial * shift // 分子
DIM denominator = shift // 分母
DIM nums[] = molecule, denominator
g = GCD(nums)
molecule = molecule / g
denominator = denominator / g
RESULT = molecule + "/" + denominator
ENDIF
ELSE
RESULT = serial + "/1"
ENDIF
CASE reTest(format, "(0+)\.?(0+)?") AND UBound(SPLIT(format, ".")) <= 1
Matches = reExecute(format, "(0+)\.?(0+)?")
len1 = LENGTH(Matches.Item(0).SubMatches(0))
len2 = LENGTH(Matches.Item(0).SubMatches(1))
DIM arr[] = LENGTH(INT(serial)), len1
IFB POS(".", format) THEN
RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX) + len2 + 1, len2), " ", "0")
ELSE
RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX)), " ", "0")
ENDIF
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 時刻文字列。hh:nn:ss AM/PM、hh:nn AM/PM、hh AM/PM、hh:nn:ss、hh:nn、hh時nn分ss秒、hh時nn分のいずれかの形式を指定。
// 【戻り値】
// シリアル値 （例）0…00:00:00、0.5…12:00:00、0.999988425925926…23:59:59
//////////////////////////////////////////////////
FUNCTION timeValue(str)
DIM serial = 0
DIM Matches
DIM pattern = "(\d+)"
DIM hh = "(0?[0-9]|1[0-2])"
DIM ampm = "([AP]M|[ap]m)"
SELECT TRUE
CASE reTest(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b")
WITH Matches.Item(0)
serial = timeValue(.SubMatches(0) + " " + .SubMatches(3)) + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + hh + ":" + pattern + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + ":" + pattern + " " + ampm + "\b")
WITH Matches.Item(0)
serial = timeValue(.SubMatches(0) + " " + .SubMatches(2)) + VAL(.SubMatches(1)) / 1440
ENDWITH
CASE reTest(str, "\b" + hh + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + " " + ampm + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0) MOD 12) + IIF(reTest(.SubMatches(1), "AM|am"), 0, 12)
serial = serial / 24
ENDWITH
CASE reTest(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b")
Matches = reExecute(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + pattern + ":" + pattern + "\b")
Matches = reExecute(str, "\b" + pattern + ":" + pattern + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440
ENDWITH
CASE reTest(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒")
Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + pattern + "時" + pattern + "分")
Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440
ENDWITH
DEFAULT
serial = ERR_VALUE
SELEND
RESULT = serial - INT(serial)
FEND
//////////////////////////////////////////////////
// 【引数】
// arrayname : 上限値を求める配列の名前
// dimension : 返す次元を示す整数
// 【戻り値】
// 配列の上限値
//////////////////////////////////////////////////
FUNCTION UBound(arrayname[], dimension = 1)
RESULT = EVAL("RESIZE(arrayname" + strRepeat("[0]", dimension - 1) + ")")
FEND結果
トウキョウ使用関数
週最初の曜日を取得
コントロール パネル\時計と地域\地域の日付と時刻の形式にある週の最初の曜日の項目を取得します。レジストリのiFirstDayOfWeekが返す値は0が月曜日、1が火曜日、…、6が日曜日のようになります。
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
DIM firstdayofweek = WshShell.RegRead("HKEY_CURRENT_USER\Control Panel\International\iFirstDayOfWeek")
DIM weeks[] = "月", "火", "水", "木", "金", "土", "日"
PRINT firstdayofweek
PRINT weeks[firstdayofweek]結果
6
日使用関数
レジストリから現在設定されているタイムゾーンを取得
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
DIM TimeZoneKeyName = WshShell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\TimeZoneKeyName")
PRINT WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\" + TimeZoneKeyName + "\Display")結果
(UTC+09:00) 大阪、札幌、東京使用関数
ゴールドプラザで最新の金の価格を取得
[createLink url="https://goldplaza.jp/gold/rate"] で最新の金の価格を取得します。
DIM WebDriver = CREATEOLEOBJ("Selenium.WebDriver")
WebDriver.Start("chrome")
WebDriver.Get("https://goldplaza.jp/gold/rate")
WebElement = WebDriver.FindElementByXPath("//span[@data-grd-rate='gold']")
PRINT WebElement.text
//////////////////////////////////////////////////
// 【引数】
// interval : 加算する時間間隔を表す文字列式（yyyy：年、m：月、d：日、ww：週、h：時、n：分、s：秒）
// num : dateに加算する値。未来は正、過去は負で指定
// date : 時間間隔を加算する日付
// 【戻り値】
// 日時（date）に、指定した単位（interval）の時間（num）を加算して返します
//////////////////////////////////////////////////
FUNCTION dateAdd(interval, num, date)
DIM year, month, day, d
GETTIME(0, date)
DIM time = G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2
SELECT interval
CASE "yyyy"
d = (G_TIME_YY + num) + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
IF time <> "00:00:00" THEN d = d + " " + time
CASE "m"
IFB num > 0 THEN
year = G_TIME_YY + INT((G_TIME_MM + num) / 12)
month = REPLACE(FORMAT(((G_TIME_MM + num) MOD 12), 2), " ", "0")
ELSE
year = G_TIME_YY + CEIL((G_TIME_MM + num) / 12 - 1)
month = REPLACE(FORMAT(G_TIME_MM - (ABS(num) MOD 12), 2), " ", "0")
ENDIF
IF month = "00" THEN month = 12
day = G_TIME_DD2
d = "" + year + month + day
IFB !isDate(d) THEN
d = year + "/" + month + "/" + "01"
d = getEndOfMonth(d)
ELSE
d = year + "/" + month + "/" + day
ENDIF
IF time <> "00:00:00" THEN d = d + " " + time
CASE "d"
t = GETTIME(num, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "ww"
t = GETTIME(num * 7, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "h"
t = GETTIME(num / 24, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "n"
t = GETTIME(num / 1440, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
CASE "s"
t = GETTIME(num / 86400, date)
d = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 + IIF(t MOD 86400, " " + G_TIME_HH2 + ":" + G_TIME_NN2 + ":" + G_TIME_SS2, "")
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
// interval : 時間単位（yyyy︰年、q：四半期、m︰月、d︰日、w：週日、ww：週、h：時、n：分、s：秒）
// date1 : 日時1
// date2 : 日時2
// 【戻り値】
// date2からdate1を引いた時間間隔を求めます。
//////////////////////////////////////////////////
FUNCTION dateDiff(interval, date1, date2)
DIM y1, y2, m1, m2, d1, d2, d
SELECT interval
CASE "yyyy"
GETTIME(0, date1)
y1 = G_TIME_YY
GETTIME(0, date2)
y2 = G_TIME_YY
d = y2 - y1
CASE "q"
GETTIME(0, date1)
y1 = G_TIME_YY
m1 = G_TIME_MM
GETTIME(0, date2)
y2 = G_TIME_YY
m2 = G_TIME_MM
d = y2 * 4 + CEIL(m2/3) - (y1 * 4 + CEIL(m1/3))
CASE "m"
GETTIME(0, date1)
y1 = G_TIME_YY
m1 = G_TIME_MM
GETTIME(0, date2)
y2 = G_TIME_YY
m2 = G_TIME_MM
d = (y2 - y1) * 12 + m2 - m1
CASE "d"
d1 = GETTIME(0, date1)
d2 = GETTIME(0, date2)
d = (d2 - d1) / 86400
CASE "w"
d = INT(dateDiff("d", date1, date2) / 7)
CASE "ww"
date1 = dateAdd("d", -1 * getWeekday(date1), date1)
d = INT(dateDiff("d", date1, date2) / 7)
CASE "h"
d = dateDiff("d", date1, date2) * 24
CASE "n"
d = dateDiff("d", date1, date2) * 1440
CASE "s"
d = dateDiff("d", date1, date2) * 86400
SELEND
RESULT = d
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 最大公約数を求める数値を格納した配列
// 【戻り値】
// 最大公約数
//////////////////////////////////////////////////
FUNCTION GCD(array[])
DIM c = LENGTH(array)
DIM rem = array[c-1] MOD array[c-2]
IFB rem = 0 THEN
IFB LENGTH(array) = 2 THEN
RESULT = array[c-2]
EXIT
ENDIF
RESIZE(array, c-2)
RESULT = GCD(array)
EXIT
ENDIF
array[c-1] = array[c-2]
array[c-2] = rem
RESULT = GCD(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）
// m : 第一引数の指定日からプラスマイナスm月とする
// 【戻り値】
// dateからm月後の月末の日付
//////////////////////////////////////////////////
FUNCTION getEndOfMonth(date, m = 0)
date = dateAdd("m", m + 1, date)
GETTIME(0, date)
GETTIME(-G_TIME_DD, date)
RESULT = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付文字列（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）もしくはシリアル値
// type : 取得する曜日番号の種類を示す0〜3または11〜17の値。1と17は日曜日を1、2と11は月曜日を1とカウントします。11以降はExcel2010で追加された値で、互換性を保つために重複した値があります。
// 【戻り値】
// typeで指定した種類によって以下の値を返します。 : （0 : 0(日曜)〜6(土曜)、1 : 1(日曜)～7(土曜)、2 : 1(月曜)～7(日曜)、3 : 0(月曜)〜6(日曜)、11 : 1(月曜)～7(日曜)、12 : 1(火曜)～7(月曜)、13 : 1(水曜)～7(火曜)、14 : 1(木曜)～7(水曜)、15 : 1(金曜)～7(木曜)、16 : 1(土曜)～7(金曜)、17 : 1(日曜)～7(土曜)）
//////////////////////////////////////////////////
FUNCTION getWeekday(date, type = 1)
IF VARTYPE(date) <> 258 THEN date = text(date, "yyyy/mm/dd")
GETTIME(0, date)
DIM w = G_TIME_WW
SELECT TRUE
CASE type = 0
RESULT = w
CASE type = 1
RESULT = w + 1
CASE type = 2
RESULT = IIF(w=0, 7, w)
CASE type = 3
RESULT = (w+6) MOD 7
CASE type >= 11
RESULT = ((getWeekday(date, 2) + 17 - type) MOD 7) + 1
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : シリアル値もしくは時刻文字列
// 【戻り値】
// 時刻から時間を表す0〜23の範囲の値
//////////////////////////////////////////////////
FUNCTION Hour(serial)
IF VARTYPE(serial) = 258 THEN serial = timeValue(serial)
RESULT = INT(serial * 24) MOD 24
FEND
//////////////////////////////////////////////////
// 【引数】
// expr : 評価する式
// truepart : 評価した式がTrueのときに返す値
// falsepart : 評価した式がFalseのときに返す値
// 【戻り値】
// truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき
//////////////////////////////////////////////////
FUNCTION IIF(expr, truepart, falsepart)
IFB EVAL(expr) THEN
RESULT = truepart
ELSE
RESULT = falsepart
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 存在するかを調べる日付文字列。YYYYMMDD or YYYY/MM/DD or YYYY-MM-DDのいずれかの形式。
// 【戻り値】
// TRUE : 日付として認識できる、FALSE : 日付として認識できない
//////////////////////////////////////////////////
FUNCTION isDate(date)
TRY
GETTIME(0, date)
RESULT = TRUE
EXCEPT
RESULT = FALSE
ENDTRY
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 正規表現による検索の対象となる文字列
// Pattern : 正規表現で使用するパターンを設定
// IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse
// Global : 文字列全体を検索する場合はTrue、しない場合はFalse
// 【戻り値】
// 正規表現で検索した結果をMatchesコレクションとして返します。
//////////////////////////////////////////////////
FUNCTION reExecute(str, Pattern, IgnoreCase = TRUE, Global = TRUE)
DIM re = CREATEOLEOBJ("VBScript.RegExp")
re.Pattern = Pattern
re.IgnoreCase = IgnoreCase
re.Global = Global
RESULT = re.Execute(str)
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 正規表現による検索の対象となる文字列
// Pattern : 正規表現で使用するパターンを設定
// IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse
// Global : 文字列全体を検索する場合はTrue、しない場合はFalse
// 【戻り値】
// 正規表現にマッチするかどうかを示すブール値
//////////////////////////////////////////////////
FUNCTION reTest(str, Pattern, IgnoreCase = TRUE, Global = TRUE)
DIM re = CREATEOLEOBJ("VBScript.RegExp")
re.Pattern = Pattern
re.IgnoreCase = IgnoreCase
re.Global = Global
RESULT = re.Test(str)
FEND
//////////////////////////////////////////////////
// 【引数】
// inputs : 繰り返す文字列
// multiplier : inputsを繰り返す回数
// 【戻り値】
// inputsをmultiplier回を繰り返した文字列を返します
//////////////////////////////////////////////////
FUNCTION strRepeat(inputs, multiplier)
DIM res = ""
FOR n = 1 TO multiplier
res = res + inputs
NEXT
RESULT = res
FEND
//////////////////////////////////////////////////
// 【引数】
// serial : シリアル値
// format : フォーマット
// 【戻り値】
// 数値を表示書式に基づいて変換した文字列
//////////////////////////////////////////////////
FUNCTION text(serial, format, hour12 = FALSE)
HASHTBL startDate
startDate["明治"] = "1868/01/25"
startDate["大正"] = "1912/07/30"
startDate["昭和"] = "1926/12/25"
startDate["平成"] = "1989/01/08"
startDate["令和"] = "2019/05/01"
DIM baseDate = "1899/12/30"
serial = VAL(serial)
SELECT TRUE
CASE reTest(format, "\[h+\]")
Matches = reExecute(format, "\[(h+)\]")
DIM hour = iif(hour12, Hour(serial) MOD 12, Hour(serial))
RESULT = text(hour, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE reTest(format, "^h+$")
Matches = reExecute(format, "^(h+)$")
hour = iif(hour12, Hour(serial) MOD 12, Hour(serial))
RESULT = text(hour MOD 24, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE reTest(format, "\[m+\]")
Matches = reExecute(format, "\[(m+)\]")
RESULT = text(serial * 1440, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0))))
CASE format = "m"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_MM, "0")
CASE format = "mm"
GETTIME(serial, baseDate)
RESULT = G_TIME_MM2
CASE format = "n"
GETTIME(serial, baseDate)
RESULT = G_TIME_NN
CASE format = "nn"
GETTIME(serial, baseDate)
RESULT = G_TIME_NN2
CASE format = "s"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_SS, "0")
CASE format = "ss"
GETTIME(serial, baseDate)
RESULT = G_TIME_SS2
CASE format = "yyyy"
GETTIME(serial, baseDate)
RESULT = G_TIME_YY4
CASE format = "yy"
GETTIME(serial, baseDate)
RESULT = COPY(G_TIME_YY4, 3, 2)
CASE format = "e"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 2018
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1988
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1925
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1911
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(serial, "yyyy") - 1867
SELEND
CASE format = "ee"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 2018, "00")
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1988, "00")
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1925, "00")
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1911, "00")
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0
RESULT = text(text(serial, "yyyy") - 1867, "00")
SELEND
CASE format = "g"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "R"
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "H"
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "S"
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "T"
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "M"
SELEND
CASE format = "gg"
RESULT = COPY(text(serial, "ggg"), 1, 1)
CASE format = "ggg"
SELECT TRUE
CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "令和"
CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "平成"
CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "昭和"
CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "大正"
CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "明治"
SELEND
CASE format = "mmmmm"
RESULT = COPY(text(serial, "mmmm"), 1, 1)
CASE format = "mmmm"
DIM month[] = "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"
RESULT = month[text(serial, "m") - 1]
CASE format = "mmm"
RESULT = COPY(text(serial, "mmmm"), 1, 3)
CASE format = "dd"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_DD2, "00")
CASE format = "d"
GETTIME(serial, baseDate)
RESULT = text(G_TIME_DD, "0")
CASE reTest(format, "^[ad]{3,4}$")
Matches = reExecute(format, "([ad]{3,4})")
GETTIME(serial, baseDate)
DIM aaa[] = "日", "月", "火", "水", "木", "金", "土"
DIM aaaa[] = "日曜日", "月曜日", "火曜日", "水曜日", "木曜日", "金曜日", "土曜日"
DIM ddd[] = "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"
DIM dddd[] = "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday";
RESULT = EVAL(Matches.Item(0).SubMatches(0) + "[" + getWeekday(G_TIME_WW, 1) + "]")
CASE reTest(format, "(0+\.?0+)?%")
Matches = reExecute(format, "(0+\.?0+)?%")
RESULT = text(serial * 100, Matches.Item(0).SubMatches(0)) + "%"
CASE reTest(format, "^\[DBNum\d{1,4}\](.*?)$")
Matches = reExecute(format, "^\[DBNum(\d{1,4})\](.*?)$")
DIM value = VAL(Matches.Item(0).SubMatches(0))
DIM sss = text(serial, Matches.Item(0).SubMatches(1))
Matches = reExecute(sss, "(\D+)?(\d+)(\D+)?")
DIM res = ""
FOR m = 0 TO Matches.Count - 1
serial = Matches.Item(m).SubMatches(1)
SELECT value
CASE 1, 2
DIM n[][9] = "〇", "一", "二", "三", "四", "五", "六", "七", "八", "九", + _
"", "壱", "弐", "参", "四", "伍", "六", "七", "八", "九"
DIM a[][3] = "", "十", "百", "千", + _
"", "拾", "百", "阡"
DIM b[][3] = "", "万", "億", "兆", + _
"", "萬", "億", "兆"
DIM r = ""
DIM j = 0
type = value - 1
REPEAT
DIM str = ""
DIM n4 = serial MOD 10000
FOR i = LENGTH(n4) TO 1 STEP -1
s = COPY(n4, i, 1)
IFB s = 1 AND a[type][LENGTH(n4)-i] <> "" THEN
str = IIF(s, a[type][LENGTH(n4)-i], "") + str
ELSE
str = n[type][s] + IIF(s, a[type][LENGTH(n4)-i], "") + str
ENDIF
NEXT
IF str <> "" THEN r = str + b[type][j] + r
j = j + 1
serial = INT(serial / 10000)
UNTIL serial = 0
res = res + Matches.Item(m).SubMatches(0) + r + Matches.Item(m).SubMatches(2)
CASE 3
res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_FULLWIDTH) + Matches.Item(m).SubMatches(2)
CASE 4
res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_HALFWIDTH) + Matches.Item(m).SubMatches(2)
SELEND
NEXT
RESULT = res
CASE reTest(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$")
Matches = reExecute(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$")
DIM array = SPLIT(Matches.Item(0).SubMatches(1), "/")
ampm = array[IIF(serial - INT(serial) >= 0.5, 1, 0)]
hour12 = TRUE
res = ""
WITH Matches.Item(0)
res = text(serial, .SubMatches(0), hour12) + ampm + text(serial, .SubMatches(2), hour12)
ENDWITH
RESULT = res
CASE reTest(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?")
Matches = reExecute(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?")
FOR n = 0 TO Matches.Count - 1
IF n = 0 THEN res = Matches.Item(n).SubMatches(0)
NEXT
FOR n = 0 TO Matches.Count - 1
WITH Matches.Item(n)
res = res + text(serial, .SubMatches(1), hour12) + .SubMatches(3)
ENDWITH
NEXT
RESULT = res
CASE format = "0/0"
DIM separator = POS(".", serial)
DIM g = 0
IFB separator <> 0 THEN
DIM keta = LENGTH(serial)
DIM shift = POWER(10, keta - separator)
IFB shift >= POWER(10, 15) THEN
DIM position = 0
FOR i = 0 TO 14
IFB serial * POWER(10, i) - serial >= 1 THEN
position = i
BREAK
ENDIF
NEXT
tmp = serial * POWER(10, position)
FOR i = 1 TO 15
r = (tmp * POWER(10, i)) / serial - (tmp / serial)
a1 = tmp * POWER(10, i) - tmp
IF a1 = INT(a1) THEN BREAK
NEXT
DIM frac[] = a1, r
g = GCD(frac)
RESULT = (a1/g) + "/" + (r/g)
ELSE
DIM molecule = serial * shift // 分子
DIM denominator = shift // 分母
DIM nums[] = molecule, denominator
g = GCD(nums)
molecule = molecule / g
denominator = denominator / g
RESULT = molecule + "/" + denominator
ENDIF
ELSE
RESULT = serial + "/1"
ENDIF
CASE reTest(format, "(0+)\.?(0+)?") AND UBound(SPLIT(format, ".")) <= 1
Matches = reExecute(format, "(0+)\.?(0+)?")
len1 = LENGTH(Matches.Item(0).SubMatches(0))
len2 = LENGTH(Matches.Item(0).SubMatches(1))
DIM arr[] = LENGTH(INT(serial)), len1
IFB POS(".", format) THEN
RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX) + len2 + 1, len2), " ", "0")
ELSE
RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX)), " ", "0")
ENDIF
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// str : 時刻文字列。hh:nn:ss AM/PM、hh:nn AM/PM、hh AM/PM、hh:nn:ss、hh:nn、hh時nn分ss秒、hh時nn分のいずれかの形式を指定。
// 【戻り値】
// シリアル値 （例）0…00:00:00、0.5…12:00:00、0.999988425925926…23:59:59
//////////////////////////////////////////////////
FUNCTION timeValue(str)
DIM serial = 0
DIM Matches
DIM pattern = "(\d+)"
DIM hh = "(0?[0-9]|1[0-2])"
DIM ampm = "([AP]M|[ap]m)"
SELECT TRUE
CASE reTest(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b")
WITH Matches.Item(0)
serial = timeValue(.SubMatches(0) + " " + .SubMatches(3)) + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + hh + ":" + pattern + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + ":" + pattern + " " + ampm + "\b")
WITH Matches.Item(0)
serial = timeValue(.SubMatches(0) + " " + .SubMatches(2)) + VAL(.SubMatches(1)) / 1440
ENDWITH
CASE reTest(str, "\b" + hh + " " + ampm + "\b")
Matches = reExecute(str, "\b" + hh + " " + ampm + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0) MOD 12) + IIF(reTest(.SubMatches(1), "AM|am"), 0, 12)
serial = serial / 24
ENDWITH
CASE reTest(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b")
Matches = reExecute(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + pattern + ":" + pattern + "\b")
Matches = reExecute(str, "\b" + pattern + ":" + pattern + "\b")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440
ENDWITH
CASE reTest(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒")
Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400
ENDWITH
CASE reTest(str, "\b" + pattern + "時" + pattern + "分")
Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分")
WITH Matches.Item(0)
serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440
ENDWITH
DEFAULT
serial = ERR_VALUE
SELEND
RESULT = serial - INT(serial)
FEND
//////////////////////////////////////////////////
// 【引数】
// arrayname : 上限値を求める配列の名前
// dimension : 返す次元を示す整数
// 【戻り値】
// 配列の上限値
//////////////////////////////////////////////////
FUNCTION UBound(arrayname[], dimension = 1)
RESULT = EVAL("RESIZE(arrayname" + strRepeat("[0]", dimension - 1) + ")")
FEND結果
¥16,874使用関数
UWSCのショートカットをスタートアップに作成
C:\Program Files (x86)\UWSC\UWSC.exeのショートカットをスタートアップに作成します。
CONST ssfSTARTUP = 7
DIM Shell = CREATEOLEOBJ("Shell.Application")
DIM folderspec = Shell.NameSpace(ssfSTARTUP).Self.Path
DIM WshShell = CREATEOLEOBJ("WScript.Shell")
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM WshShortcut = WshShell.CreateShortcut(FSO.BuildPath(folderspec, "UWSC.exe - ショートカット.lnk"))
WITH WshShortcut
.IconLocation = "C:\Program Files (x86)\UWSC\UWSC.exe, 0"
.TargetPath = "C:\Program Files (x86)\UWSC\UWSC.exe"
.WindowStyle = 1
.WorkingDirectory = "C:\Program Files (x86)\UWSC\"
.Save
ENDWITH使用関数
古いキャッシュファイルを削除する
Localフォルダ（C:\Users\username\AppData\Local\Temp \）にあるファイルの最終更新日時が7日以上前のファイルをごみ箱に移動します。
CONST ssfBITBUCKET = 10
CONST ssfLOCALAPPDATA = 28
DIM Shell = CREATEOLEOBJ("Shell.Application")
DIM Folder2 = Shell.NameSpace(ssfLOCALAPPDATA)
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM folderspec = FSO.BuildPath(Folder2.Self.Path, "Temp")
DIM FolderTemp = FSO.GetFolder(folderspec)
DIM FolderRecycle = Shell.NameSpace(ssfBITBUCKET)
DIM base = GETTIME(-7)
DIM Files = FolderTemp.Files
DIM count = Files.Count
DIM res = MSGBOX(count + "個のフォイルをごみ箱に移動します。", BTN_YES OR BTN_NO,,, BTN_NO)
IFB res = BTN_YES THEN
FOR File IN Files
DIM datetime = File.DateLastModified
IFB GETTIME(0, datetime) - base <= 0 THEN
PRINT File.Path
FolderRecycle.MoveHere(File.Path)
ENDIF
NEXT
ENDIF使用関数