Is there an algorithm, to find values ​of a polynomial with big integers, quickly without loops? - vb.net

For example, if I want to find
1085912312763120759250776993188102125849391224162 = a^9+b^9+c^9+d
the code needs to brings
a=3456
b=78525
c=217423
d=215478
I do not need specific values, only that they comply with the fact that a, b and c have 6 digits at most and d is as small as possible.
Is there a quick way to find it?
I appreciate any help you can give me.
I have tried with nested loops but it is extremely slow and the code gets stuck.
Any help in VB or other code would be appreciated. I think the structure is more important than the language in this case
Imports System.Numerics
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim Value As BigInteger = BigInteger.Parse("1085912312763120759250776993188102125849391224162")
Dim powResult As BigInteger
Dim dResult As BigInteger
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
For i = 1 To 999999
For j = 1 To 999999
For k = 1 To 999999
powResult = BigInteger.Add(BigInteger.Add(BigInteger.Pow(i, 9), BigInteger.Pow(j, 9)), BigInteger.Pow(k, 9))
dResult = BigInteger.Subtract(Value, powResult)
If Len(dResult.ToString) <= 6 Then
a = i
b = j
c = k
d = dResult
RichTextBox1.Text = a & " , " & b & " , " & c & " , " & d
Exit For
Exit For
Exit For
End If
Next
Next
Next
End Sub
End Class
UPDATE
I wrote the code in vb. But with this code, a is correct, b is correct but c is incorrect, and the result is incorrect.
a^9 + b^9 + c^9 + d is a number bigger than the initial value.
The code should brings
a= 217423
b= 78525
c= 3456
d= 215478
Total Value is ok= 1085912312763120759250776993188102125849391224162
but code brings
a= 217423
b= 78525
c= 65957
d= 70333722607339201875244531009974
Total Value is bigger and not equal=1085935936469985777155428248430866412402362281319
Whats i need to change in the code to make c= 3456 and d= 215478?
the code is
Imports System.Numerics
Public Class Form1
Private Function pow9(x As BigInteger) As BigInteger
Dim y As BigInteger
y = x * x ' x^2
y *= y ' x^4
y *= y ' x^8
y *= x ' x^9
Return y
End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim a, b, c, d, D2, n As BigInteger
Dim aa, bb, cc, dd, ae As BigInteger
D2 = BigInteger.Parse("1085912312763120759250776993188102125849391224162")
'first solution so a is maximal
d = D2
'a = BigIntegerSqrt(D2)
'RichTextBox1.Text = a.ToString
For a = 1 << ((Convert.ToInt32(Math.Ceiling(BigInteger.Log(d, 2))) + 8) / 9) To a > 0 Step -1
If (pow9(a) <= d) Then
d -= pow9(a)
Exit For
End If
Next
For b = 1 << ((Convert.ToInt32(Math.Ceiling(BigInteger.Log(d, 2))) + 8) / 9) To b > 0 Step -1
If (pow9(b) <= d) Then
d -= pow9(b)
Exit For
End If
Next
For c = 1 << ((Convert.ToInt32(Math.Ceiling(BigInteger.Log(d, 2))) + 8) / 9) To c > 0 Step -1
If (pow9(c) <= d) Then
d -= pow9(c)
Exit For
End If
Next
' minimize d
aa = a
bb = b
cc = c
dd = d
If (aa < 10) Then
ae = 0
Else
ae = aa - 10
End If
For a = aa - 1 To a > ae Step -1 'a goes down few iterations
d = D2 - pow9(a)
For n = 1 << ((Convert.ToInt32(Math.Ceiling(BigInteger.Log(d, 2))) + 8) / 9) To b < n 'b goes up
If (pow9(b) >= d) Then
b = b - 1
d -= pow9(b)
Exit For
End If
Next
For c = 1 << ((Convert.ToInt32(Math.Ceiling(BigInteger.Log(d, 2))) + 8) / 9) To c > 0 Step -1 'c must be search fully
If pow9(c) <= d Then
d -= pow9(c)
Exit For
End If
Next
If d < dd Then 'remember better solution
aa = a
bb = b
cc = c
dd = d
End If
If a < ae Then
Exit For
End If
Next
a = aa
b = bb
c = cc
d = dd
' a,b,c,d is the result
RichTextBox1.Text = D2.ToString
Dim Sum As BigInteger
Dim a9 As BigInteger
Dim b9 As BigInteger
Dim c9 As BigInteger
a9 = BigInteger.Pow(a, 9)
b9 = BigInteger.Pow(b, 9)
c9 = BigInteger.Pow(c, 9)
Sum = BigInteger.Add(BigInteger.Add(BigInteger.Add(a9, b9), c9), d)
RichTextBox2.Text = Sum.ToString
Dim Subst As BigInteger
Subst = BigInteger.Subtract(Sum, D2)
RichTextBox3.Text = Subst.ToString
End Sub
End Class

[Update]
The below code is an attempt to solve a problem like OP's, yet I erred in reading it.
The below is for 1085912312763120759250776993188102125849391224162 = a^9+b^9+c^9+d^9+e and to minimize e.
Just became too excite about OP's interesting conundrum and read too quick.
I review this more later.
OP's approach is O(N*N*N*N) - slow
Below is a O(N*N*log(N)) one.
Algorithm
Let N = 1,000,000. (Looks like 250,000 is good enough for OP's sum of 1.0859e48.)
Define 160+ wide integer math routines.
Define type: pow9
int x,y,
int160least_t z
Form array pow9 a[N*N] populated with x, y, x^9 + y^9, for every x,y in the [1...N] range.
Sort array on z.
Cost so far O(N*N*log(N).
For array elements indexed [0... N*N/2] do a binary search for another array element such that the sum is 1085912312763120759250776993188102125849391224162
Sum closest is the answer.
Time: O(N*N*log(N))
Space: O(N*N)
Easy to start with FP math and then later get a better answer with crafter extended integer math.
Try with smaller N and total sum targets to iron out implementation issues.

In case a,b,c,d might be zero I got an Idea for fast and simple solution:
First something better than brute force search of a^9 + d = x so that a is maximal (that ensures minimal d)...
let d = 1085912312763120759250776993188102125849391224162
find max value a such that a^9 <= d
this is simple as we know 9th power will multiply the bitwidth of operand 9 times so the max value can be at most a <= 2^(log2(d)/9) Now just search all numbers from this number down to zero (decrementing) until its 9th power is less or equal to x. This value will be our a.
Its still brute force search however from much better starting point so much less iterations are required.
We also need to update d so let
d = d - a^9
Now just find b,c in the same way (using smaller and smaller remainder d)... these searches are not nested so they are fast ...
b^9 <= d; d-=b^9;
c^9 <= d; c-=b^9;
To improve speed even more you can hardcode the 9th power using power by squaring ...
This will be our initial solution (on mine setup it took ~200ms with 32*8 bits uints) with these results:
x = 1085912312763120759250776993188102125849391224162
1085912312763120759250776993188102125849391224162 (reference)
a = 217425
b = 65957
c = 22886
d = 39113777348346762582909125401671564
Now we want to minimize d so simply decrement a and search b upwards until still a^9 + b^9 <= d is lower. Then search c as before and remember better solution. The a should be search downwards to meet b in the middle but as both a and bhave the same powers only few iterations might suffice (I used 50) from the first solution (but I have no proof of this its just my feeling). But still even if full range is used this has less complexity than yours as I have just 2 nested fors instead of yours 3 and they all are with lower ranges...
Here small working C++ example (sorry do not code in BASIC for decades):
//---------------------------------------------------------------------------
typedef uint<8> bigint;
//---------------------------------------------------------------------------
bigint pow9(bigint &x)
{
bigint y;
y=x*x; // x^2
y*=y; // x^4
y*=y; // x^8
y*=x; // x^9
return y;
}
//---------------------------------------------------------------------------
void compute()
{
bigint a,b,c,d,D,n;
bigint aa,bb,cc,dd,ae;
D="1085912312763120759250776993188102125849391224162";
// first solution so a is maximal
d=D;
for (a=1<<((d.bits()+8)/9);a>0;a--) if (pow9(a)<=d) break; d-=pow9(a);
for (b=1<<((d.bits()+8)/9);b>0;b--) if (pow9(b)<=d) break; d-=pow9(b);
for (c=1<<((d.bits()+8)/9);c>0;c--) if (pow9(c)<=d) break; d-=pow9(c);
// minimize d
aa=a; bb=b; cc=c; dd=d;
if (aa<50) ae=0; else ae=aa-50;
for (a=aa-1;a>ae;a--) // a goes down few iterations
{
d=D-pow9(a);
for (n=1<<((d.bits()+8)/9),b++;b<n;b++) if (pow9(b)>=d) break; b--; d-=pow9(b); // b goes up
for (c=1<<((d.bits()+8)/9);c>0;c--) if (pow9(c)<=d) break; d-=pow9(c); // c must be search fully
if (d<dd) // remember better solution
{
aa=a; bb=b; cc=c; dd=d;
}
}
a=aa; b=bb; c=cc; d=dd; // a,b,c,d is the result
}
//-------------------------------------------------------------------------
The function bits() just returns number of occupied bits (similar to log2 but much faster). Here final results:
x = 1085912312763120759250776993188102125849391224162
1085912312763120759250776993188102125849391224162 (reference)
a = 217423
b = 78525
c = 3456
d = 215478
It took 1689.651 ms ... As you can see this is much faster than yours however I am not sure with the number of search iterations while fine tuning ais OK or it should be scaled by a/b or even full range down to (a+b)/2 which will be much slower than this...
One last thing I did not bound a,b,c to 999999 so if you want it you just add if (a>999999) a=999999; statement after any a=1<<((d.bits()+8)/9)...
[Edit1] adding binary search
Ok now all the full searches for 9th root (except of the fine tunnig of a) can be done with binary search which will improve speed a lot more while ignoring bigint multiplication complexity leads to O(n.log(n)) against your O(n^3)... Here updated code (will full iteration of a while fitting so its safe):
//---------------------------------------------------------------------------
typedef uint<8> bigint;
//---------------------------------------------------------------------------
bigint pow9(bigint &x)
{
bigint y;
y=x*x; // x^2
y*=y; // x^4
y*=y; // x^8
y*=x; // x^9
return y;
}
//---------------------------------------------------------------------------
bigint binsearch_max_pow9(bigint &d) // return biggest x, where x^9 <= d, and lower d by x^9
{ // x = floor(d^(1/9)) , d = remainder
bigint m,x;
for (m=bigint(1)<<((d.bits()+8)/9),x=0;m.isnonzero();m>>=1)
{ x|=m; if (pow9(x)>d) x^=m; }
d-=pow9(x);
return x;
}
//---------------------------------------------------------------------------
void compute()
{
bigint a,b,c,d,D,n;
bigint aa,bb,cc,dd;
D="1085912312763120759250776993188102125849391224162";
// first solution so a is maximal
d=D;
a=binsearch_max_pow9(d);
b=binsearch_max_pow9(d);
c=binsearch_max_pow9(d);
// minimize d
aa=a; bb=b; cc=c; dd=d;
for (a=aa-1;a>=b;a--) // a goes down few iterations
{
d=D-pow9(a);
for (n=1<<((d.bits()+8)/9),b++;b<n;b++) if (pow9(b)>=d) break; b--; d-=pow9(b); // b goes up
c=binsearch_max_pow9(d);
if (d<dd) // remember better solution
{
aa=a; bb=b; cc=c; dd=d;
}
}
a=aa; b=bb; c=cc; d=dd; // a,b,c,d is the result
}
//-------------------------------------------------------------------------
function m.isnonzero() is the same as m!=0 just faster... The results are the same as above code but the time duration is only 821 ms for full iteration of a which would be several thousands seconds with previous code.
I think except using some polynomial discrete math trick I do not know of there is only one more thing to improve and that is to compute consequent pow9 without multiplication which will boost the speed a lot (as bigint multiplication is slowest operation by far) like I did in here:
How to get a square root for 32 bit input in one clock cycle only?
but I am too lazy to derive it...

Related

BigInteger Innacuracy

In the following project euler program #56, Considering natural numbers of the form, a^b, where a, b < 100, what is the maximum digital sum?
so I wrote the following code:
Dim num As System.Numerics.BigInteger
Dim s As String
Dim sum As Integer
Dim record As Integer
For a = 2 To 99
For b = 1 To 99
num = a ^ b
s = num.ToString
For i = 0 To s.Length - 1
sum += CInt(s.Substring(i, 1))
Next
sum = 0
Next
Next
The answer I got from the program was not the correct answer, so I wrote the following code so I can see what numbers set a new high value and see if something is wrong.
If sum > record Then
record = sum
Console.WriteLine(a & "," & b)
End If
One of the answers was a=10 b= 81. Obviously that doesn't make sense, because that value is 1 + 81 "0" = 1, but watching the result of 10^81, was 999999999999999921281879895665782741935503249059183851809998224123064148429897728
I searched about the accuracy of BigInteger but couldn't find anything, is there something that I'm missing?

VBA: Testing for perfect cubes

I'm trying to write a simple function in VBA that will test a real value and output a string result if it's a perfect cube. Here's my code:
Function PerfectCubeTest(x as Double)
If (x) ^ (1 / 3) = Int(x) Then
PerfectCubeTest = "Perfect"
Else
PerfectCubeTest = "Flawed"
End If
End Function
As you can see, I'm using a simple if statement to test if the cube root of a value is equal to its integer portion (i.e. no remainder). I tried testing the function with some perfect cubes (1, 8, 27, 64, 125), but it only works for the number 1. Any other value spits out the "Flawed" case. Any idea what's wrong here?
You are testing whether the cube is equal to the double supplied.
So for 8 you would be testing whether 2 = 8.
EDIT: Also found a floating point issue. To resolve we will round the decimals a little to try and overcome the issue.
Change to the following:
Function PerfectCubeTest(x As Double)
If Round((x) ^ (1 / 3), 10) = Round((x) ^ (1 / 3), 0) Then
PerfectCubeTest = "Perfect"
Else
PerfectCubeTest = "Flawed"
End If
End Function
Or (Thanks to Ron)
Function PerfectCubeTest(x As Double)
If CDec(x ^ (1 / 3)) = Int(CDec(x ^ (1 / 3))) Then
PerfectCubeTest = "Perfect"
Else
PerfectCubeTest = "Flawed"
End If
End Function
#ScottCraner correctly explains why you were getting incorrect results, but there are a couple other things to point out here. First, I'm assuming that you are taking a Double as input because the range of acceptable numbers is higher. However, by your implied definition of a perfect cube only numbers with an integer cube root (i.e. it would exclude 3.375) need to be evaluated. I'd just test for this up front to allow an early exit.
The next issue you run into is that 1 / 3 can't be represented exactly by a Double. Since you're raising to the inverse power to get your cube root you're also compounding the floating point error. There's a really easy way to avoid this - take the cube root, cube it, and see if it matches the input. You get around the rest of the floating point errors by going back to your definition of a perfect cube as an integer value - just round the cube root to both the next higher and next lower integer before you re-cube it:
Public Function IsPerfectCube(test As Double) As Boolean
'By your definition, no non-integer can be a perfect cube.
Dim rounded As Double
rounded = Fix(test)
If rounded <> test Then Exit Function
Dim cubeRoot As Double
cubeRoot = rounded ^ (1 / 3)
'Round both ways, then test the cube for equity.
If Fix(cubeRoot) ^ 3 = rounded Then
IsPerfectCube = True
ElseIf (Fix(cubeRoot) + 1) ^ 3 = rounded Then
IsPerfectCube = True
End If
End Function
This returned the correct result up to 1E+27 (1 billion cubed) when I tested it. I stopped going higher at that point because the test was taking so long to run and by that point you're probably outside of the range that you would reasonably need it to be accurate.
For fun, here is an implementation of a number-theory based method described here . It defines a Boolean-valued (rather than string-valued) function called PerfectCube() that tests if an integer input (represented as a Long) is a perfect cube. It first runs a quick test which throws away many numbers. If the quick test fails to classify it, it invokes a factoring-based method. Factor the number and check if the multiplicity of each prime factor is a multiple of 3. I could probably optimize this stage by not bothering to find the complete factorization when a bad factor is found, but I had a VBA factoring algorithm already lying around:
Function DigitalRoot(n As Long) As Long
'assumes that n >= 0
Dim sum As Long, digits As String, i As Long
If n < 10 Then
DigitalRoot = n
Exit Function
Else
digits = Trim(Str(n))
For i = 1 To Len(digits)
sum = sum + Mid(digits, i, 1)
Next i
DigitalRoot = DigitalRoot(sum)
End If
End Function
Sub HelperFactor(ByVal n As Long, ByVal p As Long, factors As Collection)
'Takes a passed collection and adds to it an array of the form
'(q,k) where q >= p is the smallest prime divisor of n
'p is assumed to be odd
'The function is called in such a way that
'the first divisor found is automatically prime
Dim q As Long, k As Long
q = p
Do While q <= Sqr(n)
If n Mod q = 0 Then
k = 1
Do While n Mod q ^ k = 0
k = k + 1
Loop
k = k - 1 'went 1 step too far
factors.Add Array(q, k)
n = n / q ^ k
If n > 1 Then HelperFactor n, q + 2, factors
Exit Sub
End If
q = q + 2
Loop
'if we get here then n is prime - add it as a factor
factors.Add Array(n, 1)
End Sub
Function factor(ByVal n As Long) As Collection
Dim factors As New Collection
Dim k As Long
Do While n Mod 2 ^ k = 0
k = k + 1
Loop
k = k - 1
If k > 0 Then
n = n / 2 ^ k
factors.Add Array(2, k)
End If
If n > 1 Then HelperFactor n, 3, factors
Set factor = factors
End Function
Function PerfectCubeByFactors(n As Long) As Boolean
Dim factors As Collection
Dim f As Variant
Set factors = factor(n)
For Each f In factors
If f(1) Mod 3 > 0 Then
PerfectCubeByFactors = False
Exit Function
End If
Next f
'if we get here:
PerfectCubeByFactors = True
End Function
Function PerfectCube(n As Long) As Boolean
Dim d As Long
d = DigitalRoot(n)
If d = 0 Or d = 1 Or d = 8 Or d = 9 Then
PerfectCube = PerfectCubeByFactors(n)
Else
PerfectCube = False
End If
End Function
Fixed the integer division error thanks to #Comintern. Seems to be correct up to 208064 ^ 3 - 2
Function isPerfectCube(n As Double) As Boolean
n = Abs(n)
isPerfectCube = n = Int(n ^ (1 / 3) - (n > 27)) ^ 3
End Function

Finding the x intercept of a 4th degree polynomial using small increments

I am trying to find the x intercept of a 4th degree function by incrementing the x value. I feel like this way doesnt work always and isnt the most efficient way to do this, is there another way I am missing?
My code is:
Sub Findintercept()
Dim equation As Double, x As Double, A As Double, B As Double, C As Double, D As Double, E As Double
A = 0.000200878
B = -0.002203704
C = 0.0086
D = -0.02333
E = 0.02033
x = 0
equation = A * x ^ 4 + B * x ^ 3 + C * x ^ 2 + D * x + E
While (equation > 0.00001 Or equation < -0.00001)
If (x > 5) Then
MsgBox "Could not find intercept"
equation = 0
Else
x = x + 0.0001
equation = A * x ^ 4 + B * x ^ 3 + C * x ^ 2 + D * x + E
End If
Wend
MsgBox x
End Sub
Sometimes it fails to find the intercept hence the IF condition in the while loop. (Im always expecting the intercept to be less than 5!
Your method suffers from two problems:
You assume a step size to change x. The step could be too large, causing you to "walk past" the value your are looking for. To deal with this, you make a small step size, which can mean an excessively large number of iterations are needed to find the solution.
You always assume the same direction to change x. Even with seemingly small values for your step size, you could "walk past" the solution, and have no means to change direction. Or, your initial guess may be on the wrong side of the solution, and you never find an answer.
The Newton-Raphson method handles both of these issues neatly. You do still need to choose your initial guess somewhat close to the root you are looking for.
This method does have potential problems, but for polynomials such as the one you are dealing with, it is quite good.
Below is a simple VBA sub that implements this method. It solves your problem in 4 iterations. I recommend adjusting the initial guess (xii) a lot to see how it impacts the solution you get.
Sub SimpleNewtonRaphson()
Const Tol As Double = 1E-06
Const MaxIter As Long = 50
Dim xi As Double, xii As Double, deriv As Double
Dim IterCount As Long
' Initialize
xi = 0#
xii = 1#
IterCount = 0
' Method
Do While IterCount < MaxIter And Abs(xii - xi) > Tol
xi = xii
deriv = myDeriv(xi)
If deriv = 0# Then Exit Do
xii = xi - myFunc(xi) / deriv
IterCount = IterCount + 1
Loop
' Results
If deriv = 0 Then MsgBox "Ran into a 0 derivative, modify initial guess"
If IterCount >= MaxIter Then MsgBox "MaxIterations reached"
If Abs(xii - xi) <= Tol Then MsgBox "Solution found #" & vbCrLf & "F(" & xii & ") = " & myFunc(xii)
End Sub
... and two VBA functions for your equation and it's derivative ...
Function myFunc(x As Double) As Double
Const A As Double = 0.000200878
Const B As Double = -0.002203704
Const C As Double = 0.0086
Const D As Double = -0.02333
Const E = 0.02033
myFunc = A * x ^ 4 + B * x ^ 3 + C * x ^ 2 + D * x + E
End Function
Function myDeriv(x As Double) As Double
Const A As Double = 0.000200878
Const B As Double = -0.002203704
Const C As Double = 0.0086
Const D As Double = -0.02333
myDeriv = 4 * A * x ^ 3 + 3 * B * x ^ 2 + 2 * C * x + D
End Function

Visual Basic - False Position Root Finding

I'm trying to create a code that uses the false position method to find the roots of an equation. The equation is as follows:
y = x^(1.5sin⁡(x)) * e^(-x/7) + e^(x/10) - 4
I used a calculator to find the roots, and they are 6.9025, 8.8719, and 12.8079.
My VBA code is as follows:
Option Explicit
Function Func(x)
Func = (x ^ (1.5 * Sin(x))) * Exp(-x / 7) + Exp(x / 10) - 4
End Function
Function FalsePos(Guess1, Guess2)
Dim a, b, c As Single
Dim i As Integer
a = Guess1
b = Guess2
For i = 0 To 1000
c = a - Func(a) * (b - a) / (Func(b) - Func(a))
If (Func(c) < 0.00001) Then
i = 1001
Else
If Func(a) * Func(c) < 0 Then
b = c
Else
a = c
End If
End If
Next
FalsePos = c
End Function
My problem is that when I call the function and use for example 4 and 8 as my two guesses, the number it returns is 5.29 instead of the root between 4 and 8 which is 6.9025.
Is there something wrong with my code or am I just not understanding the false position method correctly?
You should use Double for precision with Maths problems. Three other notes about coding that you may not be aware of:
dim a, b, c as Single
will dim a and b as Variants, and c as a Single, and you can use Exit For to escape from a for loop, rather than setting the control variable out of the bounds. Finally, you should define the outputs of a Function by specifying As ... after the closing parenthesis.
You should use breakpoints (press F9 with the carrot in a line of code to breakpoint that line), then step through the code by pressing F8 to advance line-by-line to see what is happening, and keep your eye on the Locals window (Go to View > Locals)
This is the code with the above changes:
Function Func(x As Double) As Double
Func = (x ^ (1.5 * Sin(x))) * Exp(-x / 7) + Exp(x / 10) - 4
End Function
Function FalsePos(Guess1 As Double, Guess2 As Double) As Double
Dim a As Double, b As Double, c As Double
Dim i As Integer
a = Guess1
b = Guess2
For i = 0 To 1000
c = a - Func(a) * (b - a) / (Func(b) - Func(a))
If (Func(c) < 0.00001) Then
Exit For
Else
If Func(a) * Func(c) < 0 Then
b = c
Else
a = c
End If
End If
Next
FalsePos = c
End Function

Function to insert a specific formula excel VBA (decimal to fractional inches)

I have a list of distances that I would like to display like you would read off a tape measure, for example 144.125 would display as 144 1/8". I have the following formula
=TEXT(A1,"0"&IF(ABS(A1-ROUND(A1,0))>1/32,"0/"&CHOOSE(ROUND(MOD(A1,1)*16,0),16,8,16,4,16,8,16,2,16,8,16,4,16,8,16),""))&""""
I'd like to simplify it to a 1 argument function (for A1) so I could use it throughout the workbook, but the amount of " quotes and vba keywords is causing problems. Is there an easier way to get a UDF to insert a complicated formula?
If you want to use a UDF with visual basic then try this:
Public Function Fraction(ByVal x As Double, Optional ByVal tol As Double = 1 / 64#) As String
Dim s As Long, w As Long, d As Long, n As Long, f As Double
s = Sgn(x): x = Abs(x)
If s = 0 Then
Fraction = "0"
Exit Function
End If
w = CInt(WorksheetFunction.Floor_Precise(x)): f = x - w
d = CInt(WorksheetFunction.Floor_Precise(1 / tol)): n = WorksheetFunction.Round(f * d, 0)
Dim g As Long
Do
g = WorksheetFunction.Gcd(n, d)
n = n / g
d = d / g
Loop While Abs(g) > 1
Fraction = Trim(IIf(s < 0, "-", vbNullString) + CStr(w) + IIf(n > 0, " " + CStr(n) + "/" + CStr(d), vbNullString))
End Function
With results:
The TEXT function can do this directly:
A B
1 144,1250 144 1/8 "
Formula in B1:
=TEXT(A1;"# ??/??\""")
Greetings
Axel