指定画像が画面上にあるかチェックし、あればその情報を返します。
CHKIMG関数は色幅は64/256までは許容範囲ですが、形は完全に一致する画像しか検索しかできません。曖昧検索をする場合は、ChkImgX関数を使います。
- 構文
- Boolean = CHKIMG( 画像名, 透過色/色無視, x1, y1, x2, y2, 番号, 色幅 )
- 引数
- 画像名 (String = Empty)省略可
- 画像ファイル名(BMP形式のみ) (画像名を省略した場合はクリップボードから)
- 透過色/色無視 (Integer = 0)省略可
- 0
- 指定なし(デフォルト)
- 1,2,3,4
- 左上(1),右上(2),左下(3),右下(4)の1ピクセルの色を透過色として処理
- -1
- 色を無視して形でチェックする
- x1, y1, x2, y2 (Integer)省略可
- サーチ範囲
- 番号 (Integer = 0)省略可
- 複数ある場合に順番を指定 (左上から)
- -1
- -1が指定された場合はヒットした数を戻値として返し、座標情報はALL_IMG_X[],ALL_IMG_Y[]に格納
- 色幅 (#chkimg = 0)省略可
- チェックに色幅を持たせる (色無視指定時もしくは 16bitカラー以下の場合は無効)
- IMG_MSK_BGR1
- 各色(BGR)に対し 2/256の色幅を許す
- IMG_MSK_BGR2
- 各色(BGR)に対し 4/256の色幅を許す
- IMG_MSK_BGR3
- 各色(BGR)に対し 8/256の色幅を許す
- IMG_MSK_BGR4
- 各色(BGR)に対し 16/256の色幅を許す
- IMG_MSK_B1, 2, 3, 4
- 青に対し 2/256, 4/256, 8/256, 16/256の色幅を許す
- IMG_MSK_G1, 2, 3, 4
- 緑に対し 2/256, 4/256, 8/256, 16/256の色幅を許す
- IMG_MSK_R1, 2, 3, 4
- 赤に対し 2/256, 4/256, 8/256, 16/256の色幅を許す
演算可例:IMG_MSK_B1 or IMG_MSK_R3(青に対し 2/256の色幅を許す + 赤に対し 8/256の色幅を許す)
- 戻り値
有ればTRUE、無ければFALSE
TRUEの場合は見つかった座標を特殊変数G_IMG_X、G_IMG_Yに格納
番号にて -1指定時はヒットした数を返し、座標情報は配列変数ALL_IMG_X[],ALL_IMG_Y[]に格納(配列はゼロから)
画像名
画像名は現在実行しているUWSファイルがあるフォルダにある画像となります。現在のフォルダはGET_CUR_DIRで確認することができ、他のフォルダの画像を指定する場合は絶対パスで指定します。
サーチ範囲の座標について
左上が基準(x = 0,y = 0)です。x2,y2はx1,y1より大きい値(x1 < x2かつy1 < y2が成り立つ範囲)を指定してください。
アクティブウィンドウの範囲
DIM ID = GETID(GET_ACTIVE_WIN)
DIM x = STATUS(ID, ST_X)
DIM y = STATUS(ID, ST_Y)
DIM width = STATUS(ID, ST_WIDTH)
DIM height = STATUS(ID, ST_HEIGHT)
CHKIMG("image.bmp",, x, y, x + width, y + height)色幅
色幅は24bit以上でないと無視されてしまいます。
ビットの深さは、[ファイル]を右クリック-[プロパティ]-[詳細]で確認、もしくはgetBitmap関数 (自作関数)で取得できます。
DIM array = getBitmap(path)
PRINT array[3]以下は左上から(B, G, R) = (180, 174, 255)~(219, 174, 255)の画像を並べています。
以下は上記画像のB成分をまとめた表です。画像の位置と対応しています。
| B成分の値 | |||||||||
|---|---|---|---|---|---|---|---|---|---|
| 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 |
| 190 | 191 | 192 | 193 | 194 | 195 | 196 | 197 | 198 | 199 |
| 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | 209 |
| 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 |
以下は(B, G, R) = (200, 174, 255)の画像で、色幅を指定することで上に示したハートを並べた画像にどれだけの誤差までマッチするのかを調べるプログラム。
DIM path = "D:\Desktop\CHKIMG\BGR=200,174,255.bmp"
DIM array[] = "IMG_MSK_BGR", "IMG_MSK_B", "IMG_MSK_G", "IMG_MSK_R"
PRINT "元画像:BGR=200,174,255.bmp"
PRINT
FOR item IN array
FOR i = 1 TO 4
a = item + i
// PRINT a + "<#TAB>" + CHKIMG(path,,,,,, -1, EVAL(a))
DIM num = CHKIMG(path,,,,,, -1, EVAL(a))
PRINT "■" + a
PRINT "マッチ数:" + num
FOR n = 0 TO num - 1
DIM c = PEEKCOLOR(ALL_IMG_X[n] + 25, ALL_IMG_Y[n] + 25)
DIM r = c AND $FF
DIM g = (c AND $FF00) / $100
DIM b = (c AND $FF0000) / $10000
PRINT r + ", " + g + ", " + b
NEXT
PRINT
NEXT
NEXT- 結果
元画像:BGR=200,174,255.bmp ■IMG_MSK_BGR1 マッチ数:3 255, 174, 199 255, 174, 200 255, 174, 201 ■IMG_MSK_BGR2 マッチ数:7 255, 174, 197 255, 174, 198 255, 174, 199 255, 174, 200 255, 174, 201 255, 174, 202 255, 174, 203 ■IMG_MSK_BGR3 マッチ数:15 255, 174, 193 255, 174, 194 255, 174, 195 255, 174, 196 255, 174, 197 255, 174, 198 255, 174, 199 255, 174, 200 255, 174, 201 255, 174, 202 255, 174, 203 255, 174, 204 255, 174, 205 255, 174, 206 255, 174, 207 ■IMG_MSK_BGR4 マッチ数:31 255, 174, 185 255, 174, 186 255, 174, 187 255, 174, 188 255, 174, 189 255, 174, 190 255, 174, 191 255, 174, 192 255, 174, 193 255, 174, 194 255, 174, 195 255, 174, 196 255, 174, 197 255, 174, 198 255, 174, 199 255, 174, 200 255, 174, 201 255, 174, 202 255, 174, 203 255, 174, 204 255, 174, 205 255, 174, 206 255, 174, 207 255, 174, 208 255, 174, 209 255, 174, 210 255, 174, 211 255, 174, 212 255, 174, 213 255, 174, 214 255, 174, 215 ■IMG_MSK_B1 マッチ数:3 255, 174, 199 255, 174, 200 255, 174, 201 ■IMG_MSK_B2 マッチ数:7 255, 174, 197 255, 174, 198 255, 174, 199 255, 174, 200 255, 174, 201 255, 174, 202 255, 174, 203 ■IMG_MSK_B3 マッチ数:15 255, 174, 193 255, 174, 194 255, 174, 195 255, 174, 196 255, 174, 197 255, 174, 198 255, 174, 199 255, 174, 200 255, 174, 201 255, 174, 202 255, 174, 203 255, 174, 204 255, 174, 205 255, 174, 206 255, 174, 207 ■IMG_MSK_B4 マッチ数:31 255, 174, 185 255, 174, 186 255, 174, 187 255, 174, 188 255, 174, 189 255, 174, 190 255, 174, 191 255, 174, 192 255, 174, 193 255, 174, 194 255, 174, 195 255, 174, 196 255, 174, 197 255, 174, 198 255, 174, 199 255, 174, 200 255, 174, 201 255, 174, 202 255, 174, 203 255, 174, 204 255, 174, 205 255, 174, 206 255, 174, 207 255, 174, 208 255, 174, 209 255, 174, 210 255, 174, 211 255, 174, 212 255, 174, 213 255, 174, 214 255, 174, 215 ■IMG_MSK_G1 マッチ数:1 255, 174, 200 ■IMG_MSK_G2 マッチ数:1 255, 174, 200 ■IMG_MSK_G3 マッチ数:1 255, 174, 200 ■IMG_MSK_G4 マッチ数:1 255, 174, 200 ■IMG_MSK_R1 マッチ数:1 255, 174, 200 ■IMG_MSK_R2 マッチ数:1 255, 174, 200 ■IMG_MSK_R3 マッチ数:1 255, 174, 200 ■IMG_MSK_R4 マッチ数:1 255, 174, 200
以上の結果から、マッチする色幅は以下のようになることがわかります。
| 定数名 | マッチするBGRの範囲 |
|---|---|
| IMG_MSK_BGR1 | (-1, -1, -1)〜(+1, +1, +1) |
| IMG_MSK_BGR2 | (-3, -3, -3)〜(+3, +3, +3) |
| IMG_MSK_BGR3 | (-7, -7, -7)〜(+7, +7, +7) |
| IMG_MSK_BGR4 | (-15, -15, -15)〜(+15, +15, +15) |
| IMG_MSK_B1 | (-1, ±0, ±0)〜(+1, ±0, ±0) |
| IMG_MSK_B2 | (-3, ±0, ±0)〜(+3, ±0, ±0) |
| IMG_MSK_B3 | (-7, ±0, ±0)〜(+7, ±0, ±0) |
| IMG_MSK_B4 | (-15, ±0, ±0)〜(+15, ±0, ±0) |
| IMG_MSK_G1 | (±0, -1, ±0)〜(±0, +1, ±0) |
| IMG_MSK_G2 | (±0, -3, ±0)〜(±0, +3, ±0) |
| IMG_MSK_G3 | (±0, -7, ±0)〜(±0, +7, ±0) |
| IMG_MSK_G4 | (±0, -15, ±0)〜(±0, +15, ±0) |
| IMG_MSK_R1 | (±0, ±0, -1)〜(±0, ±0, +1) |
| IMG_MSK_R2 | (±0, ±0, -3)〜(±0, ±0, +3) |
| IMG_MSK_R3 | (±0, ±0, -7)〜(±0, ±0, +7) |
| IMG_MSK_R4 | (±0, ±0, -15)〜(±0, ±0, +15) |
IMG_MSK_RGB(数値) の数値を\(n\)とすると、以下が成り立ちます。
色幅:\((2^{n}-1) \times 2 + 1\)範囲:\(-(2^{n}-1)〜+(2^{n}+1)\)
エラー
CHKIMGでのヒット数が4096を超えるとエラーになるので、マッチさせる画像を大きくするか、調べる範囲を狭くするなどの対策が必要です。
使い方
以下の例でimage.bmpはスクリプトと同じディレクトリにあるものとします。
指定した画像があるか
指定した画像が画面上にある場合True、なければFalseを返します。
PRINT CHKIMG("image.bmp")最初に見つかった画像をクリック
最初に見つかったビットマップ画像をクリックします。
IF CHKIMG("image.bmp") THEN BTN(LEFT, CLICK, G_IMG_X, G_IMG_Y)最後に見つかった画像をクリック
最後に見つかったビットマップ画像をクリックします。
DIM n = CHKIMG("image.bmp", -1,,,,, -1)
BTN(LEFT, CLICK, ALL_IMG_X[n-1], ALL_IMG_Y[n-1])指定画像を色を無視してチェック
指定画像を色を無視して形のみでチェックします。画像が見つかればTrue、見つからなければFalseを返します。
PRINT CHKIMG("image.bmp", -1)指定した画像のヒット数を取得
指定したビットマップ画像のヒット数を取得します。
PRINT CHKIMG("image.bmp",,,,,, -1)- 結果
4
指定した画像が見つかった座標を取得
指定したビットマップ画像が最初に見つかった座標をx,yの形式で出力します。
IF CHKIMG("image.bmp") THEN PRINT G_IMG_X + "," + G_IMG_Y- 結果
67,377
指定した画像が見つかったすべての座標を取得
指定したビットマップ画像が見つかったすべての座標を出力します。インデックス番号は0から始まることに注意してください。
FOR i = 0 TO CHKIMG("image.bmp", -1,,,,, -1) - 1
PRINT i + "<#TAB>" + ALL_IMG_X[i] + "," + ALL_IMG_Y[i]
NEXT- 結果
0 67,277 1 117,277 2 167,277 3 217,277 4 267,277
見つかったすべての画像をクリック
画面上で見つかったすべてビットマップ画像をクリックします。ESCで処理を終了します。
SETHOTKEY(VK_ESC, EMPTYPARAM, "forceQuit")
FOR i = 0 TO CHKIMG("image.bmp", -1,,,,, -1) - 1
BTN(LEFT, CLICK, ALL_IMG_X[i], ALL_IMG_Y[i])
SLEEP(0.500)
NEXTALL_IMG_X,ALL_IMG_Yは指定した画像の左上の座標なので、位置をずらしたい場合はその値を加算します。以下は見つかった画像の左上の座標から右に5px、下に10pxだけずらした位置をクリックします。
SETHOTKEY(VK_ESC, EMPTYPARAM, "forceQuit")
FOR i = 0 TO CHKIMG("image.bmp", -1,,,,, -1) - 1
BTN(LEFT, CLICK, ALL_IMG_X[i] + 5, ALL_IMG_Y[i] + 10)
SLEEP(0.500)
NEXT指定した画像が表示されるまで待機
指定した画像が画面上に表示されるまで処理を待機します。CHKIMG関数は画像が見つからなければFalse、見つかったときはTrueを返すので、REPEAT文でTrueになるまでループし待機します。
SETHOTKEY(VK_ESC, EMPTYPARAM, "forceQuit")
REPEAT
SLEEP(0.001)
UNTIL CHKIMG("image.bmp", -1)
FUKIDASI("画像が見つかりました")
SLEEP(1.000)プログラム実行例
指定した範囲に画像があるかチェック
指定画像が左上の範囲にあればTrue、なければFalseを返します。
PRINT CHKIMG("image.bmp", , 0, 0, G_SCREEN_W / 2, G_SCREEN_H / 2)指定した画像の中央を左クリック
DIM path = "image.bmp"
DIM arr = getBitmap(path)
CHKIMG(path)
BTN(LEFT, CLICK, G_IMG_X + arr[1] / 2, G_IMG_Y + arr[2] / 2)
//////////////////////////////////////////////////
// 【引数】
// 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
//////////////////////////////////////////////////
// 【引数】
//
// 【戻り値】
//
//////////////////////////////////////////////////
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
//////////////////////////////////////////////////
// 【引数】
// 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
//////////////////////////////////////////////////
// 【引数】
// 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
//////////////////////////////////////////////////
// 【引数】
// 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バックグラウンドでマッチした画像クリックする
MOUSEORG(ID, MORG_DIRECT, MORG_BACK)
CHKIMG("image.bmp", -1)
BTN(LEFT, CLICK, G_IMG_X, G_IMG_Y)関連記事
- PEEKCOLOR関数 (スクリプト関数)
- 指定位置の色を取得します。
- BGRToColor関数 (自作関数)
- 引数に指定された青成分、緑成分、赤成分、もしくは#BBGGRR形式の文字列からColor値を求めます。
- invertedColor関数 (自作関数)
- RGBの各成分、Color値、もしくは#RRGGBB形式の文字列から反転色を返します。返り値は引数と同じ形式で返します。
- colorToBGR関数 (自作関数)
- Color値を青成分、緑成分、赤成分に分解し格納した配列で返します。各成分は10進数の値で表されます。flgにTrueを指定した場合、#BBGGRRの形式で返します。
- SAVEIMG関数 (スクリプト関数)
- 画像を保存します。
- altClick関数 (自作関数)
- Web上(IE)の指定したalt属性を含む画像をクリックします。
- getBitmap関数 (自作関数)
- 引数に指定したビットマップ画像のサイズ・幅・高さ・ビットの深さを配列で返します。
- ACW関数 (スクリプト関数)
- ウィンドウの状態を変更、またはアクティブにします。
- MOUSEORG関数 (スクリプト関数)
- マウス座標を相対座標にする、またはマウスとキー情報を直接ウィンドウへ送ります。
- IE.Left プロパティ
- オブジェクトの左端の座標を取得または設定します。
