RosettaCodeData/Task/Metallic-ratios/FreeBASIC/metallic-ratios.basic

83 lines
2.1 KiB
Plaintext

' version 01-11-2024
' compile with: fbc -s console
#Include Once "gmp.bi"
#Include Once "crt\stdio.bi"
#Define prec 32
Dim Shared As String ratio_names(0 To 9)
For x As Integer = 0 To 9
Read ratio_names(x)
Next
Data "Platinum", "Golden", "Silver", "Bronze", "Copper"
Data "Nickel", "Aluminium", "Iron", "Tin", "Lead"
Sub lucas(b As UInteger)
Print Using "Lucas sequence for & ratio, where b = #";ratio_names(b); b
Dim As UInteger i, l0 = 1, l1 = 1, l2
Print "First 15 elements are 1, 1";
For i = 1 To 13
l2 = b * l1 + l0
Print ", "; l2;
Swap l0, l1
Swap l1, l2
Next
Print
End Sub
Sub metallic_ratio(b As UInteger, pr As UInteger)
Dim As UInteger i, dp
Dim As String str1
Dim As ZString Ptr gmp_str : gmp_str = Allocate(100)
Dim As mpf_ptr bb, l0, l1, l2, ra
bb = Allocate(Len(__Mpf_struct)) : Mpf_init2(bb, pr * 4)
l0 = Allocate(Len(__Mpf_struct)) : Mpf_init2(l0, pr * 4)
l1 = Allocate(Len(__Mpf_struct)) : Mpf_init2(l1, pr * 4)
l2 = Allocate(Len(__Mpf_struct)) : Mpf_init2(l2, pr * 4)
ra = Allocate(Len(__Mpf_struct)) : Mpf_init2(ra, pr * 4)
mpf_set_ui(bb, b)
mpf_set_ui(l0, 1)
mpf_set_ui(l1, 1)
mpf_div(ra, l1, l0)
Gmp_sprintf(gmp_str, "%.*Ff", pr, ra)
str1 = *gmp_str
Do
i += 1
mpf_mul(l2, bb, l1)
mpf_add(l2, l2, l0)
mpf_div(ra, l2, l1)
Gmp_sprintf(gmp_str, "%.*Ff", pr, ra)
If str1 = *gmp_str Then
Print "Value to "; Str(pr); " dp after "; Str(i); " iteration"; IIf(i < 2, "", "s"); ": ";
If pr = 256 Then print
If i = 1 Then Print Trim(Trim(str1,"0"), ".") Else Print str1
Print
mpf_clears(bb, l0, l1, l2, ra, NULL)
DeAllocate(gmp_str)
Return
End If
str1 = *gmp_str
mpf_swap(l0, l1)
mpf_swap(l1, l2)
Loop
End Sub
' ------=< MAIN >=------
For x As Integer = 0 To 9
lucas(x)
metallic_ratio(x, prec)
Next
Print "Golden ratio, where b = 1"
metallic_ratio(1, 256)
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End