1. マウス

マウスカーソルを指定した座標に移動します。MMV関数でカーソルを移動させ続けてもWindowsのスリープ防止にはならないので注意してください。

構文

1. void = MMV( x, y, ms )

引数

x （Integer）必須

位置

y （Integer）必須

位置

ms （Single = 0）省略可

実行までの待ち時間 （ミリセカンド）

戻り値

カーソル移動を滑らかにする

使い方

1. 画像image.bmpが見つかったらその場所にカーソルを移動する。

   UWSC

   CopyIF CHKIMG("image.bmp",,,,,, -1) THEN MMV(G_IMG_X, G_IMG_Y)

2. 円を描く。

   UWSC

   CopyDIM a = G_SCREEN_W / 2 DIM b = G_SCREEN_H / 2 DIM r = 100 FOR theta = 0 TO 360 DIM x = a + r * COS(degToRad(theta)) DIM y = b + r * SIN(degToRad(theta)) MMV(x, y) SLEEP(0.001) NEXT ////////////////////////////////////////////////// // 【引数】 // 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 // digits : 変換する2進数の桁数合わせを自動で行うかを示すブール値、もしくは桁数を表す数値（8,16,24,32,64のいずれか）を指定 // 【戻り値】 // 10進数に変換した値 ////////////////////////////////////////////////// FUNCTION binToDec(bin, signFlg = TRUE, digits = TRUE) DIM dec = 0 DIM decimalFlg = IIF(POS(".", bin), TRUE, FALSE) // 桁合わせ IFB digits THEN IFB decimalFlg THEN keta = LENGTH(COPY(bin, POS(".", bin) + 1)) MOD 4 IF keta <> 0 THEN bin = bin + strRepeat("0", 4 - keta) ENDIF DIM nums[] = 8, 16, 24, 32, 64 FOR num IN nums IFB LENGTH(REPLACE(bin, ".", "")) <= num THEN bin = strPad(bin, num + decimalFlg, "0", LEFT) BREAK ENDIF NEXT ENDIF IFB COPY(bin, 1, 1) = "1" AND signFlg THEN DIM msb = VAL(IIF(decimalFlg, POS(".", bin) - 1, LENGTH(bin))) DIM lsb = VAL(IIF(decimalFlg, POS(".", bin) - LENGTH(bin), 0)) DIM dec2 = Decimal.minus(Decimal.toPower(2, msb), 1) FOR i = -1 TO lsb STEP -1 dec2 = Decimal.plus(dec2, Decimal.toPower(2, i)) NEXT DIM a = binToDec(bin, FALSE) DIM b = dec2 dec = Decimal.times("-1", Decimal.plus(bitXor(a, b), Decimal.toPower(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) WITH Decimal dec = .plus(dec, .times(COPY(integer, i, 1), .toPower(2, LENGTH(integer) - i))) ENDWITH 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) IFB arg1 = arg2 THEN RESULT = 0 EXIT ENDIF DIM args[1] = arg1, arg2 DIM bins[1] DIM decimals[1] DIM integers[1] DIM keta[1] 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 modulo = 1 PUBLIC toExpNeg = -7 PUBLIC toExpPos = 21 PUBLIC minE = -9E+15 PUBLIC maxE = 9E+15 PUBLIC quadrant = EMPTY DIM inexact = FALSE 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 CONST ROUND_UP = 0 CONST ROUND_DOWN = 1 CONST ROUND_CEIL = 2 CONST ROUND_FLOOR = 3 CONST ROUND_HALF_UP = 4 CONST ROUND_HALF_DOWN = 5 CONST ROUND_HALF_EVEN = 6 CONST ROUND_HALF_CEIL = 7 CONST ROUND_HALF_FLOOR = 8 CONST EUCLID = 9 DIM external = TRUE DIM cacheFlg = 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(x[1] > y[1] XOR 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 <> "" THEN IFB COPY(n, 2) AND COPY(n, 1) = "5" THEN // Truncate to the first rounding digit. finalise(r, e + 1, 1) m = !eq(times(times(r, r), r), x) ENDIF 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, isNumeric = FALSE) RESULT = divide(dividend, divisor) 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 filename = Hash.sha256("minus,minuend=" + toString(x) + ",subtrahend=" + toString(y) + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND FOPEN(path, F_EXISTS) THEN DIM FID = FOPEN(path, F_READ) str = VARTYPE(FGET(FID, 1), 258) RESULT = Constructor(str) IF isNumeric = NULL THEN EXIT RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) FCLOSE(FID) ELSE 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] 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) ELSE RESULT = SLICE(y) ENDIF 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 filename = Hash.sha256("plus,augend=" + toString(x) + ",addend=" + toString(y) + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND FOPEN(path, F_EXISTS) THEN DIM FID = FOPEN(path, F_READ) str = VARTYPE(FGET(FID, 1), 258) RESULT = Constructor(str) IF isNumeric = NULL THEN EXIT RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) FCLOSE(FID) ELSE 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) EXIT ENDIF // Calculate base 1e7 exponents. 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) IFB i > len THEN i = len RESIZE(d, 1) ENDIF // 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) ELSE RESULT = SLICE(y) ENDIF 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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) 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 filename = Hash.sha256("times,multiplicand=" + toString(x) + ",multiplier=" + toString(y) + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND FOPEN(path, F_EXISTS) THEN DIM FID = FOPEN(path, F_READ) str = VARTYPE(FGET(FID, 1), 258) RESULT = Constructor(str) IF isNumeric = NULL THEN EXIT RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) FCLOSE(FID) ELSE 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) ELSE RESULT = SLICE(y) ENDIF 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 filename = Hash.sha256("toPower,exponent=" + exponent + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND FOPEN(path, F_EXISTS) THEN DIM FID = FOPEN(path, F_READ) str = VARTYPE(FGET(FID, 1), 258) RESULT = Constructor(str) IF isNumeric = NULL THEN EXIT RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) FCLOSE(FID) ELSE 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) RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) 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) IFB VAL(y[0]) < 0 THEN RESULT = dividedBy("1", r) ELSE RESULT = toString(finalise(r, pr, rm)) // RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) ENDIF // 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) ENDIF 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 TEXTBLOCK FUNCTION divide(dividend, divisor, pr = 20, rm = 4, dp = NULL, _base = NULL, isNumeric = FALSE) RESULT = dividedBy(dividend, divisor, pr, rm, dp, _base, isNumeric) FEND ENDTEXTBLOCK FUNCTION div(dividend, divisor, pr = 20, rm = 4, dp = NULL, _base = NULL, isNumeric = FALSE) RESULT = divide(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 IFB 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 divide(dividend, divisor, pr = NULL, rm = NULL, dp = NULL, radix = 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 radix <> NULL THEN logBase = 1 e = x[1] - y[1] ELSE radix = 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 * radix + 0 ELSE t = k * radix + 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 * radix + 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 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 IFB rm < 4 THEN roundUp = (VARTYPE(rd, VAR_BOOLEAN) OR VARTYPE(isTruncated, VAR_BOOLEAN)) AND (rm = 0 OR VARTYPE(rm = IIF(x[0] < 0, 3, 2), VAR_BOOLEAN)) ELSE roundUp1 = rd > 5 roundUp2 = rd = 5 roundUp3 = rm = 4 roundUp4 = isTruncated roundUp5 = rm = 6 roundUp6 = VARTYPE(bitAnd("" + tmp, "1"), VAR_BOOLEAN) roundUp7= (rm = IIF(x[0] < 8, 8, 7)) roundUp = (roundUp1 OR roundUp2 AND (roundUp3 OR roundUp4 OR roundUp5 AND roundUp6 OR roundUp7)) ENDIF TEXTBLOCK IFB rm < 4 THEN roundUp = (VARTYPE(rd, VAR_BOOLEAN) OR VARTYPE(isTruncated, VAR_BOOLEAN)) AND (rm = 0 OR VARTYPE(rm = IIF(x[0] < 0, 3, 2), VAR_BOOLEAN)) ELSE roundUp = 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) _ ) ENDIF ENDTEXTBLOCK TEXTBLOCK 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) _ ) _ ) ENDTEXTBLOCK 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, 2) x[1] = NULL x[2] = FALSE RESULT = SLICE(x) EXIT // Underflow? ELSEIF x[1] < minE THEN RESIZE(x, 2) x[1] = 0 x[2] = 0 RESULT = SLICE(x) EXIT 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, NULL) 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, NULL) 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[1] = NULL x[2] = FALSE // 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 quotient(dividend, divisor) WITH Decimal RESULT = (dividend - (.modulo(dividend, divisor))) / divisor ENDWITH 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) // 64bitを超えてエラー判定になるので例外処理 IFB dec = "-9223372036854775808" THEN RESULT = "1000000000000000000000000000000000000000000000000000000000000000" EXIT ENDIF // 負数で符号なしならばエラー値を返す IFB Decimal.lessThan(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 = !Decimal.isInteger(dec) DIM negativeFlg = Decimal.isNegative(dec) dec = Decimal.absoluteValue(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 = Decimal.modulo(integer, 2) + bin integer = Decimal.truncated(Decimal.dividedBy(integer, 2)) UNTIL Decimal.eq(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 = .precision .precision = 25 RESULT = .times(deg, .dividedBy(Decimal.PI, "180")) .precision = 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 ////////////////////////////////////////////////// // 【引数】 // variable : 型を調べる変数 // 【戻り値】 // : TRUE : 与えられた変数がブール型である、 // FALSE : 与えられた変数がブール型でない、 : ////////////////////////////////////////////////// FUNCTION isBoolean(variable) RESULT = IIF(VARTYPE(variable) = VAR_BOOLEAN, 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 isInt(variable) IFB VAL(variable) <> ERR_VALUE AND !isBoolean(variable) AND !isString(variable) THEN RESULT = IIF(variable - INT(variable) = 0, TRUE, FALSE) ELSE RESULT = FALSE ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // variable : 型を調べる変数 // 【戻り値】 // : TRUE : 与えられた変数が文字列型である、 // FALSE : 与えられた変数が文字列型でない、 : ////////////////////////////////////////////////// FUNCTION isString(variable) RESULT = IIF(VARTYPE(variable) = VAR_ASTR OR VARTYPE(variable) = VAR_USTR, TRUE, FALSE) FEND ////////////////////////////////////////////////// // 【引数】 // text : JSONとして解析する文字列 // value : JSON文字列に変換する値 // reviver : 使用不可 // replacer : 使用不可 // space : 出力するJSON文字列に空白を挿入するための文字列もしくは数値 // 【戻り値】 // : Parse : JSON文字列をオブジェクトに変換、 // Stringify : オブジェクトをJSON文字列に変換、 : ////////////////////////////////////////////////// MODULE JSON DIM SC, CodeObject PROCEDURE JSON SC = CREATEOLEOBJ("ScriptControl") WITH SC .Language = "JScript" .ExecuteStatement(json2) .ExecuteStatement(statement) CodeObject = .CodeObject ENDWITH FEND FUNCTION Parse(text, reviver = NULL) RESULT = CodeObject.JSON.parse(text, reviver) FEND FUNCTION Stringify(value, replacer = "", space = FALSE) RESULT = CodeObject.JSON.stringify(value, NULL, replacer) IF space THEN RESULT = REPLACE(RESULT, CHR(10), "<#CR>") FEND ENDMODULE TEXTBLOCK statement Array.prototype.Item = function(i, value){ if(value === undefined) return this[i]; this[i] = value; } Array.prototype.item = Array.prototype.Item; ENDTEXTBLOCK TEXTBLOCK json2 // json2.js // 2023-05-10 // Public Domain. // NO WARRANTY EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK. // USE YOUR OWN COPY. IT IS EXTREMELY UNWISE TO LOAD CODE FROM SERVERS YOU DO // NOT CONTROL. // This file creates a global JSON object containing two methods: stringify // and parse. This file provides the ES5 JSON capability to ES3 systems. // If a project might run on IE8 or earlier, then this file should be included. // This file does nothing on ES5 systems. // JSON.stringify(value, replacer, space) // value any JavaScript value, usually an object or array. // replacer an optional parameter that determines how object // values are stringified for objects. It can be a // function or an array of strings. // space an optional parameter that specifies the indentation // of nested structures. If it is omitted, the text will // be packed without extra whitespace. If it is a number, // it will specify the number of spaces to indent at each // level. If it is a string (such as "\t" or " "), // it contains the characters used to indent at each level. // This method produces a JSON text from a JavaScript value. // When an object value is found, if the object contains a toJSON // method, its toJSON method will be called and the result will be // stringified. A toJSON method does not serialize: it returns the // value represented by the name/value pair that should be serialized, // or undefined if nothing should be serialized. The toJSON method // will be passed the key associated with the value, and this will be // bound to the value. // For example, this would serialize Dates as ISO strings. // Date.prototype.toJSON = function (key) { // function f(n) { // // Format integers to have at least two digits. // return (n < 10) // ? "0" + n // : n; // } // return this.getUTCFullYear() + "-" + // f(this.getUTCMonth() + 1) + "-" + // f(this.getUTCDate()) + "T" + // f(this.getUTCHours()) + ":" + // f(this.getUTCMinutes()) + ":" + // f(this.getUTCSeconds()) + "Z"; // }; // You can provide an optional replacer method. It will be passed the // key and value of each member, with this bound to the containing // object. The value that is returned from your method will be // serialized. If your method returns undefined, then the member will // be excluded from the serialization. // If the replacer parameter is an array of strings, then it will be // used to select the members to be serialized. It filters the results // such that only members with keys listed in the replacer array are // stringified. // Values that do not have JSON representations, such as undefined or // functions, will not be serialized. Such values in objects will be // dropped; in arrays they will be replaced with null. You can use // a replacer function to replace those with JSON values. // JSON.stringify(undefined) returns undefined. // The optional space parameter produces a stringification of the // value that is filled with line breaks and indentation to make it // easier to read. // If the space parameter is a non-empty string, then that string will // be used for indentation. If the space parameter is a number, then // the indentation will be that many spaces. // Example: // text = JSON.stringify(["e", {pluribus: "unum"}]); // // text is '["e",{"pluribus":"unum"}]' // text = JSON.stringify(["e", {pluribus: "unum"}], null, "\t"); // // text is '[\n\t"e",\n\t{\n\t\t"pluribus": "unum"\n\t}\n]' // text = JSON.stringify([new Date()], function (key, value) { // return this[key] instanceof Date // ? "Date(" + this[key] + ")" // : value; // }); // // text is '["Date(---current time---)"]' // JSON.parse(text, reviver) // This method parses a JSON text to produce an object or array. // It can throw a SyntaxError exception. // The optional reviver parameter is a function that can filter and // transform the results. It receives each of the keys and values, // and its return value is used instead of the original value. // If it returns what it received, then the structure is not modified. // If it returns undefined then the member is deleted. // Example: // // Parse the text. Values that look like ISO date strings will // // be converted to Date objects. // myData = JSON.parse(text, function (key, value) { // var a; // if (typeof value === "string") { // a = // /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2}(?:\.\d*)?)Z$/.exec(value); // if (a) { // return new Date(Date.UTC( // +a[1], +a[2] - 1, +a[3], +a[4], +a[5], +a[6] // )); // } // return value; // } // }); // myData = JSON.parse( // "[\"Date(09/09/2001)\"]", // function (key, value) { // var d; // if ( // typeof value === "string" // && value.slice(0, 5) === "Date(" // && value.slice(-1) === ")" // ) { // d = new Date(value.slice(5, -1)); // if (d) { // return d; // } // } // return value; // } // ); // This is a reference implementation. You are free to copy, modify, or // redistribute. /*jslint eval, for, this */ /*property JSON, apply, call, charCodeAt, getUTCDate, getUTCFullYear, getUTCHours, getUTCMinutes, getUTCMonth, getUTCSeconds, hasOwnProperty, join, lastIndex, length, parse, prototype, push, replace, slice, stringify, test, toJSON, toString, valueOf */ // Create a JSON object only if one does not already exist. We create the // methods in a closure to avoid creating global variables. if (typeof JSON !== "object") { JSON = {}; } (function () { "use strict"; var rx_one = /^[\],:{}\s]*$/; var rx_two = /\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g; var rx_three = /"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g; var rx_four = /(?:^|:|,)(?:\s*\[)+/g; var rx_escapable = /[\\"\u0000-\u001f\u007f-\u009f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g; var rx_dangerous = /[\u0000\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g; function f(n) { // Format integers to have at least two digits. return (n < 10) ? "0" + n : n; } function this_value() { return this.valueOf(); } if (typeof Date.prototype.toJSON !== "function") { Date.prototype.toJSON = function () { return isFinite(this.valueOf()) ? ( this.getUTCFullYear() + "-" + f(this.getUTCMonth() + 1) + "-" + f(this.getUTCDate()) + "T" + f(this.getUTCHours()) + ":" + f(this.getUTCMinutes()) + ":" + f(this.getUTCSeconds()) + "Z" ) : null; }; Boolean.prototype.toJSON = this_value; Number.prototype.toJSON = this_value; String.prototype.toJSON = this_value; } var gap; var indent; var meta; var rep; function quote(string) { // If the string contains no control characters, no quote characters, and no // backslash characters, then we can safely slap some quotes around it. // Otherwise we must also replace the offending characters with safe escape // sequences. rx_escapable.lastIndex = 0; return rx_escapable.test(string) ? "\"" + string.replace(rx_escapable, function (a) { var c = meta[a]; return typeof c === "string" ? c : "\\u" + ("0000" + a.charCodeAt(0).toString(16)).slice(-4); }) + "\"" : "\"" + string + "\""; } function str(key, holder) { // Produce a string from holder[key]. var i; // The loop counter. var k; // The member key. var v; // The member value. var length; var mind = gap; var partial; var value = holder[key]; // If the value has a toJSON method, call it to obtain a replacement value. if ( value && typeof value === "object" && typeof value.toJSON === "function" ) { value = value.toJSON(key); } // If we were called with a replacer function, then call the replacer to // obtain a replacement value. if (typeof rep === "function") { value = rep.call(holder, key, value); } // What happens next depends on the value's type. switch (typeof value) { case "string": return quote(value); case "number": // JSON numbers must be finite. Encode non-finite numbers as null. return (isFinite(value)) ? String(value) : "null"; case "boolean": case "null": // If the value is a boolean or null, convert it to a string. Note: // typeof null does not produce "null". The case is included here in // the remote chance that this gets fixed someday. return String(value); // If the type is "object", we might be dealing with an object or an array or // null. case "object": // Due to a specification blunder in ECMAScript, typeof null is "object", // so watch out for that case. if (!value) { return "null"; } // Make an array to hold the partial results of stringifying this object value. gap += indent; partial = []; // Is the value an array? if (Object.prototype.toString.apply(value) === "[object Array]") { // The value is an array. Stringify every element. Use null as a placeholder // for non-JSON values. length = value.length; for (i = 0; i < length; i += 1) { partial[i] = str(i, value) || "null"; } // Join all of the elements together, separated with commas, and wrap them in // brackets. v = partial.length === 0 ? "[]" : gap ? ( "[\n" + gap + partial.join(",\n" + gap) + "\n" + mind + "]" ) : "[" + partial.join(",") + "]"; gap = mind; return v; } // If the replacer is an array, use it to select the members to be stringified. if (rep && typeof rep === "object") { length = rep.length; for (i = 0; i < length; i += 1) { if (typeof rep[i] === "string") { k = rep[i]; v = str(k, value); if (v) { partial.push(quote(k) + ( (gap) ? ": " : ":" ) + v); } } } } else { // Otherwise, iterate through all of the keys in the object. for (k in value) { if (Object.prototype.hasOwnProperty.call(value, k)) { v = str(k, value); if (v) { partial.push(quote(k) + ( (gap) ? ": " : ":" ) + v); } } } } // Join all of the member texts together, separated with commas, // and wrap them in braces. v = partial.length === 0 ? "{}" : gap ? "{\n" + gap + partial.join(",\n" + gap) + "\n" + mind + "}" : "{" + partial.join(",") + "}"; gap = mind; return v; } } // If the JSON object does not yet have a stringify method, give it one. if (typeof JSON.stringify !== "function") { meta = { // table of character substitutions "\b": "\\b", "\t": "\\t", "\n": "\\n", "\f": "\\f", "\r": "\\r", "\"": "\\\"", "\\": "\\\\" }; JSON.stringify = function (value, replacer, space) { // The stringify method takes a value and an optional replacer, and an optional // space parameter, and returns a JSON text. The replacer can be a function // that can replace values, or an array of strings that will select the keys. // A default replacer method can be provided. Use of the space parameter can // produce text that is more easily readable. var i; gap = ""; indent = ""; // If the space parameter is a number, make an indent string containing that // many spaces. if (typeof space === "number") { for (i = 0; i < space; i += 1) { indent += " "; } // If the space parameter is a string, it will be used as the indent string. } else if (typeof space === "string") { indent = space; } // If there is a replacer, it must be a function or an array. // Otherwise, throw an error. rep = replacer; if (replacer && typeof replacer !== "function" && ( typeof replacer !== "object" || typeof replacer.length !== "number" )) { throw new Error("JSON.stringify"); } // Make a fake root object containing our value under the key of "". // Return the result of stringifying the value. return str("", {"": value}); }; } // If the JSON object does not yet have a parse method, give it one. if (typeof JSON.parse !== "function") { JSON.parse = function (text, reviver) { // The parse method takes a text and an optional reviver function, and returns // a JavaScript value if the text is a valid JSON text. var j; function walk(holder, key) { // The walk method is used to recursively walk the resulting structure so // that modifications can be made. var k; var v; var value = holder[key]; if (value && typeof value === "object") { for (k in value) { if (Object.prototype.hasOwnProperty.call(value, k)) { v = walk(value, k); if (v !== undefined) { value[k] = v; } else { delete value[k]; } } } } return reviver.call(holder, key, value); } // Parsing happens in four stages. In the first stage, we replace certain // Unicode characters with escape sequences. JavaScript handles many characters // incorrectly, either silently deleting them, or treating them as line endings. text = String(text); rx_dangerous.lastIndex = 0; if (rx_dangerous.test(text)) { text = text.replace(rx_dangerous, function (a) { return ( "\\u" + ("0000" + a.charCodeAt(0).toString(16)).slice(-4) ); }); } // In the second stage, we run the text against regular expressions that look // for non-JSON patterns. We are especially concerned with "()" and "new" // because they can cause invocation, and "=" because it can cause mutation. // But just to be safe, we want to reject all unexpected forms. // We split the second stage into 4 regexp operations in order to work around // crippling inefficiencies in IE's and Safari's regexp engines. First we // replace the JSON backslash pairs with "@" (a non-JSON character). Second, we // replace all simple value tokens with "]" characters. Third, we delete all // open brackets that follow a colon or comma or that begin the text. Finally, // we look to see that the remaining characters are only whitespace or "]" or // "," or ":" or "{" or "}". If that is so, then the text is safe for eval. if ( rx_one.test( text .replace(rx_two, "@") .replace(rx_three, "]") .replace(rx_four, "") ) ) { // In the third stage we use the eval function to compile the text into a // JavaScript structure. The "{" operator is subject to a syntactic ambiguity // in JavaScript: it can begin a block or an object literal. We wrap the text // in parens to eliminate the ambiguity. j = eval("(" + text + ")"); // In the optional fourth stage, we recursively walk the new structure, passing // each name/value pair to a reviver function for possible transformation. return (typeof reviver === "function") ? walk({"": j}, "") : j; } // If the text is not JSON parseable, then a SyntaxError is thrown. throw new SyntaxError("JSON.parse"); }; } }()); ENDTEXTBLOCK ////////////////////////////////////////////////// // 【引数】 // array : 配列 // rank : 抽出する値の大きい方から数えた順位 // 【戻り値】 ////////////////////////////////////////////////// FUNCTION large(array[], rank) IFB rank >= 1 AND rank <= LENGTH(array) THEN shellSort(array) RESULT = array[LENGTH(array) - rank] ELSE RESULT = ERR_VALUE ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // str : 正規表現による検索の対象となる文字列 // Pattern : 正規表現で使用するパターンを設定 // IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse // Global : 文字列全体を検索する場合はTrue、しない場合はFalse // 【戻り値】 // 正規表現で検索した結果をMatchesコレクションとして返します。 ////////////////////////////////////////////////// FUNCTION reExecute(str, Pattern, IgnoreCase = TRUE, Global = TRUE) DIM re = CREATEOLEOBJ("VBScript.RegExp") re.Pattern = Pattern re.IgnoreCase = IgnoreCase re.Global = Global RESULT = re.Execute(str) FEND ////////////////////////////////////////////////// // 【引数】 // str : 正規表現による検索の対象となる文字列 // Pattern : 正規表現で使用するパターンを設定 // IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse // Global : 文字列全体を検索する場合はTrue、しない場合はFalse // 【戻り値】 // 正規表現にマッチするかどうかを示すブール値 ////////////////////////////////////////////////// FUNCTION reTest(str, Pattern, IgnoreCase = TRUE, Global = TRUE) DIM re = CREATEOLEOBJ("VBScript.RegExp") re.Pattern = Pattern re.IgnoreCase = IgnoreCase re.Global = Global RESULT = re.Test(str) FEND ////////////////////////////////////////////////// // 【引数】 // num : 数値 // digit : 四捨五入する位置（マイナスで整数方向） // 【戻り値】 // 四捨五入した値 ////////////////////////////////////////////////// FUNCTION roundOff(num, digit = 0) DIM sign = sign(num) num = ABS(num) DIM offset = POWER(10, digit) DIM n = num * offset - INT(num * offset) RESULT = sign * IIF(n >= 0.5, CEIL(num * offset) / offset, INT(num * offset) / offset) FEND ////////////////////////////////////////////////// // 【引数】 // serial : 時間を表すシリアル値を指定 // 【戻り値】 ////////////////////////////////////////////////// FUNCTION Second(serial) RESULT = REPLACE(FORMAT(INT(serial * 86400) MOD 60, 2), " ", "0") FEND ////////////////////////////////////////////////// // 【引数】 // array : ソートする数値を格納した配列。参照引数。 // 【戻り値】 ////////////////////////////////////////////////// PROCEDURE shellSort(Var array[]) DIM i, j, inc, temp inc = 4 WHILE INT(inc) > 0 FOR i = 0 TO UBound(array) j = i temp = array[i] WHILE j >= inc AND array[zcut(j-inc)] > temp array[j] = array[j-inc] j = j - inc WEND array[j] = temp NEXT IFB inc / 2 <> 0 THEN inc = inc / 2 ELSEIF inc = 1 THEN inc = 0 ELSE inc = 1 ENDIF WEND FEND ////////////////////////////////////////////////// // 【引数】 // num : 符号を求める数値 // 【戻り値】 // 1 : 正の数、0 : ゼロ、-1 : 負の数、ERR_VALUE : それ以外 ////////////////////////////////////////////////// FUNCTION sign(num) SELECT TRUE CASE !CHKNUM(num) RESULT = ERR_VALUE CASE num > 0 RESULT = 1 CASE num = 0 RESULT = 0 CASE num < 0 RESULT = -1 SELEND FEND ////////////////////////////////////////////////// // 【引数】 // array : 配列 // rank : 抽出する値の小さい方から数えた順位 // 【戻り値】 ////////////////////////////////////////////////// FUNCTION small(array[], rank) IFB rank >= 1 AND rank <= LENGTH(array) THEN shellSort(array) RESULT = array[rank-1] ELSE RESULT = ERR_VALUE ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // input : 入力文字列 // length : 埋めたあとの長さ // str : 埋める文字 // type : 埋める方向 // 【戻り値】 // 指定文字で埋めた文字列 ////////////////////////////////////////////////// FUNCTION strPad(input, length, str = " ", type = RIGHT) DIM s = "" SELECT type CASE LEFT FOR i = 1 TO CEIL((length - LENGTH(input)) / LENGTH(str)) s = s + str NEXT input = COPY(s, 1, length - LENGTH(input)) + input CASE RIGHT FOR i = 1 TO CEIL((length - LENGTH(input)) / LENGTH(str)) s = s + str NEXT input = input + COPY(s, 1, length - LENGTH(input)) SELEND RESULT = input FEND ////////////////////////////////////////////////// // 【引数】 // inputs : 繰り返す文字列 // multiplier : inputsを繰り返す回数 // 【戻り値】 // inputsをmultiplier回を繰り返した文字列を返します ////////////////////////////////////////////////// FUNCTION strRepeat(inputs, multiplier) DIM res = "" FOR n = 1 TO multiplier res = res + inputs NEXT RESULT = res FEND ////////////////////////////////////////////////// // 【引数】 // a : bと交換する値。参照引数。 // b : aと交換する値。参照引数。 // 【戻り値】 ////////////////////////////////////////////////// PROCEDURE swap(Var a, Var b) DIM tmp = a a = b b = tmp FEND ////////////////////////////////////////////////// // 【引数】 // serial : シリアル値 // format : フォーマット // 【戻り値】 // 数値を表示書式に基づいて変換した文字列 ////////////////////////////////////////////////// FUNCTION text(serial, format, hour12 = FALSE) HASHTBL startDate startDate["明治"] = "1868/01/25" startDate["大正"] = "1912/07/30" startDate["昭和"] = "1926/12/25" startDate["平成"] = "1989/01/08" startDate["令和"] = "2019/05/01" DIM baseDate = "1899/12/30" serial = VAL(serial) SELECT TRUE CASE reTest(format, "\[h+\]") Matches = reExecute(format, "\[(h+)\]") DIM hour = iif(hour12, Hour(serial) MOD 12, Hour(serial)) RESULT = text(hour, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0)))) CASE reTest(format, "^h+$") Matches = reExecute(format, "^(h+)$") hour = iif(hour12, Hour(serial) MOD 12, Hour(serial)) RESULT = text(hour MOD 24, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0)))) CASE reTest(format, "\[m+\]") Matches = reExecute(format, "\[(m+)\]") RESULT = text(serial * 1440, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0)))) CASE format = "m" GETTIME(serial, baseDate) RESULT = text(G_TIME_MM, "0") CASE format = "mm" GETTIME(serial, baseDate) RESULT = G_TIME_MM2 CASE format = "n" GETTIME(serial, baseDate) RESULT = G_TIME_NN CASE format = "nn" GETTIME(serial, baseDate) RESULT = G_TIME_NN2 CASE format = "s" GETTIME(serial, baseDate) RESULT = text(G_TIME_SS, "0") CASE format = "ss" GETTIME(serial, baseDate) RESULT = G_TIME_SS2 CASE format = "yyyy" GETTIME(serial, baseDate) RESULT = G_TIME_YY4 CASE format = "yy" GETTIME(serial, baseDate) RESULT = COPY(G_TIME_YY4, 3, 2) CASE format = "e" SELECT TRUE CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(serial, "yyyy") - 2018 CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(serial, "yyyy") - 1988 CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(serial, "yyyy") - 1925 CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(serial, "yyyy") - 1911 CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(serial, "yyyy") - 1867 SELEND CASE format = "ee" SELECT TRUE CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(text(serial, "yyyy") - 2018, "00") CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(text(serial, "yyyy") - 1988, "00") CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(text(serial, "yyyy") - 1925, "00") CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(text(serial, "yyyy") - 1911, "00") CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(text(serial, "yyyy") - 1867, "00") SELEND CASE format = "g" SELECT TRUE CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "R" CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "H" CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "S" CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "T" CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "M" SELEND CASE format = "gg" RESULT = COPY(text(serial, "ggg"), 1, 1) CASE format = "ggg" SELECT TRUE CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "令和" CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "平成" CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "昭和" CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "大正" CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "明治" SELEND CASE format = "mmmmm" RESULT = COPY(text(serial, "mmmm"), 1, 1) CASE format = "mmmm" DIM month[] = "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December" RESULT = month[text(serial, "m") - 1] CASE format = "mmm" RESULT = COPY(text(serial, "mmmm"), 1, 3) CASE format = "dd" GETTIME(serial, baseDate) RESULT = text(G_TIME_DD2, "00") CASE format = "d" GETTIME(serial, baseDate) RESULT = text(G_TIME_DD, "0") CASE reTest(format, "^[ad]{3,4}$") Matches = reExecute(format, "([ad]{3,4})") GETTIME(serial, baseDate) DIM aaa[] = "日", "月", "火", "水", "木", "金", "土" DIM aaaa[] = "日曜日", "月曜日", "火曜日", "水曜日", "木曜日", "金曜日", "土曜日" DIM ddd[] = "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" DIM dddd[] = "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" RESULT = EVAL(Matches.Item(0).SubMatches(0) + "[" + getWeekday(G_TIME_WW, 1) + "]") CASE reTest(format, "(0+\.?0+)?%") Matches = reExecute(format, "(0+\.?0+)?%") RESULT = text(serial * 100, Matches.Item(0).SubMatches(0)) + "%" CASE reTest(format, "^\[DBNum\d{1,4}\](.*?)$") Matches = reExecute(format, "^\[DBNum(\d{1,4})\](.*?)$") DIM value = VAL(Matches.Item(0).SubMatches(0)) DIM sss = text(serial, Matches.Item(0).SubMatches(1)) Matches = reExecute(sss, "(\D+)?(\d+)(\D+)?") DIM res = "" FOR m = 0 TO Matches.Count - 1 serial = Matches.Item(m).SubMatches(1) SELECT value CASE 1, 2 DIM n[][9] = "〇", "一", "二", "三", "四", "五", "六", "七", "八", "九", _ "", "壱", "弐", "参", "四", "伍", "六", "七", "八", "九" DIM a[][3] = "", "十", "百", "千", _ "", "拾", "百", "阡" DIM b[][3] = "", "万", "億", "兆", _ "", "萬", "億", "兆" DIM r = "" DIM j = 0 type = value - 1 REPEAT DIM str = "" DIM n4 = serial MOD 10000 FOR i = LENGTH(n4) TO 1 STEP -1 s = COPY(n4, i, 1) IFB s = 1 AND a[type][LENGTH(n4)-i] <> "" THEN str = IIF(s, a[type][LENGTH(n4)-i], "") + str ELSE str = n[type][s] + IIF(s, a[type][LENGTH(n4)-i], "") + str ENDIF NEXT IF str <> "" THEN r = str + b[type][j] + r j = j + 1 serial = INT(serial / 10000) UNTIL serial = 0 res = res + Matches.Item(m).SubMatches(0) + r + Matches.Item(m).SubMatches(2) CASE 3 res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_FULLWIDTH) + Matches.Item(m).SubMatches(2) CASE 4 res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_HALFWIDTH) + Matches.Item(m).SubMatches(2) SELEND NEXT RESULT = res CASE reTest(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$") Matches = reExecute(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$") DIM array = SPLIT(Matches.Item(0).SubMatches(1), "/") ampm = array[IIF(serial - INT(serial) >= 0.5, 1, 0)] hour12 = TRUE res = "" WITH Matches.Item(0) res = text(serial, .SubMatches(0), hour12) + ampm + text(serial, .SubMatches(2), hour12) ENDWITH RESULT = res CASE reTest(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?") Matches = reExecute(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?") FOR n = 0 TO Matches.Count - 1 IF n = 0 THEN res = Matches.Item(n).SubMatches(0) NEXT FOR n = 0 TO Matches.Count - 1 WITH Matches.Item(n) res = res + text(serial, .SubMatches(1), hour12) + .SubMatches(3) ENDWITH NEXT RESULT = res CASE format = "0/0" DIM separator = POS(".", serial) DIM g = 0 IFB separator <> 0 THEN DIM keta = LENGTH(serial) DIM shift = POWER(10, keta - separator) IFB shift >= POWER(10, 15) THEN DIM position = 0 FOR i = 0 TO 14 IFB serial * POWER(10, i) - serial >= 1 THEN position = i BREAK ENDIF NEXT tmp = serial * POWER(10, position) FOR i = 1 TO 15 r = (tmp * POWER(10, i)) / serial - (tmp / serial) a1 = tmp * POWER(10, i) - tmp IF a1 = INT(a1) THEN BREAK NEXT DIM frac[] = a1, r g = GCD(frac) RESULT = (a1/g) + "/" + (r/g) ELSE DIM molecule = serial * shift // 分子 DIM denominator = shift // 分母 DIM nums[] = molecule, denominator g = GCD(nums) molecule = molecule / g denominator = denominator / g RESULT = molecule + "/" + denominator ENDIF ELSE RESULT = serial + "/1" ENDIF CASE reTest(format, "(0+)\.?(0+)?") AND UBound(SPLIT(format, ".")) <= 1 Matches = reExecute(format, "(0+)\.?(0+)?") len1 = LENGTH(Matches.Item(0).SubMatches(0)) len2 = LENGTH(Matches.Item(0).SubMatches(1)) DIM arr[] = LENGTH(INT(serial)), len1 IFB POS(".", format) THEN RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX) + len2 + 1, len2), " ", "0") ELSE RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX)), " ", "0") ENDIF SELEND FEND ////////////////////////////////////////////////// // 【引数】 // str : 時刻文字列。hh:nn:ss AM/PM、hh:nn AM/PM、hh AM/PM、hh:nn:ss、hh:nn、hh時nn分ss秒、hh時nn分のいずれかの形式を指定。 // 【戻り値】 // シリアル値　（例）0…00:00:00、0.5…12:00:00、0.999988425925926…23:59:59 ////////////////////////////////////////////////// FUNCTION timeValue(str) DIM serial = 0 DIM Matches DIM pattern = "(\d+)" DIM hh = "(0?[0-9]|1[0-2])" DIM ampm = "([AP]M|[ap]m)" SELECT TRUE CASE reTest(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b") Matches = reExecute(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b") WITH Matches.Item(0) serial = timeValue(.SubMatches(0) + " " + .SubMatches(3)) + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400 ENDWITH CASE reTest(str, "\b" + hh + ":" + pattern + " " + ampm + "\b") Matches = reExecute(str, "\b" + hh + ":" + pattern + " " + ampm + "\b") WITH Matches.Item(0) serial = timeValue(.SubMatches(0) + " " + .SubMatches(2)) + VAL(.SubMatches(1)) / 1440 ENDWITH CASE reTest(str, "\b" + hh + " " + ampm + "\b") Matches = reExecute(str, "\b" + hh + " " + ampm + "\b") WITH Matches.Item(0) serial = VAL(.SubMatches(0) MOD 12) + IIF(reTest(.SubMatches(1), "AM|am"), 0, 12) serial = serial / 24 ENDWITH CASE reTest(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b") Matches = reExecute(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b") WITH Matches.Item(0) serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400 ENDWITH CASE reTest(str, "\b" + pattern + ":" + pattern + "\b") Matches = reExecute(str, "\b" + pattern + ":" + pattern + "\b") WITH Matches.Item(0) serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 ENDWITH CASE reTest(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒") Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒") WITH Matches.Item(0) serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400 ENDWITH CASE reTest(str, "\b" + pattern + "時" + pattern + "分") Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分") WITH Matches.Item(0) serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 ENDWITH DEFAULT serial = ERR_VALUE SELEND RESULT = serial - INT(serial) FEND ////////////////////////////////////////////////// // 【引数】 // arrayname : 上限値を求める配列の名前 // dimension : 返す次元を示す整数 // 【戻り値】 // 配列の上限値 ////////////////////////////////////////////////// FUNCTION UBound(arrayname[], dimension = 1) RESULT = EVAL("RESIZE(arrayname" + strRepeat("[0]", dimension - 1) + ")") FEND

3. 見つかった画像の位置をマウスカーソルで示す。

   UWSC

   CopyDIM path = "D:\Desktop\quick.bmp" DIM arr = getBitmap(path) DIM num = CHKIMG(path, -1,,,,, -1) FOR n = 0 TO num - 1 PRINT ALL_IMG_X[n] + ", " + ALL_IMG_Y[n] DIM a = ALL_IMG_X[n] + arr[1] / 2 DIM b = ALL_IMG_Y[n] + arr[2] / 2 DIM r = 5 FOR theta = 0 TO 360 STEP 10 DIM x = a + r * COS(degToRad(theta)) DIM y = b + r * SIN(degToRad(theta)) MMV(x, y) SLEEP(0.001) NEXT NEXT ////////////////////////////////////////////////// // 【引数】 // 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 // digits : 変換する2進数の桁数合わせを自動で行うかを示すブール値、もしくは桁数を表す数値（8,16,24,32,64のいずれか）を指定 // 【戻り値】 // 10進数に変換した値 ////////////////////////////////////////////////// FUNCTION binToDec(bin, signFlg = TRUE, digits = TRUE) DIM dec = 0 DIM decimalFlg = IIF(POS(".", bin), TRUE, FALSE) // 桁合わせ IFB digits THEN IFB decimalFlg THEN keta = LENGTH(COPY(bin, POS(".", bin) + 1)) MOD 4 IF keta <> 0 THEN bin = bin + strRepeat("0", 4 - keta) ENDIF DIM nums[] = 8, 16, 24, 32, 64 FOR num IN nums IFB LENGTH(REPLACE(bin, ".", "")) <= num THEN bin = strPad(bin, num + decimalFlg, "0", LEFT) BREAK ENDIF NEXT ENDIF IFB COPY(bin, 1, 1) = "1" AND signFlg THEN DIM msb = VAL(IIF(decimalFlg, POS(".", bin) - 1, LENGTH(bin))) DIM lsb = VAL(IIF(decimalFlg, POS(".", bin) - LENGTH(bin), 0)) DIM dec2 = Decimal.minus(Decimal.toPower(2, msb), 1) FOR i = -1 TO lsb STEP -1 dec2 = Decimal.plus(dec2, Decimal.toPower(2, i)) NEXT DIM a = binToDec(bin, FALSE) DIM b = dec2 dec = Decimal.times("-1", Decimal.plus(bitXor(a, b), Decimal.toPower(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) WITH Decimal dec = .plus(dec, .times(COPY(integer, i, 1), .toPower(2, LENGTH(integer) - i))) ENDWITH NEXT ENDIF RESULT = dec FEND ////////////////////////////////////////////////// // 【引数】 // bin : 2進数 // 【戻り値】 // 16進数に変換した値 ////////////////////////////////////////////////// FUNCTION binToHex(bin) HASHTBL bh bh["0000"] = "0"; bh["0001"] = "1"; bh["0010"] = "2"; bh["0011"] = "3" bh["0100"] = "4"; bh["0101"] = "5"; bh["0110"] = "6"; bh["0111"] = "7" bh["1000"] = "8"; bh["1001"] = "9"; bh["1010"] = "A"; bh["1011"] = "B" bh["1100"] = "C"; bh["1101"] = "D"; bh["1110"] = "E"; bh["1111"] = "F" // 小数ならば IFB POS(".", bin) <> 0 THEN DIM num = COPY(bin, 1, POS(".", bin) - 1) DIM frac = COPY(bin, POS(".", bin) + 1) num = strPad(num, CEIL(LENGTH(num) / 4) * 4, "0", LEFT) frac = strPad(frac, CEIL(LENGTH(frac) / 4) * 4, "0", RIGHT) DIM hex = "" FOR i = 1 TO LENGTH(num) STEP 4 hex = hex + bh[COPY(num, i, 4)] NEXT hex = hex + "." FOR i = 1 TO LENGTH(frac) STEP 4 hex = hex + bh[COPY(frac, i, 4)] NEXT RESULT = hex ELSE len = CEIL(LENGTH(bin) / 4) * 4 FOR i = 1 TO len - LENGTH(bin) bin = "0" + bin NEXT bin = REPLACE(FORMAT(bin, len), " ", "0") hex = "" FOR i = 1 TO LENGTH(bin) / 4 str = COPY(bin, i * 4 - 3, 4) hex = hex + bh[str] NEXT RESULT = hex ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // arg1 : 数値1（10進数） // arg2 : 数値2（10進数） // 【戻り値】 // 2つの数値のビット毎の論理積 ////////////////////////////////////////////////// FUNCTION bitAnd(arg1, arg2) DIM args[1] = arg1, arg2 DIM bins[1] DIM decimals[1] DIM integers[1] DIM keta[1] IFB ABS(arg1) <> arg1 OR ABS(arg2) <> arg2 THEN RESULT = ERR_VALUE EXIT ENDIF FOR i = 0 TO 1 bins[i] = decToBin(args[i]) decimals[i] = 0 IFB POS(".", bins[i]) <> 0 THEN integers[i] = COPY(bins[i], 1, POS(".", bins[i]) - 1) decimals[i] = COPY(bins[i], POS(".", bins[i]) + 1) ELSE integers[i] = bins[i] ENDIF NEXT keta[0] = IIF(LENGTH(integers[0]) > LENGTH(integers[1]), LENGTH(integers[0]), LENGTH(integers[1])) integers[0] = strPad(integers[0], keta[0], "0", LEFT) integers[1] = strPad(integers[1], keta[0], "0", LEFT) keta[1] = IIF(LENGTH(decimals[0]) > LENGTH(decimals[1]), LENGTH(decimals[0]), LENGTH(decimals[1])) decimals[0] = strPad(decimals[0], keta[1], "0", RIGHT) decimals[1] = strPad(decimals[1], keta[1], "0", RIGHT) DIM bin = "" FOR i = 1 TO keta[0] bin = bin + (VAL(COPY(integers[0], i, 1)) AND VAL(COPY(integers[1], i, 1))) NEXT bin = bin + "." FOR i = 1 TO keta[1] bin = bin + (VAL(COPY(decimals[0], i, 1)) AND VAL(COPY(decimals[1], i, 1))) NEXT RESULT = binToDec(bin) FEND ////////////////////////////////////////////////// // 【引数】 // num : 10進数もしくは2進数の値 // bit : ビット // 【戻り値】 // ビットを反転した値 ////////////////////////////////////////////////// FUNCTION bitNot(num, bit = EMPTY) IFB isString(num) THEN DIM res = "" FOR i = 1 TO LENGTH(num) DIM str = COPY(num, i, 1) IFB str = "0" OR str = "1" THEN res = res + (1 - VAL(str)) ELSE res = res + str ENDIF NEXT RESULT = res ELSE DIM exponent = IIF(bit = EMPTY, CEIL(LOGN(2, num + 1)), bit) RESULT = POWER(2, exponent) - num - 1 ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // arg1 : 数値1（10進数） // arg2 : 数値2（10進数） // 【戻り値】 // 2つの数値のビット毎の排他的論理和 ////////////////////////////////////////////////// FUNCTION bitXor(arg1, arg2) IFB arg1 = arg2 THEN RESULT = 0 EXIT ENDIF DIM args[1] = arg1, arg2 DIM bins[1] DIM decimals[1] DIM integers[1] DIM keta[1] 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 modulo = 1 PUBLIC toExpNeg = -7 PUBLIC toExpPos = 21 PUBLIC minE = -9E+15 PUBLIC maxE = 9E+15 PUBLIC quadrant = EMPTY DIM inexact = FALSE 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 CONST ROUND_UP = 0 CONST ROUND_DOWN = 1 CONST ROUND_CEIL = 2 CONST ROUND_FLOOR = 3 CONST ROUND_HALF_UP = 4 CONST ROUND_HALF_DOWN = 5 CONST ROUND_HALF_EVEN = 6 CONST ROUND_HALF_CEIL = 7 CONST ROUND_HALF_FLOOR = 8 CONST EUCLID = 9 DIM external = TRUE DIM cacheFlg = 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(x[1] > y[1] XOR 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 <> "" THEN IFB COPY(n, 2) AND COPY(n, 1) = "5" THEN // Truncate to the first rounding digit. finalise(r, e + 1, 1) m = !eq(times(times(r, r), r), x) ENDIF 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, isNumeric = FALSE) RESULT = divide(dividend, divisor) 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 filename = Hash.sha256("minus,minuend=" + toString(x) + ",subtrahend=" + toString(y) + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND FOPEN(path, F_EXISTS) THEN DIM FID = FOPEN(path, F_READ) str = VARTYPE(FGET(FID, 1), 258) RESULT = Constructor(str) IF isNumeric = NULL THEN EXIT RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) FCLOSE(FID) ELSE 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] 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) ELSE RESULT = SLICE(y) ENDIF 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 filename = Hash.sha256("plus,augend=" + toString(x) + ",addend=" + toString(y) + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND FOPEN(path, F_EXISTS) THEN DIM FID = FOPEN(path, F_READ) str = VARTYPE(FGET(FID, 1), 258) RESULT = Constructor(str) IF isNumeric = NULL THEN EXIT RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) FCLOSE(FID) ELSE 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) EXIT ENDIF // Calculate base 1e7 exponents. 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) IFB i > len THEN i = len RESIZE(d, 1) ENDIF // 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) ELSE RESULT = SLICE(y) ENDIF 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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 + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND 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) 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 filename = Hash.sha256("times,multiplicand=" + toString(x) + ",multiplier=" + toString(y) + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND FOPEN(path, F_EXISTS) THEN DIM FID = FOPEN(path, F_READ) str = VARTYPE(FGET(FID, 1), 258) RESULT = Constructor(str) IF isNumeric = NULL THEN EXIT RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) FCLOSE(FID) ELSE 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) ELSE RESULT = SLICE(y) ENDIF 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 filename = Hash.sha256("toPower,exponent=" + exponent + ",precision=" + precision + ",rounding=" + rounding + ",modulo=" + modulo + ",toExpNeg=" + toExpNeg + ",toExpPos=" + toExpPos + ",minE=" + minE + ",maxE=" + maxE) DIM path = folderspec + filename IFB cacheFlg AND FOPEN(path, F_EXISTS) THEN DIM FID = FOPEN(path, F_READ) str = VARTYPE(FGET(FID, 1), 258) RESULT = Constructor(str) IF isNumeric = NULL THEN EXIT RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) FCLOSE(FID) ELSE 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) RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) 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) IFB VAL(y[0]) < 0 THEN RESULT = dividedBy("1", r) ELSE RESULT = toString(finalise(r, pr, rm)) // RESULT = IIF(isNumeric, toNumber(RESULT), toString(RESULT)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) ENDIF // 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)) CreateFolders(folderspec) FID = FOPEN(path, F_READ OR F_WRITE8) FPUT(FID, RESULT) FCLOSE(FID) ENDIF 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 TEXTBLOCK FUNCTION divide(dividend, divisor, pr = 20, rm = 4, dp = NULL, _base = NULL, isNumeric = FALSE) RESULT = dividedBy(dividend, divisor, pr, rm, dp, _base, isNumeric) FEND ENDTEXTBLOCK FUNCTION div(dividend, divisor, pr = 20, rm = 4, dp = NULL, _base = NULL, isNumeric = FALSE) RESULT = divide(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 IFB 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 divide(dividend, divisor, pr = NULL, rm = NULL, dp = NULL, radix = 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 radix <> NULL THEN logBase = 1 e = x[1] - y[1] ELSE radix = 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 * radix + 0 ELSE t = k * radix + 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 * radix + 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 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 IFB rm < 4 THEN roundUp = (VARTYPE(rd, VAR_BOOLEAN) OR VARTYPE(isTruncated, VAR_BOOLEAN)) AND (rm = 0 OR VARTYPE(rm = IIF(x[0] < 0, 3, 2), VAR_BOOLEAN)) ELSE roundUp1 = rd > 5 roundUp2 = rd = 5 roundUp3 = rm = 4 roundUp4 = isTruncated roundUp5 = rm = 6 roundUp6 = VARTYPE(bitAnd("" + tmp, "1"), VAR_BOOLEAN) roundUp7= (rm = IIF(x[0] < 8, 8, 7)) roundUp = (roundUp1 OR roundUp2 AND (roundUp3 OR roundUp4 OR roundUp5 AND roundUp6 OR roundUp7)) ENDIF TEXTBLOCK IFB rm < 4 THEN roundUp = (VARTYPE(rd, VAR_BOOLEAN) OR VARTYPE(isTruncated, VAR_BOOLEAN)) AND (rm = 0 OR VARTYPE(rm = IIF(x[0] < 0, 3, 2), VAR_BOOLEAN)) ELSE roundUp = 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) _ ) ENDIF ENDTEXTBLOCK TEXTBLOCK 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) _ ) _ ) ENDTEXTBLOCK 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, 2) x[1] = NULL x[2] = FALSE RESULT = SLICE(x) EXIT // Underflow? ELSEIF x[1] < minE THEN RESIZE(x, 2) x[1] = 0 x[2] = 0 RESULT = SLICE(x) EXIT 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, NULL) 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, NULL) 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[1] = NULL x[2] = FALSE // 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 quotient(dividend, divisor) WITH Decimal RESULT = (dividend - (.modulo(dividend, divisor))) / divisor ENDWITH 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) // 64bitを超えてエラー判定になるので例外処理 IFB dec = "-9223372036854775808" THEN RESULT = "1000000000000000000000000000000000000000000000000000000000000000" EXIT ENDIF // 負数で符号なしならばエラー値を返す IFB Decimal.lessThan(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 = !Decimal.isInteger(dec) DIM negativeFlg = Decimal.isNegative(dec) dec = Decimal.absoluteValue(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 = Decimal.modulo(integer, 2) + bin integer = Decimal.truncated(Decimal.dividedBy(integer, 2)) UNTIL Decimal.eq(integer, "0") // (3) 10進数（小数部）を2進数に変換する。 IFB decimalFlg THEN bin = bin + "." DIM loop = 0 REPEAT loop = loop + 1 decimal = decimal * 2 bin = bin + IIF(decimal >= 1, "1", "0") IF decimal > 1 THEN decimal = decimal - 1 UNTIL decimal = 1 OR loop > 64 ENDIF // digitsがFALSE以外なら IFB digits THEN // (4) 2進数の桁合わせを行う DIM tmp = bin DIM binInteger = TOKEN(".", tmp) DIM binDecimal = TOKEN(".", tmp) // 整数部、小数部を4bit単位になるまで拡張 // 整数部、4の倍数になるまで整数部の先頭に'0'を追加 IF LENGTH(binInteger) MOD 4 <> 0 THEN binInteger = strRepeat("0", 4 - LENGTH(binInteger) MOD 4) + binInteger // 小数部、4の倍数になるまで小数部の末尾に'0'を追加 IF LENGTH(binDecimal) MOD 4 <> 0 THEN binDecimal = binDecimal + strRepeat("0", 4 - LENGTH(binDecimal) MOD 4) DIM digit = LENGTH(binInteger + binDecimal) // 10進数の場合、一旦自動調整を行う integer = INT(dec) IF signFlg AND COPY(binInteger, 1, 1) = "1" THEN binInteger = strRepeat("0", 4) + binInteger IFB signFlg THEN IFB integer >= -128 AND integer <= 127 THEN // -2^7〜2^7-1 binInteger = strRepeat("0", 8 - LENGTH(binInteger)) + binInteger ELSEIF integer >= -32768 AND integer <= 32767 THEN // -2^15〜2^15-1 binInteger = strRepeat("0", 16 - LENGTH(binInteger)) + binInteger ELSEIF integer >= -8388608 AND integer <= 8388607 THEN // -2^23〜2^23-1 binInteger = strRepeat("0", 24 - LENGTH(binInteger)) + binInteger ELSEIF integer >= -2147783648 AND integer <= 2147483647 THEN // -2^31〜2^31-1 binInteger = strRepeat("0", 32 - LENGTH(binInteger)) + binInteger ELSE binInteger = strRepeat("0", 64 - LENGTH(binInteger)) + binInteger ENDIF ELSE IFB integer <= 255 THEN // 2^8-1 binInteger = strRepeat("0", 8 - LENGTH(binInteger)) + binInteger ELSEIF integer <= 65535 THEN // 2^16-1 binInteger = strRepeat("0", 16 - LENGTH(binInteger)) + binInteger ELSEIF integer <= 16777215 THEN // 2^24-1 binInteger = strRepeat("0", 24 - LENGTH(binInteger)) + binInteger ELSEIF integer <= 4294967295 THEN // 2^32-1 binInteger = strRepeat("0", 32 - LENGTH(binInteger)) + binInteger ELSE binInteger = strRepeat("0", 64 - LENGTH(binInteger)) + binInteger ENDIF ENDIF totalDigits = LENGTH(binInteger + binDecimal) IFB totalDigits > 64 THEN DIM del32 = totalDigits - 32 DIM del64 = totalDigits - 64 IFB del32 = LENGTH(binDecimal) AND digits <> 64 THEN binDecimal = "" msg = "32bitを超えたため、小数点以下を削除しました" ELSEIF del32 < LENGTH(binDecimal) AND digits <> 64 THEN binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - del32) msg = "32bitを超えたため、小数点以下の一部を削除しました" ELSEIF del64 = LENGTH(binDecimal) AND del64 <> 0 THEN binDecimal = "" msg = "64bitを超えたため、小数点以下を削除しました" ELSEIF del64 < LENGTH(binDecimal) THEN binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - del64) msg = "64bitを超えたため、小数点以下の一部を削除しました" ELSE msg = "64bitを超えるため、変換できません" isError = TRUE ENDIF ENDIF // 整数部、小数部の合計桁数を8,16,24,32,64bit単位になるまで拡張 digit = LENGTH(binInteger + binDecimal) DIM array[] = 8, 16, 24, 32, 64 FOR item IN array IFB digit <= item THEN binInteger = strRepeat("0", item - digit) + binInteger BREAK ENDIF NEXT // 指定ビットに調整 // 合計桁数の再設定 totalDigits = LENGTH(binInteger + binDecimal) IFB digits = TRUE THEN // 桁合わせを自動調整 IFB totalDigits > 64 THEN len = LENGTH(binInteger + binDecimal) WHILE LENGTH(binInteger) > 8 AND len > digits IFB COPY(binInteger, 1, 4) = "0000" THEN binInteger = COPY(binInteger, 5) len = len - 4 ELSE BREAK ENDIF WEND WHILE LENGTH(binDecimal) > 4 AND LENGTH(binInteger + binDecimal) > digits IFB COPY(binDecimal, LENGTH(binDecimal) - 4) = "0000" THEN binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - 4) ELSE BREAK ENDIF WEND tmp = binInteger + "." + binDecimal binInteger = COPY(tmp, 1, POS(".", tmp) - 1) binDecimal = COPY(tmp, POS(".", tmp) + 1) totalDigits = LENGTH(binInteger + binDecimal) IFB totalDigits > 64 THEN isError = TRUE msg = "64bitを超えたため変換できません" ENDIF ENDIF ELSE // 指定ビットに調整 IFB totalDigits <= digits THEN binInteger = strPad(binInteger, digits - LENGTH(binDecimal), "0", LEFT) ELSE // 桁あふれ調整 totalDigits = LENGTH(binInteger + binDecimal) len = LENGTH(binInteger + binDecimal) WHILE LENGTH(binInteger) > 8 AND len > digits IFB COPY(binInteger, 1, 4) = "0000" THEN binInteger = COPY(binInteger, 5) len = len - 4 ELSE BREAK ENDIF WEND WHILE LENGTH(binDecimal) > 4 AND LENGTH(binInteger + binDecimal) > digits IFB COPY(binDecimal, LENGTH(binDecimal) - 4) = "0000" THEN binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - 4) ELSE BREAK ENDIF WEND tmp = binInteger + "." + binDecimal binInteger = COPY(tmp, 1, POS(".", tmp) - 1) binDecimal = COPY(tmp, POS(".", tmp) + 1) len = LENGTH(binInteger + binDecimal) IFB len > digits THEN DIM deleteLength = len - digits IFB deleteLength = LENGTH(binDecimal) THEN binDecimal = "" msg = "指定ビット数にするため小数点以下を削除しました" ELSEIF deleteLength < LENGTH(binDecimal) THEN binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - deleteLength) msg = "指定ビット数にするため小数点以下の一部を削除しました" ELSE isError = TRUE msg = "指定ビット数では変換できません" ENDIF ENDIF ENDIF ENDIF bin = binInteger + IIF(binDecimal <> "", "." + binDecimal, "") // (5) 入力値がマイナスのため、2進数をマイナス値に変換する IFB negativeFlg THEN // 1の補数 bin = bitNot(bin) // 2の補数 DIM res = "" DIM carry = "1" FOR i = LENGTH(bin) TO 1 STEP -1 IFB carry = "1" THEN SELECT COPY(bin, i, 1) CASE "0" res = "1" + res carry = 0 CASE "1" res = "0" + res DEFAULT res = COPY(bin, i, 1) + res SELEND ELSE res = COPY(bin, i, 1) + res ENDIF NEXT bin = res ENDIF ENDIF IF errorMsg AND msg <> "" THEN PRINT msg RESULT = IIF(isError, ERR_VALUE, bin) FEND ////////////////////////////////////////////////// // 【引数】 // dec : 10進数 // signFlg : 符号付きならばTrue // digits : 変換した16進数の桁数合わせを自動で行うかを示すブール値、もしくは桁数を表す数値（8,16,24,32,64のいずれか）を指定 // errorMsg : エラーメッセージを出力するかを示すブール値 // 【戻り値】 // 16進数に変換した値 ////////////////////////////////////////////////// FUNCTION decToHex(dec, signFlg = FALSE, digits = FALSE, errorMsg = FALSE) // 【1】変数の初期化 DIM hex = "" DIM msg = "" DIM isError = FALSE DIM dec2hex[] = "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F" DIM decimalFlg = IIF(POS(".", dec) <> 0, TRUE, FALSE) DIM negativeFlg = IIF(dec < 0, TRUE, FALSE) // (end 1) // 【2】decの絶対値を返す dec = Decimal.absoluteValue(dec) // (end 2) // 【3】10進数を整数部と小数部に分ける DIM integer = Decimal.floor(dec) DIM decimal = Decimal.modulo(dec, "1") // (end 3) // 【4】10進数（整数部）を16進数に変換する。 REPEAT hex = dec2hex[Decimal.modulo(integer, 16)] + hex integer = Decimal.truncated(Decimal.dividedBy(integer, 16)) UNTIL Decimal.equals(integer, 0) // 【5】10進数（小数部）を16進数に変換する。 IFB decimalFlg THEN hex = hex + "." DIM loop = 0 REPEAT loop = loop + 1 decimal = Decimal.times(decimal, 16) hex = hex + dec2hex[decimal] offset = Decimal.toPower(10, LENGTH(decimal) - POS(".", decimal)) decimal = Decimal.dividedBy(Decimal.minus(Decimal.times(decimal, offset), Decimal.times(Decimal.truncated(decimal), offset)), offset) UNTIL Decimal.equals(decimal, 0) OR loop > 16 ENDIF // 《6》digitsがFALSE以外ならば IFB digits THEN // 【6-1】16進数の桁合わせを行う DIM tmp = hex DIM hexInteger = TOKEN(".", tmp) DIM hexDecimal = TOKEN(".", tmp) // 整数部、小数部を4bit単位になるまで拡張 // 整数部、4の倍数になるまで整数部の先頭に'0'を追加 // ※16進数は4bit単位なのでこの処理は不要 DIM digit = LENGTH(hexInteger + hexDecimal) integer = Decimal.truncated(dec) IF signFlg AND COPY(hexToBin(hexInteger), 1, 1) = "1" THEN hexInteger = "0" + hexInteger IFB signFlg THEN WITH Decimal IFB .greaterThanOrEqualTo(integer, -128) AND .lessThanOrEqualTo(integer, 127) THEN // -2^7〜2^7-1 hexInteger = strRepeat("0", 2 - LENGTH(hexInteger)) + hexInteger ELSEIF .greaterThanOrEqualTo(integer, -32768) AND .lessThanOrEqualTo(integer, 32767) THEN // -2^15〜2^15-1 hexInteger = strRepeat("0", 4 - LENGTH(hexInteger)) + hexInteger ELSEIF .greaterThanOrEqualTo(integer, -8388608) AND .lessThanOrEqualTo(integer, 8388607) THEN // -2^23〜2^23-1 hexInteger = strRepeat("0", 6 - LENGTH(hexInteger)) + hexInteger ELSEIF .greaterThanOrEqualTo(integer, -2147783648) AND .lessThanOrEqualTo(integer, 2147483647) THEN // -2^31〜2^31-1 hexInteger = strRepeat("0", 8 - LENGTH(hexInteger)) + hexInteger ELSE hexInteger = strRepeat("0", 16 - LENGTH(hexInteger)) + hexInteger ENDIF ENDWITH ELSE WITH Decimal IFB .lessThanOrEqualTo(integer, 255) THEN // 2^8-1 hexInteger = strRepeat("0", 2 - LENGTH(hexInteger)) + hexInteger ELSEIF .lessThanOrEqualTo(integer, 65535) THEN // 2^16-1 hexInteger = strRepeat("0", 4 - LENGTH(hexInteger)) + hexInteger ELSEIF .lessThanOrEqualTo(integer, 16777215) THEN // 2^24-1 hexInteger = strRepeat("0", 6 - LENGTH(hexInteger)) + hexInteger ELSEIF .lessThanOrEqualTo(integer, 4294967295) THEN // 2^32-1 hexInteger = strRepeat("0", 8 - LENGTH(hexInteger)) + hexInteger ELSE hexInteger = strRepeat("0", 16 - LENGTH(hexInteger)) + hexInteger ENDIF ENDWITH ENDIF totalDigits = LENGTH(hexInteger + hexDecimal) * 4 // 64bitを超えたら IFB totalDigits > 64 THEN DIM del32 = totalDigits - 32 DIM del64 = totalDigits - 64 IFB del32 = LENGTH(hexDecimal) * 4 AND digits <> 64 THEN hexDecimal = "" msg = "32bitを超えたため、小数点以下を削除しました" ELSEIF del32 < LENGTH(hexDecimal) * 4 AND digits <> 64 THEN hexDecimal = COPY(hexDecimal, 1, (LENGTH(hexDecimal) * 4 - del32) / 4) msg = "32bitを超えたため、小数点以下の一部を削除しました" ELSEIF del64 = LENGTH(hexDecimal) * 4 AND del64 <> 0 THEN hexDecimal = "" msg = "64bitを超えたため、小数点以下を削除しました" ELSEIF del64 < LENGTH(hexDecimal) * 4 THEN hexDecimal = COPY(hexDecimal, 1, (LENGTH(hexDecimal) * 4 - del64) / 4) msg = "64bitを超えたため、小数点以下の一部を削除しました" ELSE isError = TRUE msg = "64bitを超えるため、変換できません" ENDIF ENDIF // 整数部、小数部の合計桁数を8,16,24,32,64bit単位になるまで拡張 digit = LENGTH(hexInteger + hexDecimal) * 4 DIM array[] = 8, 16, 24, 32, 64 FOR item IN array IFB digit <= item THEN hexInteger = strRepeat("0", (item - digit) / 4) + hexInteger BREAK ENDIF NEXT totalDigits = LENGTH(hexInteger + hexDecimal) * 4 IFB digits = TRUE THEN // 桁合わせを自動調整 IFB totalDigits > 64 THEN digit = LENGTH(hexInteger + hexDecimal) WHILE LENGTH(hexInteger) > 8 AND digit > digits IFB COPY(hexInteger, 1, 1) = "0" THEN digit = digit - 1 ELSE BREAK ENDIF WEND WHILE LENGTH(hexDecimal) * 4 > 4 AND LENGTH(hexInteger + hexDecimal) > digits IFB COPY(hexDecimal, LENGTH(hexDecimal) - 1) = "0" THEN hexDecimal = COPY(hexDecimal, 1, LENGTH(hexDecimal) - 1) ELSE BREAK ENDIF WEND tmp = hexInteger + "." + hexDecimal hexInteger = COPY(tmp, 1, POS(".", tmp) - 1) hexDecimal = COPY(tmp, POS(".", tmp) + 1) totalDigits = LENGTH(hexInteger + hexDecimal) IFB totalDigits > 64 THEN isError = TRUE msg = "64bitを超えたため変換できません" ENDIF ENDIF ELSE // 指定ビットに調整 IFB totalDigits <= digits THEN hexInteger = strPad(hexInteger, digits / 4 - LENGTH(hexDecimal), "0", LEFT) ELSE // 桁あふれ調整 totalDigits = LENGTH(hexInteger + hexDecimal) digit = LENGTH(hexInteger + hexDecimal) WHILE LENGTH(hexInteger) * 4 > 8 AND digit > digits IFB COPY(hexInteger, 1, 1) = "0" THEN hexInteger = COPY(hexInteger, 2) digit = digit - 4 / 4 ELSE BREAK ENDIF WEND WHILE LENGTH(hexDecimal) * 4 > 4 AND LENGTH(hexInteger + hexDecimal) > digits IFB COPY(hexDecimal, LENGTH(hexDecimal) - 1) = "0" THEN hexDecimal = COPY(hexDecimal, 1, LENGTH(hexDecimal) - 1) ELSE BREAK ENDIF WEND tmp = hexInteger + "." + hexDecimal hexInteger = COPY(tmp, 1, POS(".", tmp) - 1) hexDecimal = COPY(tmp, POS(".", tmp) + 1) digit = LENGTH(hexInteger + hexDecimal) * 4 IFB digit > digits THEN DIM deleteLength = digit - digits IFB deleteLength = LENGTH(hexDecimal) * 4 THEN hexDecimal = "" msg = "指定ビット数にするため小数点以下を削除しました" ELSEIF deleteLength < LENGTH(hexDecimal) * 4 THEN hexDecimal = COPY(hexDecimal, 1, LENGTH(hexDecimal) - deleteLength / 4) msg = "指定ビット数にするため小数点以下の一部を削除しました" ELSE isError = TRUE msg = "指定ビット数では変換できません" ENDIF ENDIF ENDIF ENDIF hex = hexInteger + IIF(hexDecimal <> "", "." + hexDecimal, "") // 入力値がマイナスのため、16進数をマイナス値に変換する IFB negativeFlg THEN bin = hexToBin(hex) // 1の補数 bin = bitNot(bin) // 2の補数 DIM res = "" DIM carry = "1" FOR i = LENGTH(bin) TO 1 STEP -1 IFB carry = "1" THEN SELECT COPY(bin, i, 1) CASE "0" res = "1" + res carry = 0 CASE "1" res = "0" + res DEFAULT res = COPY(bin, i, 1) + res SELEND ELSE res = COPY(bin, i, 1) + res ENDIF NEXT hex = binToHex(res) ENDIF ENDIF IF errorMsg AND msg <> "" THEN PRINT msg RESULT = IIF(isError, ERR_VALUE, hex) FEND ////////////////////////////////////////////////// // 【引数】 // deg : 角度（度数法） // 【戻り値】 // 度数法から弧度法に変換した値 ////////////////////////////////////////////////// FUNCTION degToRad(deg) WITH Decimal pr = .precision .precision = 25 RESULT = .times(deg, .dividedBy(Decimal.PI, "180")) .precision = 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 ////////////////////////////////////////////////// // 【引数】 // str : 相互変換させるバイナリデータ // 【戻り値】 // 変換したバイナリデータ ////////////////////////////////////////////////// FUNCTION Endian(str) DIM len = LENGTH(str) IFB !isEven(len) THEN str = "0" + str len = len + 1 ENDIF DIM res = "" FOR n = 1 TO len STEP 2 res = COPY(str, n, 2) + res NEXT RESULT = res FEND ////////////////////////////////////////////////// // 【引数】 // num : 数値 // digits : 小数点以下の桁数 // 【戻り値】 ////////////////////////////////////////////////// FUNCTION fixed(num, digits = EMPTY) num = VAL(num) // 指数表記を整える IFB POS("E-", num) THEN DIM mantissa = BETWEENSTR(num,, "E") DIM exponent = BETWEENSTR(num, "E") RESULT = "0." + strRepeat("0", VAL(ABS(exponent) - 1)) + REPLACE(mantissa, ".", "") ELSEIF POS("E", num) THEN RESULT = ROUND(num, -1 *digits) mantissa = BETWEENSTR(num,, "E") exponent = BETWEENSTR(num, "E") RESULT = REPLACE(mantissa, ".", "") + strRepeat("0", VAL(exponent) - decimalDigits(mantissa)) ELSEIF LENGTH(BETWEENSTR(num, ".")) < digits THEN DIM keta = digits - LENGTH(BETWEENSTR(num, ".")) RESULT = num + IIF(POS(".", num) OR keta = 0, "", ".") + strRepeat("0", keta) ELSE IF digits = EMPTY THEN digits = LENGTH(BETWEENSTR(num, ".")) RESULT = "" + roundOff(num, digits) ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // num : 丸め処理を行う値 // 【戻り値】 // 負の方向に丸めた値 ////////////////////////////////////////////////// FUNCTION floor(num) RESULT = INT(num) + IIF(num < 0 AND num <> INT(num), -1, 0) FEND ////////////////////////////////////////////////// // 【引数】 // array : 最大公約数を求める数値を格納した配列 // 【戻り値】 // 最大公約数 ////////////////////////////////////////////////// FUNCTION GCD(array[]) DIM c = LENGTH(array) DIM rem = array[c-1] MOD array[c-2] IFB rem = 0 THEN IFB LENGTH(array) = 2 THEN RESULT = array[c-2] EXIT ENDIF RESIZE(array, c-2) RESULT = GCD(array) EXIT ENDIF array[c-1] = array[c-2] array[c-2] = rem RESULT = GCD(array) FEND ////////////////////////////////////////////////// // 【引数】 // path : ビットマップ画像のパス // 【戻り値】 // 配列。0:サイズ（Byte）、1:幅（px）、2:高さ（px）、3:ビットの深さ（bit） ////////////////////////////////////////////////// FUNCTION getBitmap(path) CONST adTypeBinary = 1 DIM array[3] DIM Stream = CREATEOLEOBJ("ADODB.Stream") Stream.Open() Stream.Type = adTypeBinary Stream.LoadFromFile(path) DIM tmp = Stream.Read(30) Stream.Close() DIM fmt = "" FOR i = 0 TO 1 fmt = fmt + decToHex(tmp[i]) NEXT IFB fmt <> "424D" THEN RESULT = ERR_VALUE EXIT ENDIF DIM size = "" FOR i = 2 TO 5 hex = decToHex(tmp[i], FALSE) size = size + IIF(LENGTH(hex) = 1, "0", "") + hex NEXT array[0] = hexToDec(Endian(size)) DIM width = "" FOR i = 18 TO 21 hex = decToHex(tmp[i], FALSE) width = width + IIF(LENGTH(hex) = 1, "0", "") + hex NEXT array[1] = hexToDec(Endian(width)) DIM height = "" FOR i = 22 TO 25 hex = decToHex(tmp[i], FALSE) height = height + IIF(LENGTH(hex) = 1, "0", "") + hex NEXT array[2] = hexToDec(Endian(height)) DIM bit = "" FOR i = 28 TO 29 hex = decToHex(tmp[i], FALSE) bit = bit + IIF(LENGTH(hex) = 1, "0", "") + hex NEXT array[3] = hexToDec(Endian(bit)) RESULT = SLICE(array) FEND ////////////////////////////////////////////////// // 【引数】 // date : 日付（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”） // m : 第一引数の指定日からプラスマイナスm月とする // 【戻り値】 // dateからm月後の月末の日付 ////////////////////////////////////////////////// FUNCTION getEndOfMonth(date, m = 0) date = dateAdd("m", m + 1, date) GETTIME(0, date) GETTIME(-G_TIME_DD, date) RESULT = G_TIME_YY4 + "/" + G_TIME_MM2 + "/" + G_TIME_DD2 FEND ////////////////////////////////////////////////// // 【引数】 // date : 日付文字列（”YYYYMMDD” or “YYYY/MM/DD” or “YYYY-MM-DD” or “YYYYMMDDHHNNSS” or “YYYY/MM/DD HH:NN:SS”）もしくはシリアル値 // type : 取得する曜日番号の種類を示す0〜3または11〜17の値。1と17は日曜日を1、2と11は月曜日を1とカウントします。11以降はExcel2010で追加された値で、互換性を保つために重複した値があります。 // 【戻り値】 // typeで指定した種類によって以下の値を返します。 : （0 : 0(日曜)〜6(土曜)、1 : 1(日曜)～7(土曜)、2 : 1(月曜)～7(日曜)、3 : 0(月曜)〜6(日曜)、11 : 1(月曜)～7(日曜)、12 : 1(火曜)～7(月曜)、13 : 1(水曜)～7(火曜)、14 : 1(木曜)～7(水曜)、15 : 1(金曜)～7(木曜)、16 : 1(土曜)～7(金曜)、17 : 1(日曜)～7(土曜)） ////////////////////////////////////////////////// FUNCTION getWeekday(date, type = 1) IF VARTYPE(date) <> 258 THEN date = text(date, "yyyy/mm/dd") GETTIME(0, date) DIM w = G_TIME_WW SELECT TRUE CASE type = 0 RESULT = w CASE type = 1 RESULT = w + 1 CASE type = 2 RESULT = IIF(w=0, 7, w) CASE type = 3 RESULT = (w+6) MOD 7 CASE type >= 11 RESULT = ((getWeekday(date, 2) + 17 - type) MOD 7) + 1 SELEND FEND ////////////////////////////////////////////////// // 【引数】 // str : ハッシュ化する文字列 // 【戻り値】 // ハッシュ化した文字列 ////////////////////////////////////////////////// MODULE Hash DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject") DIM path PROCEDURE Hash() CONST TemporaryFolder = 2 DIM Folder = FSO.GetSpecialFolder(TemporaryFolder) DIM folderspec = Folder.Path DIM filename = FSO.GetTempName path = FSO.BuildPath(folderspec, filename) FEND FUNCTION md2(str) DIM TextStream = FSO.CreateTextFile(path) TextStream.Write(str) TextStream.Close RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD2 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>")) FSO.DeleteFile(path) FEND FUNCTION md4(str) DIM TextStream = FSO.CreateTextFile(path) TextStream.Write(str) TextStream.Close RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD4 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>")) FSO.DeleteFile(path) FEND FUNCTION md5(str) DIM TextStream = FSO.CreateTextFile(path) TextStream.Write(str) TextStream.Close RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> MD5 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>")) FSO.DeleteFile(path) FEND FUNCTION sha1(str) DIM TextStream = FSO.CreateTextFile(path) TextStream.Write(str) TextStream.Close RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA1 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>")) FSO.DeleteFile(path) FEND FUNCTION sha256(str) DIM TextStream = FSO.CreateTextFile(path) TextStream.Write(str) TextStream.Close RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA256 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>")) FSO.DeleteFile(path) FEND FUNCTION sha384(str) DIM TextStream = FSO.CreateTextFile(path) TextStream.Write(str) TextStream.Close RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA384 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>")) FSO.DeleteFile(path) FEND FUNCTION sha512(str) DIM TextStream = FSO.CreateTextFile(path) TextStream.Write(str) TextStream.Close RESULT = TRIM(DOSCMD("CertUtil -hashfile <#DBL>" + path + "<#DBL> SHA512 | findstr /R <#DBL>^[0-9A-Fa-f][0-9A-Fa-f]*$<#DBL>")) FSO.DeleteFile(path) FEND ENDMODULE ////////////////////////////////////////////////// // 【引数】 // hex : 16進数 // 【戻り値】 // 2進数に変換した値 ////////////////////////////////////////////////// FUNCTION hexToBin(hex) HASHTBL hb hb["0"] = "0000"; hb["1"] = "0001"; hb["2"] = "0010"; hb["3"] = "0011" hb["4"] = "0100"; hb["5"] = "0101"; hb["6"] = "0110"; hb["7"] = "0111" hb["8"] = "1000"; hb["9"] = "1001"; hb["A"] = "1010"; hb["B"] = "1011" hb["C"] = "1100"; hb["D"] = "1101"; hb["E"] = "1110"; hb["F"] = "1111" DIM bin = "" IFB POS(".", hex) <> 0 THEN FOR i = 1 TO LENGTH(hex) DIM str = COPY(hex, i, 1) IF str = "." THEN bin = bin + "." bin = bin + hb[str] NEXT ELSE FOR i = 1 TO LENGTH(hex) bin = bin + hb[COPY(hex, i, 1)] NEXT ENDIF RESULT = bin FEND ////////////////////////////////////////////////// // 【引数】 // hex : 16進数 // signFlg : 符号付きならばTrue // 【戻り値】 // 10進数に変換した値 ////////////////////////////////////////////////// FUNCTION hexToDec(hex, signFlg = TRUE) hex = STRCONV(hex, SC_UPPERCASE) DIM dec = 0 DIM decimalFlg = IIF(POS(".", hex) <> 0, TRUE, FALSE) hex = IIF(LENGTH(REPLACE(hex,".", "" )) MOD 2 <> 0, "0", "") + hex DIM negativeFlg = IIF(COPY(hexToBin(hex), 1, 1) = "1", TRUE, FALSE) DIM sign = 1 IF negativeFlg AND signFlg THEN sign = -1 IFB negativeFlg AND signFlg THEN DIM bin = hexToBin(hex) DIM msb = IIF(decimalFlg, POS(".", bin) - 1, LENGTH(bin)) DIM lsb = IIF(decimalFlg, POS(".", bin) - LENGTH(bin), 0) DIM a = hexToDec(hex, FALSE) DIM b = POWER(2, msb) - 1 FOR i = -1 TO lsb STEP -1 b = b + POWER(2, i) NEXT DIM dec2 = bitXor(a, b) + POWER(2, lsb) hex = decToHex(dec2) ENDIF integer = IIF(decimalFlg, COPY(hex, 1, POS(".", hex) - 1), hex) decimal = IIF(decimalFlg, COPY(hex, POS(".", hex) + 1), "0") FOR i = 1 TO LENGTH(integer) s = COPY(hex, i, 1) num = IIF(CHKNUM(s), s, ASC(s) - (ASC("A") - 10)) dec = dec + num * POWER(16, LENGTH(integer) - i) NEXT FOR i = 1 TO LENGTH(decimal) s = COPY(decimal, i, 1) num = IIF(CHKNUM(s), s, ASC(s) - (ASC("A") - 10)) dec = dec + num * POWER(16, -1 * i) NEXT RESULT = sign * dec FEND ////////////////////////////////////////////////// // 【引数】 // serial : シリアル値もしくは時刻文字列 // 【戻り値】 // 時刻から時間を表す0〜23の範囲の値 ////////////////////////////////////////////////// FUNCTION Hour(serial) IF VARTYPE(serial) = 258 THEN serial = timeValue(serial) RESULT = INT(serial * 24) MOD 24 FEND ////////////////////////////////////////////////// // 【引数】 // expr : 評価する式 // truepart : 評価した式がTrueのときに返す値 // falsepart : 評価した式がFalseのときに返す値 // 【戻り値】 // truepart : 評価した式がTrueのとき、falsepart : 評価した式がFalseのとき ////////////////////////////////////////////////// FUNCTION IIF(expr, truepart, falsepart) IFB EVAL(expr) THEN RESULT = truepart ELSE RESULT = falsepart ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // variable : 型を調べる変数 // 【戻り値】 ////////////////////////////////////////////////// FUNCTION isArray(variable[]) RESULT = IIF(VARTYPE(variable) AND 8192, TRUE, FALSE) FEND ////////////////////////////////////////////////// // 【引数】 // variable : 型を調べる変数 // 【戻り値】 // : TRUE : 与えられた変数がブール型である、 // FALSE : 与えられた変数がブール型でない、 : ////////////////////////////////////////////////// FUNCTION isBoolean(variable) RESULT = IIF(VARTYPE(variable) = VAR_BOOLEAN, TRUE, FALSE) FEND ////////////////////////////////////////////////// // 【引数】 // date : 存在するかを調べる日付文字列。YYYYMMDD or YYYY/MM/DD or YYYY-MM-DDのいずれかの形式。 // 【戻り値】 // TRUE : 日付として認識できる、FALSE : 日付として認識できない ////////////////////////////////////////////////// FUNCTION isDate(date) TRY GETTIME(0, date) RESULT = TRUE EXCEPT RESULT = FALSE ENDTRY FEND ////////////////////////////////////////////////// // 【引数】 // 数値 : 整数 // 【戻り値】 // True : 偶数、False : 偶数以外の数値、ERR_VALUE : 数値以外 ////////////////////////////////////////////////// FUNCTION isEven(n) IFB VAL(n) = n THEN RESULT = IIF(INT(n) MOD 2 = 0, TRUE, FALSE) ELSE RESULT = ERR_VALUE ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // variable : 型を調べる変数 // 【戻り値】 ////////////////////////////////////////////////// FUNCTION isFloat(variable) IFB VAL(variable) <> ERR_VALUE THEN RESULT = IIF((VARTYPE(variable) = VAR_SINGLE OR VARTYPE(variable) = VAR_DOUBLE) AND INT(variable) <> variable, TRUE, FALSE) ELSE RESULT = FALSE ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // variable : 型を調べる変数 // 【戻り値】 // : TRUE : 与えられた変数が整数型である、 // FALSE : 与えられた変数が整数型でない、 : ////////////////////////////////////////////////// FUNCTION isInt(variable) IFB VAL(variable) <> ERR_VALUE AND !isBoolean(variable) AND !isString(variable) THEN RESULT = IIF(variable - INT(variable) = 0, TRUE, FALSE) ELSE RESULT = FALSE ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // variable : 型を調べる変数 // 【戻り値】 // : TRUE : 与えられた変数が文字列型である、 // FALSE : 与えられた変数が文字列型でない、 : ////////////////////////////////////////////////// FUNCTION isString(variable) RESULT = IIF(VARTYPE(variable) = VAR_ASTR OR VARTYPE(variable) = VAR_USTR, TRUE, FALSE) FEND ////////////////////////////////////////////////// // 【引数】 // text : JSONとして解析する文字列 // value : JSON文字列に変換する値 // reviver : 使用不可 // replacer : 使用不可 // space : 出力するJSON文字列に空白を挿入するための文字列もしくは数値 // 【戻り値】 // : Parse : JSON文字列をオブジェクトに変換、 // Stringify : オブジェクトをJSON文字列に変換、 : ////////////////////////////////////////////////// MODULE JSON DIM SC, CodeObject PROCEDURE JSON SC = CREATEOLEOBJ("ScriptControl") WITH SC .Language = "JScript" .ExecuteStatement(json2) .ExecuteStatement(statement) CodeObject = .CodeObject ENDWITH FEND FUNCTION Parse(text, reviver = NULL) RESULT = CodeObject.JSON.parse(text, reviver) FEND FUNCTION Stringify(value, replacer = "", space = FALSE) RESULT = CodeObject.JSON.stringify(value, NULL, replacer) IF space THEN RESULT = REPLACE(RESULT, CHR(10), "<#CR>") FEND ENDMODULE TEXTBLOCK statement Array.prototype.Item = function(i, value){ if(value === undefined) return this[i]; this[i] = value; } Array.prototype.item = Array.prototype.Item; ENDTEXTBLOCK TEXTBLOCK json2 // json2.js // 2023-05-10 // Public Domain. // NO WARRANTY EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK. // USE YOUR OWN COPY. IT IS EXTREMELY UNWISE TO LOAD CODE FROM SERVERS YOU DO // NOT CONTROL. // This file creates a global JSON object containing two methods: stringify // and parse. This file provides the ES5 JSON capability to ES3 systems. // If a project might run on IE8 or earlier, then this file should be included. // This file does nothing on ES5 systems. // JSON.stringify(value, replacer, space) // value any JavaScript value, usually an object or array. // replacer an optional parameter that determines how object // values are stringified for objects. It can be a // function or an array of strings. // space an optional parameter that specifies the indentation // of nested structures. If it is omitted, the text will // be packed without extra whitespace. If it is a number, // it will specify the number of spaces to indent at each // level. If it is a string (such as "\t" or " "), // it contains the characters used to indent at each level. // This method produces a JSON text from a JavaScript value. // When an object value is found, if the object contains a toJSON // method, its toJSON method will be called and the result will be // stringified. A toJSON method does not serialize: it returns the // value represented by the name/value pair that should be serialized, // or undefined if nothing should be serialized. The toJSON method // will be passed the key associated with the value, and this will be // bound to the value. // For example, this would serialize Dates as ISO strings. // Date.prototype.toJSON = function (key) { // function f(n) { // // Format integers to have at least two digits. // return (n < 10) // ? "0" + n // : n; // } // return this.getUTCFullYear() + "-" + // f(this.getUTCMonth() + 1) + "-" + // f(this.getUTCDate()) + "T" + // f(this.getUTCHours()) + ":" + // f(this.getUTCMinutes()) + ":" + // f(this.getUTCSeconds()) + "Z"; // }; // You can provide an optional replacer method. It will be passed the // key and value of each member, with this bound to the containing // object. The value that is returned from your method will be // serialized. If your method returns undefined, then the member will // be excluded from the serialization. // If the replacer parameter is an array of strings, then it will be // used to select the members to be serialized. It filters the results // such that only members with keys listed in the replacer array are // stringified. // Values that do not have JSON representations, such as undefined or // functions, will not be serialized. Such values in objects will be // dropped; in arrays they will be replaced with null. You can use // a replacer function to replace those with JSON values. // JSON.stringify(undefined) returns undefined. // The optional space parameter produces a stringification of the // value that is filled with line breaks and indentation to make it // easier to read. // If the space parameter is a non-empty string, then that string will // be used for indentation. If the space parameter is a number, then // the indentation will be that many spaces. // Example: // text = JSON.stringify(["e", {pluribus: "unum"}]); // // text is '["e",{"pluribus":"unum"}]' // text = JSON.stringify(["e", {pluribus: "unum"}], null, "\t"); // // text is '[\n\t"e",\n\t{\n\t\t"pluribus": "unum"\n\t}\n]' // text = JSON.stringify([new Date()], function (key, value) { // return this[key] instanceof Date // ? "Date(" + this[key] + ")" // : value; // }); // // text is '["Date(---current time---)"]' // JSON.parse(text, reviver) // This method parses a JSON text to produce an object or array. // It can throw a SyntaxError exception. // The optional reviver parameter is a function that can filter and // transform the results. It receives each of the keys and values, // and its return value is used instead of the original value. // If it returns what it received, then the structure is not modified. // If it returns undefined then the member is deleted. // Example: // // Parse the text. Values that look like ISO date strings will // // be converted to Date objects. // myData = JSON.parse(text, function (key, value) { // var a; // if (typeof value === "string") { // a = // /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2}(?:\.\d*)?)Z$/.exec(value); // if (a) { // return new Date(Date.UTC( // +a[1], +a[2] - 1, +a[3], +a[4], +a[5], +a[6] // )); // } // return value; // } // }); // myData = JSON.parse( // "[\"Date(09/09/2001)\"]", // function (key, value) { // var d; // if ( // typeof value === "string" // && value.slice(0, 5) === "Date(" // && value.slice(-1) === ")" // ) { // d = new Date(value.slice(5, -1)); // if (d) { // return d; // } // } // return value; // } // ); // This is a reference implementation. You are free to copy, modify, or // redistribute. /*jslint eval, for, this */ /*property JSON, apply, call, charCodeAt, getUTCDate, getUTCFullYear, getUTCHours, getUTCMinutes, getUTCMonth, getUTCSeconds, hasOwnProperty, join, lastIndex, length, parse, prototype, push, replace, slice, stringify, test, toJSON, toString, valueOf */ // Create a JSON object only if one does not already exist. We create the // methods in a closure to avoid creating global variables. if (typeof JSON !== "object") { JSON = {}; } (function () { "use strict"; var rx_one = /^[\],:{}\s]*$/; var rx_two = /\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g; var rx_three = /"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g; var rx_four = /(?:^|:|,)(?:\s*\[)+/g; var rx_escapable = /[\\"\u0000-\u001f\u007f-\u009f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g; var rx_dangerous = /[\u0000\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g; function f(n) { // Format integers to have at least two digits. return (n < 10) ? "0" + n : n; } function this_value() { return this.valueOf(); } if (typeof Date.prototype.toJSON !== "function") { Date.prototype.toJSON = function () { return isFinite(this.valueOf()) ? ( this.getUTCFullYear() + "-" + f(this.getUTCMonth() + 1) + "-" + f(this.getUTCDate()) + "T" + f(this.getUTCHours()) + ":" + f(this.getUTCMinutes()) + ":" + f(this.getUTCSeconds()) + "Z" ) : null; }; Boolean.prototype.toJSON = this_value; Number.prototype.toJSON = this_value; String.prototype.toJSON = this_value; } var gap; var indent; var meta; var rep; function quote(string) { // If the string contains no control characters, no quote characters, and no // backslash characters, then we can safely slap some quotes around it. // Otherwise we must also replace the offending characters with safe escape // sequences. rx_escapable.lastIndex = 0; return rx_escapable.test(string) ? "\"" + string.replace(rx_escapable, function (a) { var c = meta[a]; return typeof c === "string" ? c : "\\u" + ("0000" + a.charCodeAt(0).toString(16)).slice(-4); }) + "\"" : "\"" + string + "\""; } function str(key, holder) { // Produce a string from holder[key]. var i; // The loop counter. var k; // The member key. var v; // The member value. var length; var mind = gap; var partial; var value = holder[key]; // If the value has a toJSON method, call it to obtain a replacement value. if ( value && typeof value === "object" && typeof value.toJSON === "function" ) { value = value.toJSON(key); } // If we were called with a replacer function, then call the replacer to // obtain a replacement value. if (typeof rep === "function") { value = rep.call(holder, key, value); } // What happens next depends on the value's type. switch (typeof value) { case "string": return quote(value); case "number": // JSON numbers must be finite. Encode non-finite numbers as null. return (isFinite(value)) ? String(value) : "null"; case "boolean": case "null": // If the value is a boolean or null, convert it to a string. Note: // typeof null does not produce "null". The case is included here in // the remote chance that this gets fixed someday. return String(value); // If the type is "object", we might be dealing with an object or an array or // null. case "object": // Due to a specification blunder in ECMAScript, typeof null is "object", // so watch out for that case. if (!value) { return "null"; } // Make an array to hold the partial results of stringifying this object value. gap += indent; partial = []; // Is the value an array? if (Object.prototype.toString.apply(value) === "[object Array]") { // The value is an array. Stringify every element. Use null as a placeholder // for non-JSON values. length = value.length; for (i = 0; i < length; i += 1) { partial[i] = str(i, value) || "null"; } // Join all of the elements together, separated with commas, and wrap them in // brackets. v = partial.length === 0 ? "[]" : gap ? ( "[\n" + gap + partial.join(",\n" + gap) + "\n" + mind + "]" ) : "[" + partial.join(",") + "]"; gap = mind; return v; } // If the replacer is an array, use it to select the members to be stringified. if (rep && typeof rep === "object") { length = rep.length; for (i = 0; i < length; i += 1) { if (typeof rep[i] === "string") { k = rep[i]; v = str(k, value); if (v) { partial.push(quote(k) + ( (gap) ? ": " : ":" ) + v); } } } } else { // Otherwise, iterate through all of the keys in the object. for (k in value) { if (Object.prototype.hasOwnProperty.call(value, k)) { v = str(k, value); if (v) { partial.push(quote(k) + ( (gap) ? ": " : ":" ) + v); } } } } // Join all of the member texts together, separated with commas, // and wrap them in braces. v = partial.length === 0 ? "{}" : gap ? "{\n" + gap + partial.join(",\n" + gap) + "\n" + mind + "}" : "{" + partial.join(",") + "}"; gap = mind; return v; } } // If the JSON object does not yet have a stringify method, give it one. if (typeof JSON.stringify !== "function") { meta = { // table of character substitutions "\b": "\\b", "\t": "\\t", "\n": "\\n", "\f": "\\f", "\r": "\\r", "\"": "\\\"", "\\": "\\\\" }; JSON.stringify = function (value, replacer, space) { // The stringify method takes a value and an optional replacer, and an optional // space parameter, and returns a JSON text. The replacer can be a function // that can replace values, or an array of strings that will select the keys. // A default replacer method can be provided. Use of the space parameter can // produce text that is more easily readable. var i; gap = ""; indent = ""; // If the space parameter is a number, make an indent string containing that // many spaces. if (typeof space === "number") { for (i = 0; i < space; i += 1) { indent += " "; } // If the space parameter is a string, it will be used as the indent string. } else if (typeof space === "string") { indent = space; } // If there is a replacer, it must be a function or an array. // Otherwise, throw an error. rep = replacer; if (replacer && typeof replacer !== "function" && ( typeof replacer !== "object" || typeof replacer.length !== "number" )) { throw new Error("JSON.stringify"); } // Make a fake root object containing our value under the key of "". // Return the result of stringifying the value. return str("", {"": value}); }; } // If the JSON object does not yet have a parse method, give it one. if (typeof JSON.parse !== "function") { JSON.parse = function (text, reviver) { // The parse method takes a text and an optional reviver function, and returns // a JavaScript value if the text is a valid JSON text. var j; function walk(holder, key) { // The walk method is used to recursively walk the resulting structure so // that modifications can be made. var k; var v; var value = holder[key]; if (value && typeof value === "object") { for (k in value) { if (Object.prototype.hasOwnProperty.call(value, k)) { v = walk(value, k); if (v !== undefined) { value[k] = v; } else { delete value[k]; } } } } return reviver.call(holder, key, value); } // Parsing happens in four stages. In the first stage, we replace certain // Unicode characters with escape sequences. JavaScript handles many characters // incorrectly, either silently deleting them, or treating them as line endings. text = String(text); rx_dangerous.lastIndex = 0; if (rx_dangerous.test(text)) { text = text.replace(rx_dangerous, function (a) { return ( "\\u" + ("0000" + a.charCodeAt(0).toString(16)).slice(-4) ); }); } // In the second stage, we run the text against regular expressions that look // for non-JSON patterns. We are especially concerned with "()" and "new" // because they can cause invocation, and "=" because it can cause mutation. // But just to be safe, we want to reject all unexpected forms. // We split the second stage into 4 regexp operations in order to work around // crippling inefficiencies in IE's and Safari's regexp engines. First we // replace the JSON backslash pairs with "@" (a non-JSON character). Second, we // replace all simple value tokens with "]" characters. Third, we delete all // open brackets that follow a colon or comma or that begin the text. Finally, // we look to see that the remaining characters are only whitespace or "]" or // "," or ":" or "{" or "}". If that is so, then the text is safe for eval. if ( rx_one.test( text .replace(rx_two, "@") .replace(rx_three, "]") .replace(rx_four, "") ) ) { // In the third stage we use the eval function to compile the text into a // JavaScript structure. The "{" operator is subject to a syntactic ambiguity // in JavaScript: it can begin a block or an object literal. We wrap the text // in parens to eliminate the ambiguity. j = eval("(" + text + ")"); // In the optional fourth stage, we recursively walk the new structure, passing // each name/value pair to a reviver function for possible transformation. return (typeof reviver === "function") ? walk({"": j}, "") : j; } // If the text is not JSON parseable, then a SyntaxError is thrown. throw new SyntaxError("JSON.parse"); }; } }()); ENDTEXTBLOCK ////////////////////////////////////////////////// // 【引数】 // array : 配列 // rank : 抽出する値の大きい方から数えた順位 // 【戻り値】 ////////////////////////////////////////////////// FUNCTION large(array[], rank) IFB rank >= 1 AND rank <= LENGTH(array) THEN shellSort(array) RESULT = array[LENGTH(array) - rank] ELSE RESULT = ERR_VALUE ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // str : 正規表現による検索の対象となる文字列 // Pattern : 正規表現で使用するパターンを設定 // IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse // Global : 文字列全体を検索する場合はTrue、しない場合はFalse // 【戻り値】 // 正規表現で検索した結果をMatchesコレクションとして返します。 ////////////////////////////////////////////////// FUNCTION reExecute(str, Pattern, IgnoreCase = TRUE, Global = TRUE) DIM re = CREATEOLEOBJ("VBScript.RegExp") re.Pattern = Pattern re.IgnoreCase = IgnoreCase re.Global = Global RESULT = re.Execute(str) FEND ////////////////////////////////////////////////// // 【引数】 // str : 正規表現による検索の対象となる文字列 // Pattern : 正規表現で使用するパターンを設定 // IgnoreCase : 大文字・小文字を区別しない場合はTrue、区別する場合はFalse // Global : 文字列全体を検索する場合はTrue、しない場合はFalse // 【戻り値】 // 正規表現にマッチするかどうかを示すブール値 ////////////////////////////////////////////////// FUNCTION reTest(str, Pattern, IgnoreCase = TRUE, Global = TRUE) DIM re = CREATEOLEOBJ("VBScript.RegExp") re.Pattern = Pattern re.IgnoreCase = IgnoreCase re.Global = Global RESULT = re.Test(str) FEND ////////////////////////////////////////////////// // 【引数】 // num : 数値 // digit : 四捨五入する位置（マイナスで整数方向） // 【戻り値】 // 四捨五入した値 ////////////////////////////////////////////////// FUNCTION roundOff(num, digit = 0) DIM sign = sign(num) num = ABS(num) DIM offset = POWER(10, digit) DIM n = num * offset - INT(num * offset) RESULT = sign * IIF(n >= 0.5, CEIL(num * offset) / offset, INT(num * offset) / offset) FEND ////////////////////////////////////////////////// // 【引数】 // serial : 時間を表すシリアル値を指定 // 【戻り値】 ////////////////////////////////////////////////// FUNCTION Second(serial) RESULT = REPLACE(FORMAT(INT(serial * 86400) MOD 60, 2), " ", "0") FEND ////////////////////////////////////////////////// // 【引数】 // array : ソートする数値を格納した配列。参照引数。 // 【戻り値】 ////////////////////////////////////////////////// PROCEDURE shellSort(Var array[]) DIM i, j, inc, temp inc = 4 WHILE INT(inc) > 0 FOR i = 0 TO UBound(array) j = i temp = array[i] WHILE j >= inc AND array[zcut(j-inc)] > temp array[j] = array[j-inc] j = j - inc WEND array[j] = temp NEXT IFB inc / 2 <> 0 THEN inc = inc / 2 ELSEIF inc = 1 THEN inc = 0 ELSE inc = 1 ENDIF WEND FEND ////////////////////////////////////////////////// // 【引数】 // num : 符号を求める数値 // 【戻り値】 // 1 : 正の数、0 : ゼロ、-1 : 負の数、ERR_VALUE : それ以外 ////////////////////////////////////////////////// FUNCTION sign(num) SELECT TRUE CASE !CHKNUM(num) RESULT = ERR_VALUE CASE num > 0 RESULT = 1 CASE num = 0 RESULT = 0 CASE num < 0 RESULT = -1 SELEND FEND ////////////////////////////////////////////////// // 【引数】 // array : 配列 // rank : 抽出する値の小さい方から数えた順位 // 【戻り値】 ////////////////////////////////////////////////// FUNCTION small(array[], rank) IFB rank >= 1 AND rank <= LENGTH(array) THEN shellSort(array) RESULT = array[rank-1] ELSE RESULT = ERR_VALUE ENDIF FEND ////////////////////////////////////////////////// // 【引数】 // input : 入力文字列 // length : 埋めたあとの長さ // str : 埋める文字 // type : 埋める方向 // 【戻り値】 // 指定文字で埋めた文字列 ////////////////////////////////////////////////// FUNCTION strPad(input, length, str = " ", type = RIGHT) DIM s = "" SELECT type CASE LEFT FOR i = 1 TO CEIL((length - LENGTH(input)) / LENGTH(str)) s = s + str NEXT input = COPY(s, 1, length - LENGTH(input)) + input CASE RIGHT FOR i = 1 TO CEIL((length - LENGTH(input)) / LENGTH(str)) s = s + str NEXT input = input + COPY(s, 1, length - LENGTH(input)) SELEND RESULT = input FEND ////////////////////////////////////////////////// // 【引数】 // inputs : 繰り返す文字列 // multiplier : inputsを繰り返す回数 // 【戻り値】 // inputsをmultiplier回を繰り返した文字列を返します ////////////////////////////////////////////////// FUNCTION strRepeat(inputs, multiplier) DIM res = "" FOR n = 1 TO multiplier res = res + inputs NEXT RESULT = res FEND ////////////////////////////////////////////////// // 【引数】 // a : bと交換する値。参照引数。 // b : aと交換する値。参照引数。 // 【戻り値】 ////////////////////////////////////////////////// PROCEDURE swap(Var a, Var b) DIM tmp = a a = b b = tmp FEND ////////////////////////////////////////////////// // 【引数】 // serial : シリアル値 // format : フォーマット // 【戻り値】 // 数値を表示書式に基づいて変換した文字列 ////////////////////////////////////////////////// FUNCTION text(serial, format, hour12 = FALSE) HASHTBL startDate startDate["明治"] = "1868/01/25" startDate["大正"] = "1912/07/30" startDate["昭和"] = "1926/12/25" startDate["平成"] = "1989/01/08" startDate["令和"] = "2019/05/01" DIM baseDate = "1899/12/30" serial = VAL(serial) SELECT TRUE CASE reTest(format, "\[h+\]") Matches = reExecute(format, "\[(h+)\]") DIM hour = iif(hour12, Hour(serial) MOD 12, Hour(serial)) RESULT = text(hour, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0)))) CASE reTest(format, "^h+$") Matches = reExecute(format, "^(h+)$") hour = iif(hour12, Hour(serial) MOD 12, Hour(serial)) RESULT = text(hour MOD 24, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0)))) CASE reTest(format, "\[m+\]") Matches = reExecute(format, "\[(m+)\]") RESULT = text(serial * 1440, strRepeat("0", LENGTH(Matches.Item(0).SubMatches(0)))) CASE format = "m" GETTIME(serial, baseDate) RESULT = text(G_TIME_MM, "0") CASE format = "mm" GETTIME(serial, baseDate) RESULT = G_TIME_MM2 CASE format = "n" GETTIME(serial, baseDate) RESULT = G_TIME_NN CASE format = "nn" GETTIME(serial, baseDate) RESULT = G_TIME_NN2 CASE format = "s" GETTIME(serial, baseDate) RESULT = text(G_TIME_SS, "0") CASE format = "ss" GETTIME(serial, baseDate) RESULT = G_TIME_SS2 CASE format = "yyyy" GETTIME(serial, baseDate) RESULT = G_TIME_YY4 CASE format = "yy" GETTIME(serial, baseDate) RESULT = COPY(G_TIME_YY4, 3, 2) CASE format = "e" SELECT TRUE CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(serial, "yyyy") - 2018 CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(serial, "yyyy") - 1988 CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(serial, "yyyy") - 1925 CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(serial, "yyyy") - 1911 CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(serial, "yyyy") - 1867 SELEND CASE format = "ee" SELECT TRUE CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(text(serial, "yyyy") - 2018, "00") CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(text(serial, "yyyy") - 1988, "00") CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(text(serial, "yyyy") - 1925, "00") CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(text(serial, "yyyy") - 1911, "00") CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0 RESULT = text(text(serial, "yyyy") - 1867, "00") SELEND CASE format = "g" SELECT TRUE CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "R" CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "H" CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "S" CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "T" CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "M" SELEND CASE format = "gg" RESULT = COPY(text(serial, "ggg"), 1, 1) CASE format = "ggg" SELECT TRUE CASE dateDiff("d", startDate["令和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "令和" CASE dateDiff("d", startDate["平成"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "平成" CASE dateDiff("d", startDate["昭和"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "昭和" CASE dateDiff("d", startDate["大正"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "大正" CASE dateDiff("d", startDate["明治"], text(serial, "yyyy/mm/dd")) >= 0; RESULT = "明治" SELEND CASE format = "mmmmm" RESULT = COPY(text(serial, "mmmm"), 1, 1) CASE format = "mmmm" DIM month[] = "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December" RESULT = month[text(serial, "m") - 1] CASE format = "mmm" RESULT = COPY(text(serial, "mmmm"), 1, 3) CASE format = "dd" GETTIME(serial, baseDate) RESULT = text(G_TIME_DD2, "00") CASE format = "d" GETTIME(serial, baseDate) RESULT = text(G_TIME_DD, "0") CASE reTest(format, "^[ad]{3,4}$") Matches = reExecute(format, "([ad]{3,4})") GETTIME(serial, baseDate) DIM aaa[] = "日", "月", "火", "水", "木", "金", "土" DIM aaaa[] = "日曜日", "月曜日", "火曜日", "水曜日", "木曜日", "金曜日", "土曜日" DIM ddd[] = "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" DIM dddd[] = "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" RESULT = EVAL(Matches.Item(0).SubMatches(0) + "[" + getWeekday(G_TIME_WW, 1) + "]") CASE reTest(format, "(0+\.?0+)?%") Matches = reExecute(format, "(0+\.?0+)?%") RESULT = text(serial * 100, Matches.Item(0).SubMatches(0)) + "%" CASE reTest(format, "^\[DBNum\d{1,4}\](.*?)$") Matches = reExecute(format, "^\[DBNum(\d{1,4})\](.*?)$") DIM value = VAL(Matches.Item(0).SubMatches(0)) DIM sss = text(serial, Matches.Item(0).SubMatches(1)) Matches = reExecute(sss, "(\D+)?(\d+)(\D+)?") DIM res = "" FOR m = 0 TO Matches.Count - 1 serial = Matches.Item(m).SubMatches(1) SELECT value CASE 1, 2 DIM n[][9] = "〇", "一", "二", "三", "四", "五", "六", "七", "八", "九", _ "", "壱", "弐", "参", "四", "伍", "六", "七", "八", "九" DIM a[][3] = "", "十", "百", "千", _ "", "拾", "百", "阡" DIM b[][3] = "", "万", "億", "兆", _ "", "萬", "億", "兆" DIM r = "" DIM j = 0 type = value - 1 REPEAT DIM str = "" DIM n4 = serial MOD 10000 FOR i = LENGTH(n4) TO 1 STEP -1 s = COPY(n4, i, 1) IFB s = 1 AND a[type][LENGTH(n4)-i] <> "" THEN str = IIF(s, a[type][LENGTH(n4)-i], "") + str ELSE str = n[type][s] + IIF(s, a[type][LENGTH(n4)-i], "") + str ENDIF NEXT IF str <> "" THEN r = str + b[type][j] + r j = j + 1 serial = INT(serial / 10000) UNTIL serial = 0 res = res + Matches.Item(m).SubMatches(0) + r + Matches.Item(m).SubMatches(2) CASE 3 res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_FULLWIDTH) + Matches.Item(m).SubMatches(2) CASE 4 res = res + Matches.Item(m).SubMatches(0) + STRCONV(serial, SC_HALFWIDTH) + Matches.Item(m).SubMatches(2) SELEND NEXT RESULT = res CASE reTest(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$") Matches = reExecute(format, "^(.*?)(AM\/PM|am\/pm|A\/P|a\/p)(.*?)$") DIM array = SPLIT(Matches.Item(0).SubMatches(1), "/") ampm = array[IIF(serial - INT(serial) >= 0.5, 1, 0)] hour12 = TRUE res = "" WITH Matches.Item(0) res = text(serial, .SubMatches(0), hour12) + ampm + text(serial, .SubMatches(2), hour12) ENDWITH RESULT = res CASE reTest(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?") Matches = reExecute(format, "([^ymdagehns]{0,})?(([ymdagehns])\3{0,})([^ymdagehns]+)?") FOR n = 0 TO Matches.Count - 1 IF n = 0 THEN res = Matches.Item(n).SubMatches(0) NEXT FOR n = 0 TO Matches.Count - 1 WITH Matches.Item(n) res = res + text(serial, .SubMatches(1), hour12) + .SubMatches(3) ENDWITH NEXT RESULT = res CASE format = "0/0" DIM separator = POS(".", serial) DIM g = 0 IFB separator <> 0 THEN DIM keta = LENGTH(serial) DIM shift = POWER(10, keta - separator) IFB shift >= POWER(10, 15) THEN DIM position = 0 FOR i = 0 TO 14 IFB serial * POWER(10, i) - serial >= 1 THEN position = i BREAK ENDIF NEXT tmp = serial * POWER(10, position) FOR i = 1 TO 15 r = (tmp * POWER(10, i)) / serial - (tmp / serial) a1 = tmp * POWER(10, i) - tmp IF a1 = INT(a1) THEN BREAK NEXT DIM frac[] = a1, r g = GCD(frac) RESULT = (a1/g) + "/" + (r/g) ELSE DIM molecule = serial * shift // 分子 DIM denominator = shift // 分母 DIM nums[] = molecule, denominator g = GCD(nums) molecule = molecule / g denominator = denominator / g RESULT = molecule + "/" + denominator ENDIF ELSE RESULT = serial + "/1" ENDIF CASE reTest(format, "(0+)\.?(0+)?") AND UBound(SPLIT(format, ".")) <= 1 Matches = reExecute(format, "(0+)\.?(0+)?") len1 = LENGTH(Matches.Item(0).SubMatches(0)) len2 = LENGTH(Matches.Item(0).SubMatches(1)) DIM arr[] = LENGTH(INT(serial)), len1 IFB POS(".", format) THEN RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX) + len2 + 1, len2), " ", "0") ELSE RESULT = REPLACE(FORMAT(serial, CALCARRAY(arr, CALC_MAX)), " ", "0") ENDIF SELEND FEND ////////////////////////////////////////////////// // 【引数】 // str : 時刻文字列。hh:nn:ss AM/PM、hh:nn AM/PM、hh AM/PM、hh:nn:ss、hh:nn、hh時nn分ss秒、hh時nn分のいずれかの形式を指定。 // 【戻り値】 // シリアル値　（例）0…00:00:00、0.5…12:00:00、0.999988425925926…23:59:59 ////////////////////////////////////////////////// FUNCTION timeValue(str) DIM serial = 0 DIM Matches DIM pattern = "(\d+)" DIM hh = "(0?[0-9]|1[0-2])" DIM ampm = "([AP]M|[ap]m)" SELECT TRUE CASE reTest(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b") Matches = reExecute(str, "\b" + hh + ":" + pattern + ":" + pattern + " " + ampm + "\b") WITH Matches.Item(0) serial = timeValue(.SubMatches(0) + " " + .SubMatches(3)) + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400 ENDWITH CASE reTest(str, "\b" + hh + ":" + pattern + " " + ampm + "\b") Matches = reExecute(str, "\b" + hh + ":" + pattern + " " + ampm + "\b") WITH Matches.Item(0) serial = timeValue(.SubMatches(0) + " " + .SubMatches(2)) + VAL(.SubMatches(1)) / 1440 ENDWITH CASE reTest(str, "\b" + hh + " " + ampm + "\b") Matches = reExecute(str, "\b" + hh + " " + ampm + "\b") WITH Matches.Item(0) serial = VAL(.SubMatches(0) MOD 12) + IIF(reTest(.SubMatches(1), "AM|am"), 0, 12) serial = serial / 24 ENDWITH CASE reTest(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b") Matches = reExecute(str, "\b" + pattern + ":" + pattern + ":" + pattern + "\b") WITH Matches.Item(0) serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400 ENDWITH CASE reTest(str, "\b" + pattern + ":" + pattern + "\b") Matches = reExecute(str, "\b" + pattern + ":" + pattern + "\b") WITH Matches.Item(0) serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 ENDWITH CASE reTest(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒") Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分" + pattern + "秒") WITH Matches.Item(0) serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 + VAL(.SubMatches(2)) / 86400 ENDWITH CASE reTest(str, "\b" + pattern + "時" + pattern + "分") Matches = reExecute(str, "\b" + pattern + "時" + pattern + "分") WITH Matches.Item(0) serial = VAL(.SubMatches(0)) / 24 + VAL(.SubMatches(1)) / 1440 ENDWITH DEFAULT serial = ERR_VALUE SELEND RESULT = serial - INT(serial) FEND ////////////////////////////////////////////////// // 【引数】 // arrayname : 上限値を求める配列の名前 // dimension : 返す次元を示す整数 // 【戻り値】 // 配列の上限値 ////////////////////////////////////////////////// FUNCTION UBound(arrayname[], dimension = 1) RESULT = EVAL("RESIZE(arrayname" + strRepeat("[0]", dimension - 1) + ")") FEND

プログラム実行例

アクティブウィンドウの左上にカーソルを移動

マウスカーソルをランダムな位置に移動

マウスカーソル下のウィンドウの左上の座標に移動する

関連記事

GETKEYSTATE関数 (スクリプト関数)

キーコードの状態を取得します。

LOCKHARDEX関数 (スクリプト関数)

キーボード、マウスからの入力を禁止します。

MOUSEORG関数 (スクリプト関数)

マウス座標を相対座標にする、またはマウスとキー情報を直接ウィンドウへ送ります。

MUSCUR関数 (スクリプト関数)

マウスカーソル種別を返します。