Check Machin-like formulas: Difference between revisions
m
→{{header|Wren}}: Minor tidy
Thundergnat (talk | contribs) m (Automated syntax highlighting fixup (second round - minor fixes)) |
m (→{{header|Wren}}: Minor tidy) |
||
| (3 intermediate revisions by 2 users not shown) | |||
Line 41:
<br><br>
=={{header|BASIC}}==
==={{header|FreeBASIC}}===
{{libheader|GMP}}
<syntaxhighlight lang="freebasic">' version 07-04-2018
' compile with: fbc -s console
#Include "gmp.bi"
#Define _a(Q) (@(Q)->_mp_num) 'a
#Define _b(Q) (@(Q)->_mp_den) 'b
Data "[1, 1, 2] [1, 1, 3]"
Data "[2, 1, 3] [1, 1, 7]"
Data "[4, 1, 5] [-1, 1, 239]"
Data "[5, 1, 7] [2, 3, 79]"
Data "[1, 1, 2] [1, 1, 5] [1, 1, 8]"
Data "[4, 1, 5] [-1, 1, 70] [1, 1, 99]"
Data "[5, 1, 7] [4, 1, 53] [2, 1, 4443]"
Data "[6, 1, 8] [2, 1, 57] [1, 1, 239]"
Data "[8, 1, 10] [-1, 1, 239] [-4, 1, 515]"
Data "[12, 1, 18] [8, 1, 57] [-5, 1, 239]"
Data "[16, 1, 21] [3, 1, 239] [4, 3, 1042]"
Data "[22, 1, 28] [2, 1, 443] [-5, 1, 1393] [-10, 1, 11018]"
Data "[22, 1, 38] [17, 7, 601] [10, 7, 8149]"
Data "[44, 1, 57] [7, 1, 239] [-12, 1, 682] [24, 1, 12943]"
Data "[88, 1, 172] [51, 1, 239] [32, 1, 682] [44, 1, 5357] [68, 1, 12943]"
Data "[88, 1, 172] [51, 1, 239] [32, 1, 682] [44, 1, 5357] [68, 1, 12944]"
Data ""
Sub work2do (ByRef a As LongInt, f1 As mpq_ptr)
Dim As LongInt flag = -1
Dim As Mpq_ptr x, y, z
x = Allocate(Len(__mpq_struct)) : Mpq_init(x)
y = Allocate(Len(__mpq_struct)) : Mpq_init(y)
z = Allocate(Len(__mpq_struct)) : Mpq_init(z)
Dim As Mpz_ptr temp1, temp2
temp1 = Allocate(Len(__Mpz_struct)) : Mpz_init(temp1)
temp2 = Allocate(Len(__Mpz_struct)) : Mpz_init(temp2)
mpq_set(y, f1)
While a > 0
If (a And 1) = 1 Then
If flag = -1 Then
mpq_set(x, y)
flag = 0
Else
Mpz_mul(temp1, _a(x), _b(y))
Mpz_mul(temp2, _b(x), _a(y))
Mpz_add(_a(z), temp1, temp2)
Mpz_mul(temp1, _b(x), _b(y))
Mpz_mul(temp2, _a(x), _a(y))
Mpz_sub(_b(z), temp1, temp2)
mpq_canonicalize(z)
mpq_set(x, z)
End If
End If
Mpz_mul(temp1, _a(y), _b(y))
Mpz_mul(temp2, _b(y), _a(y))
Mpz_add(_a(z), temp1, temp2)
Mpz_mul(temp1, _b(y), _b(y))
Mpz_mul(temp2, _a(y), _a(y))
Mpz_sub(_b(z), temp1, temp2)
mpq_canonicalize(z)
mpq_set(y, z)
a = a Shr 1
Wend
mpq_set(f1, x)
End Sub
' ------=< MAIN >=------
Dim As Mpq_ptr f1, f2, f3
f1 = Allocate(Len(__mpq_struct)) : Mpq_init(f1)
f2 = Allocate(Len(__mpq_struct)) : Mpq_init(f2)
f3 = Allocate(Len(__mpq_struct)) : Mpq_init(f3)
Dim As Mpz_ptr temp1, temp2
temp1 = Allocate(Len(__Mpz_struct)) : Mpz_init(temp1)
temp2 = Allocate(Len(__Mpz_struct)) : Mpz_init(temp2)
Dim As mpf_ptr float
float = Allocate(Len(__mpf_struct)) : Mpf_init(float)
Dim As LongInt m1, a1, b1, flag, t1, t2, t3, t4
Dim As String s, s1, s2, s3, sign
Dim As ZString Ptr zstr
Do
Read s
If s = "" Then Exit Do
flag = -1
While s <> ""
t1 = InStr(s, "[") +1
t2 = InStr(t1, s, ",") +1
t3 = InStr(t2, s, ",") +1
t4 = InStr(t3, s, "]")
s1 = Trim(Mid(s, t1, t2 - t1 -1))
s2 = Trim(Mid(s, t2, t3 - t2 -1))
s3 = Trim(Mid(s, t3, t4 - t3))
m1 = Val(s1)
a1 = Val(s2)
b1 = Val(s3)
sign = IIf(m1 < 0, " - ", " + ")
If m1 < 0 Then a1 = -a1 : m1 = Abs(m1)
s = Mid(s, t4 +1)
Print IIf(flag = 0, sign, ""); IIf(m1 = 1, "", Str(m1));
Print "Atn("; s2; "/" ;s3; ")";
If flag = -1 Then
flag = 0
Mpz_set_si(_a(f1), a1)
Mpz_set_si(_b(f1), b1)
If m1 > 1 Then work2do(m1, f1)
Continue While
End If
Mpz_set_si(_a(f2), a1)
Mpz_set_si(_b(f2), b1)
If m1 > 1 Then work2do(m1, f2)
Mpz_mul(temp1, _a(f1), _b(f2))
Mpz_mul(temp2, _b(f1), _a(f2))
Mpz_add(_a(f3), temp1, temp2)
Mpz_mul(temp1, _b(f1), _b(f2))
Mpz_mul(temp2, _a(f1), _a(f2))
Mpz_sub(_b(f3), temp1, temp2)
mpq_canonicalize(f3)
mpq_set(f1, f3)
Wend
If Mpz_cmp_ui(_b(f1), 1) = 0 AndAlso Mpz_cmp(_a(f1), _b(f1)) = 0 Then
Print " = 1"
Else
Mpf_set_q(float, f1)
gmp_printf(!" = %.*Ff\n", 15, float)
End If
Loop
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End</syntaxhighlight>
{{out}}
<pre>Atn(1/2) + Atn(1/3) = 1
2Atn(1/3) + Atn(1/7) = 1
4Atn(1/5) - Atn(1/239) = 1
5Atn(1/7) + 2Atn(3/79) = 1
Atn(1/2) + Atn(1/5) + Atn(1/8) = 1
4Atn(1/5) - Atn(1/70) + Atn(1/99) = 1
5Atn(1/7) + 4Atn(1/53) + 2Atn(1/4443) = 1
6Atn(1/8) + 2Atn(1/57) + Atn(1/239) = 1
8Atn(1/10) - Atn(1/239) - 4Atn(1/515) = 1
12Atn(1/18) + 8Atn(1/57) - 5Atn(1/239) = 1
16Atn(1/21) + 3Atn(1/239) + 4Atn(3/1042) = 1
22Atn(1/28) + 2Atn(1/443) - 5Atn(1/1393) - 10Atn(1/11018) = 1
22Atn(1/38) + 17Atn(7/601) + 10Atn(7/8149) = 1
44Atn(1/57) + 7Atn(1/239) - 12Atn(1/682) + 24Atn(1/12943) = 1
88Atn(1/172) + 51Atn(1/239) + 32Atn(1/682) + 44Atn(1/5357) + 68Atn(1/12943) = 1
88Atn(1/172) + 51Atn(1/239) + 32Atn(1/682) + 44Atn(1/5357) + 68Atn(1/12944) = 0.999999188225744</pre>
==={{header|Visual Basic .NET}}===
'''BigRat''' class based on the Arithmetic/Rational#C here at Rosetta Code.<br/>
The parser here allows for some flexibility in the input text. Case is ignored, and a variable number of spaces are allowed. Atan(), arctan(), atn() are all recognized as valid. If one of those three are not found, a warning will appear. The coefficient need not have a multiplication sign between it and the "arctan()". The left side of the equation must be pi / 4, otherwise a warning will appear.
<syntaxhighlight lang="vbnet">Imports System.Numerics
Public Class BigRat ' Big Rational Class constructed with BigIntegers
Implements IComparable
Public nu, de As BigInteger
Public Shared Zero = New BigRat(BigInteger.Zero, BigInteger.One),
One = New BigRat(BigInteger.One, BigInteger.One)
Sub New(bRat As BigRat)
nu = bRat.nu : de = bRat.de
End Sub
Sub New(n As BigInteger, d As BigInteger)
If d = BigInteger.Zero Then _
Throw (New Exception(String.Format("tried to set a BigRat with ({0}/{1})", n, d)))
Dim bi As BigInteger = BigInteger.GreatestCommonDivisor(n, d)
If bi > BigInteger.One Then n /= bi : d /= bi
If d < BigInteger.Zero Then n = -n : d = -d
nu = n : de = d
End Sub
Shared Operator -(x As BigRat) As BigRat
Return New BigRat(-x.nu, x.de)
End Operator
Shared Operator +(x As BigRat, y As BigRat)
Return New BigRat(x.nu * y.de + x.de * y.nu, x.de * y.de)
End Operator
Shared Operator -(x As BigRat, y As BigRat) As BigRat
Return x + (-y)
End Operator
Shared Operator *(x As BigRat, y As BigRat) As BigRat
Return New BigRat(x.nu * y.nu, x.de * y.de)
End Operator
Shared Operator /(x As BigRat, y As BigRat) As BigRat
Return New BigRat(x.nu * y.de, x.de * y.nu)
End Operator
Public Function CompareTo(obj As Object) As Integer Implements IComparable.CompareTo
Dim dif As BigRat = New BigRat(nu, de) - obj
If dif.nu < BigInteger.Zero Then Return -1
If dif.nu > BigInteger.Zero Then Return 1
Return 0
End Function
Shared Operator =(x As BigRat, y As BigRat) As Boolean
Return x.CompareTo(y) = 0
End Operator
Shared Operator <>(x As BigRat, y As BigRat) As Boolean
Return x.CompareTo(y) <> 0
End Operator
Overrides Function ToString() As String
If de = BigInteger.One Then Return nu.ToString
Return String.Format("({0}/{1})", nu, de)
End Function
Shared Function Combine(a As BigRat, b As BigRat) As BigRat
Return (a + b) / (BigRat.One - (a * b))
End Function
End Class
Public Structure Term ' coefficent, BigRational construction for each term
Dim c As Integer, br As BigRat
Sub New(cc As Integer, bigr As BigRat)
c = cc : br = bigr
End Sub
End Structure
Module Module1
Function Eval(c As Integer, x As BigRat) As BigRat
If c = 1 Then Return x Else If c < 0 Then Return Eval(-c, -x)
Dim hc As Integer = c \ 2
Return BigRat.Combine(Eval(hc, x), Eval(c - hc, x))
End Function
Function Sum(terms As List(Of Term)) As BigRat
If terms.Count = 1 Then Return Eval(terms(0).c, terms(0).br)
Dim htc As Integer = terms.Count / 2
Return BigRat.Combine(Sum(terms.Take(htc).ToList), Sum(terms.Skip(htc).ToList))
End Function
Function ParseLine(ByVal s As String) As List(Of Term)
ParseLine = New List(Of Term) : Dim t As String = s.ToLower, p As Integer, x As New Term(1, BigRat.Zero)
While t.Contains(" ") : t = t.Replace(" ", "") : End While
p = t.IndexOf("pi/4=") : If p < 0 Then _
Console.WriteLine("warning: tan(left side of equation) <> 1") : ParseLine.Add(x) : Exit Function
t = t.Substring(p + 5)
For Each item As String In t.Split(")")
If item.Length > 5 Then
If (Not item.Contains("tan") OrElse item.IndexOf("a") < 0 OrElse
item.IndexOf("a") > item.IndexOf("tan")) AndAlso Not item.Contains("atn") Then
Console.WriteLine("warning: a term is mising a valid arctangent identifier on the right side of the equation: [{0})]", item)
ParseLine = New List(Of Term) : ParseLine.Add(New Term(1, BigRat.Zero)) : Exit Function
End If
x.c = 1 : x.br = New BigRat(BigRat.One)
p = item.IndexOf("/") : If p > 0 Then
x.br.de = UInt64.Parse(item.Substring(p + 1))
item = item.Substring(0, p)
p = item.IndexOf("(") : If p > 0 Then
x.br.nu = UInt64.Parse(item.Substring(p + 1))
p = item.IndexOf("a") : If p > 0 Then
Integer.TryParse(item.Substring(0, p).Replace("*", ""), x.c)
If x.c = 0 Then x.c = 1
If item.Contains("-") AndAlso x.c > 0 Then x.c = -x.c
End If
ParseLine.Add(x)
End If
End If
End If
Next
End Function
Sub Main(ByVal args As String())
Dim nl As String = vbLf
For Each item In ("pi/4 = ATan(1 / 2) + ATan(1/3)" & nl &
"pi/4 = 2Atan(1/3) + ATan(1/7)" & nl &
"pi/4 = 4ArcTan(1/5) - ATan(1 / 239)" & nl &
"pi/4 = 5arctan(1/7) + 2 * atan(3/79)" & nl &
"Pi/4 = 5ATan(29/278) + 7*ATan(3/79)" & nl &
"pi/4 = atn(1/2) + ATan(1/5) + ATan(1/8)" & nl &
"PI/4 = 4ATan(1/5) - Atan(1/70) + ATan(1/99)" & nl &
"pi /4 = 5*ATan(1/7) + 4 ATan(1/53) + 2ATan(1/4443)" & nl &
"pi / 4 = 6ATan(1/8) + 2arctangent(1/57) + ATan(1/239)" & nl &
"pi/ 4 = 8ATan(1/10) - ATan(1/239) - 4ATan(1/515)" & nl &
"pi/4 = 12ATan(1/18) + 8ATan(1/57) - 5ATan(1/239)" & nl &
"pi/4 = 16 * ATan(1/21) + 3ATan(1/239) + 4ATan(3/1042)" & nl &
"pi/4 = 22ATan(1/28) + 2ATan(1/443) - 5ATan(1/1393) - 10 ATan( 1 / 11018 )" & nl &
"pi/4 = 22ATan(1/38) + 17ATan(7/601) + 10ATan(7 / 8149)" & nl &
"pi/4 = 44ATan(1/57) + 7ATan(1/239) - 12ATan(1/682) + 24ATan(1/12943)" & nl &
"pi/4 = 88ATan(1/172) + 51ATan(1/239) + 32ATan(1/682) + 44ATan(1/5357) + 68ATan(1/12943)" & nl &
"pi/4 = 88ATan(1/172) + 51ATan(1/239) + 32ATan(1/682) + 44ATan(1/5357) + 68ATan(1/12944)").Split(nl)
Console.WriteLine("{0}: {1}", If(Sum(ParseLine(item)) = BigRat.One, "Pass", "Fail"), item)
Next
End Sub
End Module</syntaxhighlight>
{{out}}
<pre>Pass: pi/4 = ATan(1 / 2) + ATan(1/3)
Pass: pi/4 = 2Atan(1/3) + ATan(1/7)
Pass: pi/4 = 4ArcTan(1/5) - ATan(1 / 239)
Pass: pi/4 = 5arctan(1/7) + 2 * atan(3/79)
Pass: pi/4 = 5ATan(29/278) + 7*ATan(3/79)
Pass: pi/4 = atn(1/2) + ATan(1/5) + ATan(1/8)
Pass: pi/4 = 4ATan(1/5) - Atan(1/70) + ATan(1/99)
Pass: pi /4 = 5*ATan(1/7) + 4 ATan(1/53) + 2ATan(1/4443)
Pass: pi / 4 = 6ATan(1/8) + 2arctangent(1/57) + ATan(1/239)
Pass: pi/ 4 = 8ATan(1/10) - ATan(1/239) - 4ATan(1/515)
Pass: pi/4 = 12ATan(1/18) + 8ATan(1/57) - 5ATan(1/239)
Pass: pi/4 = 16 * ATan(1/21) + 3ATan(1/239) + 4ATan(3/1042)
Pass: pi/4 = 22ATan(1/28) + 2ATan(1/443) - 5ATan(1/1393) - 10 ATan( 1 / 11018 )
Pass: pi/4 = 22ATan(1/38) + 17ATan(7/601) + 10ATan(7 / 8149)
Pass: pi/4 = 44ATan(1/57) + 7ATan(1/239) - 12ATan(1/682) + 24ATan(1/12943)
Pass: pi/4 = 88ATan(1/172) + 51ATan(1/239) + 32ATan(1/682) + 44ATan(1/5357) + 68ATan(1/12943)
Fail: pi/4 = 88ATan(1/172) + 51ATan(1/239) + 32ATan(1/682) + 44ATan(1/5357) + 68ATan(1/12944)</pre>
=={{header|Clojure}}==
Clojure automatically handles ratio of numbers as fractions
Line 390 ⟶ 715:
} = 10092...08223/10092...39711
</pre>
=={{header|GAP}}==
The formula is entered as a list of pairs [k, x], where each pair means k*atan(x), and all the terms in the list are summed. Like most other solutions, the program will only check that the tangent of the resulting sum is 1. For instance, <code>Check([[5, 1/2], [5, 1/3]]);</code> returns also <code>true</code>, though the result is 5pi/4.
Line 2,392 ⟶ 2,545:
bad: pi/4 = 88*atan(1/172) + 51*atan(1/239) + 32*atan(1/682) + 44*atan(1/5357) + 67.9999999994*atan(1/12943)
</pre>
=={{header|RPL}}==
RPL does not support fat integers, therefore fat fractions neither, but the precision of floating-point numbers is actually sufficient to detect the incorrect formula and validate the other ones without using any trigonometric function. The 17 formulas to be checked are stored as strings in a global variable; each string is converted into a list of coefficients and real numbers, on which <code>tan(a+b)=(tan(a)+tan(b))/(1-tan(a)*tan(b))</code> is recursively applied, in a similar way to other languages.
{ "1*arctan(1/2) + 1*arctan(1/3)"
"2*arctan(1/3) + 1*arctan(1/7)"
"4*arctan(1/5) + -1*arctan(1/239)"
"5*arctan(1/7) + 2*arctan(3/79)"
"5*arctan(29/278) + 7*arctan(3/79)"
"1*arctan(1/2) + 1*arctan(1/5) + 1*arctan(1/8)"
"4*arctan(1/5) + -1*arctan(1/70) + 1*arctan(1/99)"
"5*arctan(1/7) + 4*arctan(1/53) + 2*arctan(1/4443)"
"6*arctan(1/8) + 2*arctan(1/57) + 1*arctan(1/239)"
"8*arctan(1/10) + -1*arctan(1/239) + -4*arctan(1/515)"
"12*arctan(1/18) + 8*arctan(1/57) + -5*arctan(1/239)"
"16*arctan(1/21) + 3*arctan(1/239) + 4*arctan(3/1042)"
"22*arctan(1/28) + 2*arctan(1/443) + -5*arctan(1/1393) + -10*arctan(1/11018)"
"22*arctan(1/38) + 17*arctan(7/601) + 10*arctan(7/8149)"
"44*arctan(1/57) + 7*arctan(1/239) + -12*arctan(1/682) + 24*arctan(1/12943)"
"88*arctan(1/172) + 51*arctan(1/239) + 32*arctan(1/682) + 44*arctan(1/5357) + 68*arctan(1/12943)"
"88*arctan(1/172) + 51*arctan(1/239) + 32*arctan(1/682) + 44*arctan(1/5357) + 68*arctan(1/12944)"
} ''''Formulas'''' STO
{{works with|Halcyon Calc|4.2.7}}
{| class="wikitable"
! RPL code
! Comment
|-
|
≪
IF DUP 1 == THEN DROP
ELSE IF DUP 0 < THEN NEG '''TanEval''' NEG
ELSE DUP2 2 / IP '''TanEval''' ROT ROT
DUP 2 / IP - '''TanEval'''
+ LAST * 1 - NEG /
END END
≫ ‘'''TanEval'''’ STO
≪
DUP 2 GET →NUM OVER 1 GET →NUM '''TanEval''' SWAP
IF DUP SIZE 3 ≥ THEN
LIST→ 2 - →LIST ROT ROT DROP2
'''TanSum''' SWAP + LAST * 1 - NEG /
ELSE DROP END
≫ ‘'''TanSum'''’ STO
≪ DUP "+" POS → eq op
≪ IF op THEN eq op 1 + OVER SIZE SUB eq 1 op 1 - SUB
ELSE "" eq END
"'" DUP ROT SWAP + + STR→
≫ ≫ ''''PopTerm'''' STO
≪
{} SWAP WHILE DUP "" ≠ REPEAT
'''PopTerm'''
ROT OVER 1 EXGET + SWAP DUP SIZE 1 - EXGET + SWAP
END DROP
≫ ‘'''ParsExp'''’ STO
≪ 1 CF 0
1 '''Formulas''' SIZE FOR f
'''Formulas''' f GET '''ParsExp TanSum'''
IF RND 1 == THEN 1 +
ELSE
1 SF "INCORRECT: π/4 ≠ "
'''Formulas''' f GET + SWAP
END NEXT
→STR IF 1 FS? THEN " others" + END " OK" +
≫ ‘'''TASK'''’ STO
|
'''TanEval''' ''( f c -- tan(c*arctan(f)) )''
if c = 1 then return f
else if c < 0 then return -tan(-c*arctan(f))
else put a = tan((c%2)*arctan(f)) at stack level 3
get b = tan((c-c%2)*arctan(f))
return (a+b)/(-(a*b-1))
'''TanSum''' ''( { c1 f1 .. cn fn } -- result )''
Get tan(c1*arctan(f1))
if input list > 2 items
make { c2 f2 .. cn fn }
evaluate tan of { c2..fn } and add it to
otherwise drop empty list
'''PopTerm''' ''( "T1+T2+..+Tn" -- "T2+..+Tn" 'T1' )''
If input string contains "+" then split it
else string contains only the last term
convert term into algebraic expression
'''ParsExp''' ''( "Machin formula" -- { c1 f1 .. cn fn } )''
Scan the formula
extract next term
extract c and f
Drop empty string
Initialize flag and counter
Scan list of formulas
evaluate tan(formula)
if ok, increase counter
else
build error message
with incorrect formula
Finalize report
|}
{{out}}
<pre>
2: "INCORRECT: π/4 ≠ 88*arctan(1/172) + 51*arctan(1/239) + 32*arctan(1/682) + 44*arctan(1/5357) + 68*arctan(1/12944)"
1: "16 others OK"
</pre>
=={{header|Seed7}}==
<syntaxhighlight lang="seed7">$ include "seed7_05.s7i";
Line 2,485 ⟶ 2,752:
FALSE: pi/4 = +88*arctan(1/172)+51*arctan(1/239)+32*arctan(1/682)+44*arctan(1/5357)+68*arctan(1/12944)
</pre>
=={{header|Sidef}}==
{{trans|Python}}
Line 2,669 ⟶ 2,937:
No! 'pi/4 = 88*arctan(1/172) + 51*arctan(1/239) + 32*arctan(1/682) + 44*arctan(1/5357) + 68*arctan(1/12944)' not true
</pre>
=={{header|Wren}}==
{{trans|Kotlin}}
Line 2,823 ⟶ 2,942:
{{libheader|Wren-fmt}}
We already have a BigRat class so we use that.
<syntaxhighlight lang="
import "./fmt" for Fmt
/** represents a term of the form: c * atan(n / d) */
Line 2,916 ⟶ 3,035:
false: 1 == tan(88*atan(1/172) + 51*atan(1/239) + 32*atan(1/682) + 44*atan(1/5357) + 68*atan(1/12944))
</pre>
=={{header|XPL0}}==
<syntaxhighlight lang="xpl0">code ChOut=8, Text=12; \intrinsic routines
| |||