本ページには広告が含まれています。
数値の絶対値を返します。絶対値とは数値から符号（+,-）を取り除いた値のことです。ABSはABSoluteの略です。
- 構文
- Double = ABS( 数値 )
- 引数
- 数値 （Integer）必須
- 絶対値を求める値
- 戻り値
- 引数の絶対値を返す
使い方
正の数
15の絶対値を求めます。
PRINT ABS(15)- 結果
15
負の数
-43の絶対値を求めます。
PRINT ABS(-43)- 結果
43
先頭のゼロ埋めを取り除く
00123の先頭のゼロを取り除きます。
PRINT ABS("00123")- 結果
123
負の数が指定された場合も同じです。
PRINT ABS("-00123")- 結果
123
プログラム実行例
次の満月の日付を求める
GETTIME()
DIM year = G_TIME_YY
DIM month = G_TIME_MM
DIM day = G_TIME_DD
DIM JD = YMDToJD(year, month, day)
REPEAT
DIM TD = JD - 9/24
DIM JC = (TD + 0.5 - 2451545) / 36525
DIM λsun = longitudeSun(JC)
DIM λmoon = longitudeMoon(JC)
DIM Δλ = ABS(λsun - λmoon)
JD = JD + ABS(180 - Δλ) / 15 // 180°に遠いときは大きい値、近いときは小さい値を足す
UNTIL ABS(Δλ - 180) <= 1 // 誤差が1以下になるまで
d = JDToYMD(JD)
RESIZE(d, 2)
PRINT JOIN(d, "/")
//////////////////////////////////////////////////
// 【引数】
// 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
//////////////////////////////////////////////////
// 【引数】
// 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
//////////////////////////////////////////////////
// 【引数】
// deg : 角度（度数法）
// 【戻り値】
// 度数法から弧度法に変換した値
//////////////////////////////////////////////////
FUNCTION degToRad(deg)
WITH Decimal
pr = .CtorPrecision
.CtorPrecision = 25
RESULT = .times(deg, .dividedBy(Decimal.PI, "180"))
.CtorPrecision = pr
ENDWITH
FEND
//////////////////////////////////////////////////
// 【引数】
// dividend : 被除数
// divisor : 除数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION division(dividend, divisor)
DIM array[] = dividend, divisor
DIM g = GCD(array)
DIM tmp = divisor / g
DIM dat[] = 10, 5, 2
DIM position = 0
FOR i = 0 TO UBound(dat)
WHILE tmp MOD dat[i] = 0
tmp = INT(tmp / dat[i])
position = position + 1
WEND
NEXT
DIM repetend = ""
DIM res = ""
tmp = 0
i = 0
WHILE TRUE
DIM quotient = INT(dividend/divisor)
DIM remainder = dividend MOD divisor
IF i = position THEN tmp = remainder
IFB i > position THEN
repetend = repetend + quotient
ELSE
res = res + quotient
IF i = 0 THEN res = res + "."
ENDIF
IF i > position AND tmp = remainder THEN BREAK
dividend = remainder * 10
i = i + 1
WEND
RESULT = res + IIF(repetend<>0, "[" + repetend + "]", "")
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 数値
// digits : 小数点以下の桁数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION fixed(num, digits = EMPTY)
num = VAL(num) // 指数表記を整える
IFB POS("E-", num) THEN
DIM mantissa = BETWEENSTR(num,, "E")
DIM exponent = BETWEENSTR(num, "E")
RESULT = "0." + strRepeat("0", VAL(ABS(exponent) - 1)) + REPLACE(mantissa, ".", "")
ELSEIF POS("E", num) THEN
RESULT = ROUND(num, -1 *digits)
mantissa = BETWEENSTR(num,, "E")
exponent = BETWEENSTR(num, "E")
RESULT = REPLACE(mantissa, ".", "") + strRepeat("0", VAL(exponent) - decimalDigits(mantissa))
ELSEIF LENGTH(BETWEENSTR(num, ".")) < digits THEN
DIM keta = digits - LENGTH(BETWEENSTR(num, "."))
RESULT = num + IIF(POS(".", num) OR keta = 0, "", ".") + strRepeat("0", keta)
ELSE
IF digits = EMPTY THEN digits = LENGTH(BETWEENSTR(num, "."))
RESULT = "" + roundOff(num, digits)
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// num : 丸め処理を行う値
// 【戻り値】
// 負の方向に丸めた値
//////////////////////////////////////////////////
FUNCTION floor(num)
RESULT = INT(num) + IIF(num < 0 AND num <> INT(num), -1, 0)
FEND
//////////////////////////////////////////////////
// 【引数】
// array : 最大公約数を求める数値を格納した配列
// 【戻り値】
// 最大公約数
//////////////////////////////////////////////////
FUNCTION GCD(array[])
DIM c = LENGTH(array)
DIM rem = array[c-1] MOD array[c-2]
IFB rem = 0 THEN
IFB LENGTH(array) = 2 THEN
RESULT = array[c-2]
EXIT
ENDIF
RESIZE(array, c-2)
RESULT = GCD(array)
EXIT
ENDIF
array[c-1] = array[c-2]
array[c-2] = rem
RESULT = GCD(array)
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）
// m : 第一引数の指定日からプラスマイナスm月とする
// 【戻り値】
// dateからm月後の月末の日付
//////////////////////////////////////////////////
FUNCTION getEndOfMonth(date, m = 0)
date = dateAdd("m", m + 1, date)
GETTIME(0, date)
GETTIME(-G_TIME_DD, date)
RESULT = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 日付文字列（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）もしくはシリアル値
// type : 取得する曜日番号の種類を示す0〜3または11〜17の値。1と17は日曜日を1、2と11は月曜日を1とカウントします。11以降はExcel2010で追加された値で、互換性を保つために重複した値があります。
// 【戻り値】
// typeで指定した種類によって以下の値を返します。 : （0 : 0(日曜)〜6(土曜)、1 : 1(日曜)～7(土曜)、2 : 1(月曜)～7(日曜)、3 : 0(月曜)〜6(日曜)、11 : 1(月曜)～7(日曜)、12 : 1(火曜)～7(月曜)、13 : 1(水曜)～7(火曜)、14 : 1(木曜)～7(水曜)、15 : 1(金曜)～7(木曜)、16 : 1(土曜)～7(金曜)、17 : 1(日曜)～7(土曜)）
//////////////////////////////////////////////////
FUNCTION getWeekday(date, type = 1)
IF VARTYPE(date) <> 258 THEN date = text(date, "yyyy/mm/dd")
GETTIME(0, date)
DIM w = G_TIME_WW
SELECT TRUE
CASE type = 0
RESULT = w
CASE type = 1
RESULT = w + 1
CASE type = 2
RESULT = IIF(w=0, 7, w)
CASE type = 3
RESULT = (w+6) MOD 7
CASE type >= 11
RESULT = ((getWeekday(date, 2) + 17 - type) MOD 7) + 1
SELEND
FEND
//////////////////////////////////////////////////
// 【引数】
// str : ハッシュ化する文字列
// 【戻り値】
// ハッシュ化した文字列
//////////////////////////////////////////////////
MODULE Hash
DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
DIM path
PROCEDURE Hash()
CONST TemporaryFolder = 2
DIM Folder = FSO.GetSpecialFolder(TemporaryFolder)
DIM folderspec = Folder.Path
DIM filename = FSO.GetTempName
path = FSO.BuildPath(folderspec, filename)
FEND
FUNCTION md2(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD2 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION md4(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD4 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION md5(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD5 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha1(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA1 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha256(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA256 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha384(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA384 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
FUNCTION sha512(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA512 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>"))
FSO.DeleteFile(path)
FEND
ENDMODULE
//////////////////////////////////////////////////
// 【引数】
// serial : シリアル値もしくは時刻文字列
// 【戻り値】
// 時刻から時間を表す0〜23の範囲の値
//////////////////////////////////////////////////
FUNCTION Hour(serial)
IF VARTYPE(serial) = 258 THEN serial = timeValue(serial)
RESULT = INT(serial * 24) MOD 24
FEND
//////////////////////////////////////////////////
// 【引数】
// expr : 評価する式
// truepart : 評価した式がTrueのときに返す値
// falsepart : 評価した式がFalseのときに返す値
// 【戻り値】
// truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき
//////////////////////////////////////////////////
FUNCTION IIF(expr, truepart, falsepart)
IFB EVAL(expr) THEN
RESULT = truepart
ELSE
RESULT = falsepart
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// variable : 型を調べる変数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION isArray(variable[])
RESULT = IIF(VARTYPE(variable) AND 8192, TRUE, FALSE)
FEND
//////////////////////////////////////////////////
// 【引数】
// date : 存在するかを調べる日付文字列。YYYYMMDD or YYYY/MM/DD or YYYY-MM-DDのいずれかの形式。
// 【戻り値】
// TRUE : 日付として認識できる、FALSE : 日付として認識できない
//////////////////////////////////////////////////
FUNCTION isDate(date)
TRY
GETTIME(0, date)
RESULT = TRUE
EXCEPT
RESULT = FALSE
ENDTRY
FEND
//////////////////////////////////////////////////
// 【引数】
// variable : 型を調べる変数
// 【戻り値】
//
//////////////////////////////////////////////////
FUNCTION isFloat(variable)
IFB VAL(variable) <> ERR_VALUE THEN
RESULT = IIF((VARTYPE(variable) = VAR_SINGLE OR VARTYPE(variable) = VAR_DOUBLE) AND INT(variable) <> variable, TRUE, FALSE)
ELSE
RESULT = FALSE
ENDIF
FEND
//////////////////////////////////////////////////
// 【引数】
// variable : 型を調べる変数
// 【戻り値】
// : TRUE : 与えられた変数が文字列型である、
// FALSE : 与えられた変数が文字列型でない、 :
//////////////////////////////////////////////////
FUNCTION isString(variable)
RESULT = IIF(VARTYPE(variable) = VAR_ASTR OR VARTYPE(variable) = VAR_USTR, TRUE, FALSE)
FEND
//////////////////////////////////////////////////
// 【引数】
// JD : ユリウス日
// 【戻り値】
// グレゴリオ暦を格納した配列（0 : 年, 1 : 月, 2 : 日, 3 : 時, 4 : 分, 5 : 秒）
//////////////////////////////////////////////////
FUNCTION JDToYMD(JD)
DIM x0 = INT(JD + 68570)
DIM x1 = INT(x0 / 36524.25)
DIM x2 = x0 - INT(36524.25 * x1 + 0.75)
DIM x3 = INT((x2 + 1) / 365.2425)
DIM x4 = x2 - INT(365.25 * x3) + 31
DIM x5 = INT(INT(x4) / 30.59)
DIM x6 = INT(INT(x5) / 11)
DIM t2 = x4 - INT(30.59 * x5)
DIM t1 = x5 - 12 * x6 + 2
DIM t0 = 100 * (x1 - 49) + x3 + x6
IFB t1 = 2 AND t2 > 28 THEN
SELECT TRUE
CASE t0 MOD 100 = 0 AND t0 MOD 400 = 0
t2 = 29
CASE t0 MOD 4 = 0
t2 = 29
DEFAULT
t2 = 28
SELEND
ENDIF
DIM tm = 86400 * (JD - INT(JD))
DIM t3 = INT(tm / 3600)
DIM t4 = INT((tm - 3600 * t3) / 60)
DIM t5 = INT(tm - 3600 * t3 - 60 * t4)
DIM t[] = t0, t1, t2, t3, t4, t5
RESULT = SLICE(t)
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
//////////////////////////////////////////////////
// 【引数】
// JC : ユリウス世紀
// 【戻り値】
// 月黄経（λmoon）
//////////////////////////////////////////////////
FUNCTION longitudeMoon(JC)
DIM A[63] = 0.0003, 0.0003, 0.0003, 0.0003, 0.0003, 0.0003, 0.0003, 0.0004, 0.0004, 0.0005, 0.0005, 0.0005, 0.0006, 0.0006, 0.0007, 0.0007, 0.0007, 0.0007, 0.0008, 0.0009, 0.0011, 0.0012, 0.0016, 0.0018, 0.0021, 0.0021, 0.0021, 0.0022, 0.0023, 0.0024, 0.0026, 0.0027, 0.0028, 0.0037, 0.0038, 0.004, 0.004, 0.004, 0.005, 0.0052, 0.0068, 0.0079, 0.0085, 0.01, 0.0107, 0.011, 0.0125, 0.0154, 0.0304, 0.0347, 0.0409, 0.0458, 0.0533, 0.0571, 0.0588, 0.1144, 0.1851, 0.2136, 0.6583, 1.274, 6.2888, 481267.8809 * JC, 218.3162
DIM k[63] = 2322131, 4067, 549197, 1808933, 349472, 381404, 958465, 12006, 39871, 509131, 1745069, 1908795, 2258267, 111869, 27864, 485333, 405201, 790672, 1403732, 858602, 1920802, 1267871, 1856938, 401329, 341337, 71998, 990397, 818536, 922466, 99863, 1379739, 918399, 1934, 541062, 1781068, 133, 1844932, 1331734, 481266, 31932, 926533, 449334, 826671, 1431597, 1303870, 489205, 1443603, 75870, 513197.9, 445267.1, 441199.8, 854535.2, 1367733.1, 377336.3, 63863.5, 966404, 35999, 954397.7, 890534.2, 413335.3, 477198.9, 0, 0
DIM θ0[63] = 191, 70, 220, 58, 337, 354, 340, 187, 223, 242, 24, 90, 156, 38, 127, 186, 50, 114, 98, 129, 186, 249, 152, 274, 16, 85, 357, 151, 163, 122, 17, 182, 145, 259, 21, 29, 56, 283, 205, 107, 323, 188, 111, 315, 246, 142, 52, 41, 222.5, 27.9, 47.4, 148.2, 280.7, 13.2, 124.2, 276.5, 87.53, 179.93, 145.7, 10.74, 44.963, 0, 0
DIM λmoon[63]
FOR n = 0 TO 60
DIM ang = normalizeAngle(k[n] * JC + θ0[n])
λmoon[n] = A[n] * COS(degToRad(ang))
NEXT
λmoon[61] = normalizeAngle(A[61])
λmoon[62] = normalizeAngle(A[62])
RESULT = normalizeAngle(CALCARRAY(λmoon, CALC_ADD))
FEND
//////////////////////////////////////////////////
// 【引数】
// JC : ユリウス世紀
// 【戻り値】
// 太陽黄経（λsun）
//////////////////////////////////////////////////
FUNCTION longitudeSun(JC)
DIM A[18] = 0.0004, 0.0004, 0.0005, 0.0005, 0.0006, 0.0007, 0.0007, 0.0007, 0.0013, 0.0015, 0.0018, 0.0018, 0.0020, 0.0200, -0.0048*JC, 1.9147, 36000.7695*JC, 280.4659
DIM k[18] = 31557.0, 29930.0, 2281.0, 155.0, 33718.0, 9038.0, 3035.0, 65929.0, 22519.0, 45038.0, 445267.0, 19.0, 32964.0, 71998.1, 35999.05, 35999.05, 0, 0
DIM θ0[18] = 161.0, 48.0, 221.0, 118.0, 316.0, 64.0, 110.0, 45.0, 352.0, 254.0, 208.0, 159.0, 158.0, 265.1, 267.52, 267.52, 0, 0
DIM λsun[18]
FOR n = 0 TO 15
DIM ang = normalizeAngle(k[n] * JC + θ0[n])
λsun[n] = A[n] * COS(degToRad(ang))
NEXT
λsun[16] = normalizeAngle(A[16])
λsun[17] = normalizeAngle(A[17])
RESULT = normalizeAngle(CALCARRAY(λsun, CALC_ADD))
FEND
//////////////////////////////////////////////////
// 【引数】
// deg : 度数法
// offset : 0～360°の範囲からずらす場合のオフセット
// 【戻り値】
// 度単位の角度を0～360度に正規化
//////////////////////////////////////////////////
FUNCTION normalizeAngle(deg, offset = 0)
deg = deg - offset
SELECT TRUE
CASE deg >= 360 + offset
deg = deg - INT(deg / 360) * 360
CASE deg < 0
deg = deg + INT(ABS(deg / 360) + 1) * 360
SELEND
RESULT = deg + offset
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
//////////////////////////////////////////////////
// 【引数】
// year : 年
// month : 月
// day : 日
// hour : 時
// minute : 分
// second : 秒
// 【戻り値】
// ユリウス日
//////////////////////////////////////////////////
FUNCTION YMDToJD(year, month, day, hour = 0, minute = 0, second = 0)
year = VAL(year); month = VAL(month); day = VAL(day);
hour = VAL(hour); minute = VAL(minute); second = VAL(second)
IFB month < 3 THEN
year = year - 1
month = month + 12
ENDIF
DIM JD = INT(year * 365.25)
JD = JD + INT(year / 400)
JD = JD - INT(year / 100)
JD = JD + INT((month - 2) * 30.59)
JD = JD + 1721088
JD = JD + day
DIM t = second / 3600
t = t + minute / 60
t = t + hour
t = t / 24
JD = JD + t
RESULT = JD
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結果
2020/5/7使用関数
参考文献
関連記事
- ARCCOS関数 (スクリプト関数)
- 引数の逆余弦を求めます。
- CEIL関数 (スクリプト関数)
- 正の値へ切り上げた数値を返します。
- EXP関数 (スクリプト関数)
- 自然指数関数（\(y=e^{x}\)）を求める。
- LN関数 (スクリプト関数)
- 自然対数（\(\log_e{x}\)）を求める。
- LOGN関数 (スクリプト関数)
- Baseを底とするXの対数（\(\log_{Base}{x}\)）を求める。
- ZCUT関数 (スクリプト関数)
- マイナス値は0にして返します。
- fact関数 (自作関数)
- 引数に指定した数値の階乗を求めます。
- ARCSIN関数 (スクリプト関数)
- 引数の逆正弦を求めます。
- INT関数 (スクリプト関数)
- 小数点以下を切り落とした数値を返します。
- isOdd関数 (自作関数)
- 奇数かどうか調べます。