本ページには広告が含まれています。
引数に指定した日付から旧暦を求めます。
- 構文
- getKyureki( year, month, day )
- 引数
- year 必須
- 年
- month 必須
- 月
- day 必須
- 日
- 戻り値
- 旧暦を格納した配列（0 : 年, 1 : 月, 2 : 日）
プログラム
旧暦
ここでいう旧暦とは、現在使われているグレゴリオ暦の一つ前の天保暦のことです。天保15年1月1日（1844年2月18日）から明治5年12月2日（1872年12月31日）まで約29年間使用された。
| 季節 | 月 | 二十四節気 | 太陽黄経 |
|---|---|---|---|
| 春 | 1月節 | 立春 | 315度 |
| 1月中 | 雨水 | 330度 | |
| 2月節 | 啓蟄 | 345度 | |
| 2月中 | 春分 | 0度 | |
| 3月節 | 清明 | 15度 | |
| 3月中 | 穀雨 | 30度 | |
| 夏 | 4月節 | 立夏 | 45度 |
| 4月中 | 小満 | 60度 | |
| 5月節 | 芒種 | 75度 | |
| 5月中 | 夏至 | 90度 | |
| 6月節 | 小暑 | 105度 | |
| 6月中 | 大暑 | 120度 | |
| 秋 | 7月節 | 立秋 | 135度 |
| 7月中 | 処暑 | 150度 | |
| 8月節 | 白露 | 165度 | |
| 8月中 | 秋分 | 180度 | |
| 9月節 | 寒露 | 195度 | |
| 9月中 | 霜降 | 210度 | |
| 冬 | 10月節 | 立冬 | 225度 |
| 10月中 | 小雪 | 240度 | |
| 11月節 | 大雪 | 255度 | |
| 11月中 | 冬至 | 270度 | |
| 12月節 | 小寒 | 285度 | |
| 12月中 | 大寒 | 300度 |
旧暦2033年問題
旧暦2033年問題とは、西暦2033年秋から2034年春にかけて日本の旧暦の月名が天保暦の暦法で決定できなくなる問題のことです。
プログラム実行例
旧暦を求める
2020年3月14日の旧暦を求める。
DIM d = getKyureki(2020, 3, 14)
PRINT d[0] + "/" + d[1] + d[2] + "/" + d[3]
//////////////////////////////////////////////////
// 【引数】
// 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, ".", "")) 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
//////////////////////////////////////////////////
// 【引数】
// JD : ユリウス日
// 【戻り値】
// 中気と太陽黄経を格納した配列（0 : 中気, 1 : 太陽黄経）
//////////////////////////////////////////////////
FUNCTION chuki(JD)
JD = JD - 9/24
DIM t = (JD + 0.5 - 2451545) / 36525
DIM λsun = longitudeSun(t)
DIM λsun0 = 30 * INT(λsun/30)
REPEAT
t = (JD + 0.5 - 2451545) / 36525
λsun = longitudeSun(t)
DIM Δλ = λsun - λsun0
SELECT TRUE
CASE Δλ > 180
Δλ = Δλ - 360
CASE Δλ "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) 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) 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 ys THEN
RESULT = xs
EXIT
ENDIF
// Compare exponents.
IFB x[1] y[1] THEN
RESULT = IIF(x[1] > y[1] XOR xs yd[i] THEN
RESULT = IIF(xd[i] > yd[i], 1, -1)
RESULT = IIF(xs POWER(ydL, xs) "))
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) "" 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) 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) "))
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 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) "))
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 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) "))
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) = 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) "))
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) "))
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 = 1 && pr 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) NULL, TRUE, FALSE)
FEND
FUNCTION isInteger(x)
x = IIF(VARTYPE(x) = 3 AND GLOBAL.floor(x[1] / LOG_BASE) > LENGTH(x) - 2 - 2, VAR_BOOLEAN)
FEND
FUNCTION isNaN(x)
x = IIF(VARTYPE(x) 0, TRUE, FALSE)
FEND
FUNCTION isZero(x)
x = IIF(VARTYPE(x) "))
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]) = 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) 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 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 0 THEN len = i
FOR i = 0 TO len - 1
IFB VAL(xd[i]) VAL(yd[i]) THEN
xLTy = VAL(xd[i]) 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]) 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) 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 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 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
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) 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) "))
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 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) 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 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) 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) "))
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 = LENGTH(y) - 2 - 1 AND k maxE + 1 OR 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) = 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 = toExpPos)
RESULT = IIF(isNegative(x) AND !isZero(x), "-" + str, str)
FEND
FUNCTION truncated(x, isNumeric = FALSE)
x = IIF(VARTYPE(x) = 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 0
w = w / 10
WEND
RESULT = str + w
FEND
FUNCTION checkInt32(i, min, max)
IF i VARTYPE(i, VAR_INTEGER) 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 UBound(d) THEN
rd = 0
ELSE
rd = d[di] MOD k
ENDIF
IFB repeating = NULL THEN
IFB i 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 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 3 AND rd = 4999
ELSE
IFB di + 1 > UBound(d) THEN
n = 0
ELSE
n = d[di + 1]
ENDIF
r = ((repeating OR 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 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 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) 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 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 = 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 = base / 2 THEN yd0 = VAL(yd0) + 1
WHILE TRUE
k = 0
// Compare divisor and remainder.
cmp = compare(yd, rem, yL, remL)
// If divisor 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 = 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) 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 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) 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 = k THEN
IFB isTruncated THEN
// Needed by `naturalExponential`, `naturalLogarithm` and `squareRoot`.
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 UBound(xd) THEN
isTruncated = TRUE
ELSEIF IIF(j 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 5
roundUp2 = rd = 5
roundUp3 = rm = 4
roundUp4 = isTruncated
roundUp5 = rm = 6
roundUp6 = VARTYPE(bitAnd("" + tmp, "1"), VAR_BOOLEAN)
roundUp7= (rm = IIF(x[0] 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] 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 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] 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 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 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) 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 "))
rm = rounding
pr = precision
// Is x negative or Infinity, NaN, 0 or 1?
IFB x[0] 1) {
// max n is 6 (gives 0.7 - 1.3)
WHILE 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| 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 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 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
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, "'", ""))
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 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 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) = 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] 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 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 k || i === k && (rm === 4 || roundUp || rm === 6 && xd[sd - 1] & 1 ||
// rm === (x.s 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] NULL OR roundUp) AND (rm = 0 OR rm = IIF(x[0] k OR i = k AND (rm = 4 OR roundUp OR rm = 6 AND xd[sd - 1] AND 1 OR rm = IIF(x[0] 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 len THEN
FOR e = e - len TO 1 STEP -1
str = str + "0"
NEXT
ELSEIF e 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 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] = 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 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] 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 = 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 "" 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] VAR_BOOLEAN AND digits = 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 = -32768 AND integer = -8388608 AND integer = -2147783648 AND integer 64 THEN
DIM del32 = totalDigits - 32
DIM del64 = totalDigits - 64
IFB del32 = LENGTH(binDecimal) AND digits 64 THEN
binDecimal = ""
msg = "32bitを超えたため、小数点以下を削除しました"
ELSEIF del32 64 THEN
binDecimal = COPY(binDecimal, 1, LENGTH(binDecimal) - del32)
msg = "32bitを超えたため、小数点以下の一部を削除しました"
ELSEIF del64 = LENGTH(binDecimal) AND del64 0 THEN
binDecimal = ""
msg = "64bitを超えたため、小数点以下を削除しました"
ELSEIF del64 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 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 "", "." + 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(repetend0, "[" + 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, ".")) 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
//////////////////////////////////////////////////
// 【引数】
// year : 年
// month : 月
// day : 日
// 【戻り値】
// 旧暦を格納した配列（0 : 年, 1 : 月, 2 : 日）
//////////////////////////////////////////////////
FUNCTION getKyureki(year, month, day)
DIM tm = YMDToJD(year, month, day, 0, 0, 0)
DIM chu[-1] // n*2︰ユリウス日、n*2+1︰Δλsun0、n=0,1,2
DIM tmp
tmp = nishiNibun(tm)
FOR n = 0 TO UBound(tmp)
arrayPush(chu, tmp[n])
NEXT
// 中気の計算 3回 chu[n]︰n+1回目
FOR n = 0 TO 2
tmp = chuki(chu[n*2] + 32)
FOR n = 0 TO UBound(tmp)
arrayPush(chu, tmp[n])
NEXT
NEXT
DIM saku[5]
saku[0] = saku(chu[0])
// 朔の計算
FOR n = 1 TO 4
saku[n] = saku(saku[n-1] + 30)
IFB ABS(INT(saku[n-1]) - INT(saku[n])) INT(chu[0*2+0])
SHIFTARRAY(saku, 1)
saku[0] = saku(saku[0] - 27)
SELEND
DIM kyureki[3] // 0︰年、1︰閏月、2︰月、3︰日
// 閏月検索
DIM flg = FALSE
IF INT(saku[4]) 12 THEN m[0][0] = m[0][0] - 12
m[0][2] = INT(saku[0*0+0])
m[0][1] = ""
FOR n = 1 TO 4
IFB flg = TRUE AND n 1 THEN
IFB INT(chu[(n-1)*2+0]) = INT(saku[n]) THEN
m[n-1][0] = m[n-2][0]
m[n-1][1] = "閏"
m[n-1][2] = INT(saku[n-1])
flg = FALSE
ENDIF
ENDIF
m[n][0] = m[n-1][0] + 1
IF m[n][0] > 12 THEN m[n][0] = m[n][0] - 12
m[n][2] = INT(saku[n])
m[n][1] = ""
NEXT
DIM state = 0
FOR n = 0 TO 4
IFB INT(tm) 9 AND kyureki[2] > d[1] THEN kyureki[0] = kyureki[0] - 1
RESULT = SLICE(kyureki)
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 " + path + " MD2 | findstr /R ^[0-9A-Fa-f][0-9A-Fa-f]*$"))
FSO.DeleteFile(path)
FEND
FUNCTION md4(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile " + path + " MD4 | findstr /R ^[0-9A-Fa-f][0-9A-Fa-f]*$"))
FSO.DeleteFile(path)
FEND
FUNCTION md5(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile " + path + " MD5 | findstr /R ^[0-9A-Fa-f][0-9A-Fa-f]*$"))
FSO.DeleteFile(path)
FEND
FUNCTION sha1(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile " + path + " SHA1 | findstr /R ^[0-9A-Fa-f][0-9A-Fa-f]*$"))
FSO.DeleteFile(path)
FEND
FUNCTION sha256(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile " + path + " SHA256 | findstr /R ^[0-9A-Fa-f][0-9A-Fa-f]*$"))
FSO.DeleteFile(path)
FEND
FUNCTION sha384(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile " + path + " SHA384 | findstr /R ^[0-9A-Fa-f][0-9A-Fa-f]*$"))
FSO.DeleteFile(path)
FEND
FUNCTION sha512(str)
DIM TextStream = FSO.CreateTextFile(path)
TextStream.Write(str)
TextStream.Close
RESULT = TRIM(DOSCMD("CertUtil -hashfile " + path + " SHA512 | findstr /R ^[0-9A-Fa-f][0-9A-Fa-f]*$"))
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
//////////////////////////////////////////////////
// 【引数】
// JD : ユリウス日
// 【戻り値】
// グレゴリオ暦を格納した配列（0 : 年, 1 : 月, 2 : 日, 3 : 時, 4 : 分, 5 : 秒）
//////////////////////////////////////////////////
FUNCTION JDToYMD(JD)
DIM x0 = INT(JD + 68570)
DIM x1 = INT(x0 / 36524.25)
DIM x2 = x0 - INT(36524.25 * x1 + 0.75)
DIM x3 = INT((x2 + 1) / 365.2425)
DIM x4 = x2 - INT(365.25 * x3) + 31
DIM x5 = INT(INT(x4) / 30.59)
DIM x6 = INT(INT(x5) / 11)
DIM t2 = x4 - INT(30.59 * x5)
DIM t1 = x5 - 12 * x6 + 2
DIM t0 = 100 * (x1 - 49) + x3 + x6
IFB t1 = 2 AND t2 > 28 THEN
SELECT TRUE
CASE t0 MOD 100 = 0 AND t0 MOD 400 = 0
t2 = 29
CASE t0 MOD 4 = 0
t2 = 29
DEFAULT
t2 = 28
SELEND
ENDIF
DIM tm = 86400 * (JD - INT(JD))
DIM t3 = INT(tm / 3600)
DIM t4 = INT((tm - 3600 * t3) / 60)
DIM t5 = INT(tm - 3600 * t3 - 60 * t4)
DIM t[] = t0, t1, t2, t3, t4, t5
RESULT = SLICE(t)
FEND
//////////////////////////////////////////////////
// 【引数】
// text : JSONとして解析する文字列
// value : JSON文字列に変換する値
// reviver : 使用不可
// replacer : 使用不可
// space : 出力するJSON文字列に空白を挿入するための文字列もしくは数値
// 【戻り値】
// : Parse : JSON文字列をオブジェクトに変換、
// Stringify : オブジェクトをJSON文字列に変換、 :
//////////////////////////////////////////////////
MODULE JSON
DIM SC, CodeObject
PROCEDURE JSON
SC = CREATEOLEOBJ("ScriptControl")
WITH SC
.Language = "JScript"
.ExecuteStatement(json2)
.ExecuteStatement(statement)
CodeObject = .CodeObject
ENDWITH
FEND
FUNCTION Parse(text, reviver = NULL)
RESULT = CodeObject.JSON.parse(text, reviver)
FEND
FUNCTION Stringify(value, replacer = "", space = FALSE)
RESULT = CodeObject.JSON.stringify(value, NULL, replacer)
IF space THEN RESULT = REPLACE(RESULT, CHR(10), "")
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 = 1 AND rank 180
Δλ = Δλ - 360
CASE Δλ = 360 + offset
deg = deg - INT(deg / 360) * 360
CASE deg = 0.5, CEIL(num * offset) / offset, INT(num * offset) / offset)
FEND
//////////////////////////////////////////////////
// 【引数】
// JD : ユリウス日
// 【戻り値】
// 朔の日時
//////////////////////////////////////////////////
FUNCTION saku(JD)
DIM lc = 1 // loop counter
DIM JD1 = INT(JD)
DIM JD2 = JD - JD1
JD2 = JD2 - 9/24
DIM Δt1 = 0
DIM Δt2 = 1
WHILE ABS(Δt1+Δt2) > 1/86400
DIM JC = (JD2 + 0.5) / 36525
JC = JC + (JD1 - 2451545) / 36525
DIM λsun = longitudeSun(JC)
DIM λmoon = longitudeMoon(JC)
DIM Δλ = λmoon - λsun
SELECT TRUE
CASE lc = 1 AND Δλ = 0 AND λsun = 300
Δλ = normalizeAngle(Δλ)
Δλ = 360 - Δλ
CASE ABS(Δλ) > 40
Δλ = normalizeAngle(Δλ)
SELEND
Δt1 = INT(Δλ * 29.530589 / 360)
Δt2 = Δλ * 29.530589 / 360
Δt2 = Δt2 - Δt1
JD1 = JD1 - Δt1
JD2 = JD2 - Δt2
IFB JD2 1/86400 THEN
JD1 = INT(JD - 26)
JD2 = 0
ELSEIF lc > 30 AND ABS(Δt1+Δt2) > 1/86400 THEN
JD1 = JD
JD2 = 0
ENDIF
lc = lc + 1
WEND
RESULT = JD1 + JD2 + 9/24
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 = 1 AND rank = 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, ".")) 結果
使用関数
今年の十五夜の日付を求める
結果
使用関数
関連記事
- YMDToJD関数 (自作関数)
- グレゴリオ暦をユリウス日に変換します。
- JDToYMD関数 (自作関数)
- ユリウス日をグレゴリオ暦に変換します。
- saku関数 (自作関数)
- 指定したユリウス日の直前の朔を求めます。
- GETTIME関数 (スクリプト関数)
- 日付、時間を取得します。
- getWeekdayName関数 (自作関数)
- 引数で指定した曜日番号に対応する曜日名を返します。
- getYear関数 (自作関数)
- 指定された日付の年を返します。
- getMonth関数 (自作関数)
- 指定された日付の月を返します。
- getDay関数 (自作関数)
- 指定された日付の日を返します。
- getWeekday関数 (自作関数)
- 引数に指定された日付の曜日番号（0：日曜〜6：土曜）を返します。
- getEndOfMonth関数 (自作関数)
- dateで指定された月の月末日を取得します。