Skin detection code always shows "Arithmetic overflow" - vb.net

Why this simple skin detection code always returns Message=Arithmetic operation resulted in an overflow.
xMax = bmp.Width - 1 : yMax = bmp.Height - 1
For y = 0 To yMax
For x = 0 To xMax
tmpColor = fixColor(bmp.GetPixel(x, y))
If (((tmpColor.R > 95) And (tmpColor.G > 40) And (tmpColor.B > 20) And (tmpColor.R - tmpColor.G > 15) And (tmpColor.R > tmpColor.G) And (tmpColor.R > tmpColor.B)) Or _
((tmpColor.R > 220) And (tmpColor.G > 210) And (tmpColor.B > 170) And (tmpColor.R - tmpColor.G <= 15) And (tmpColor.R > tmpColor.B) And (tmpColor.G > tmpColor.B))) Then bmp.SetPixel(x, y, Color.Black)
Next x
Next y

Assuming that tmpColor is defined as System.Color, an educated guess would be that, when this error occurs tmpColor.G is greater than tmpColor.R, which would render the result less than zero, and unable to be stored into a byte.
One possible solution would be to do this
Dim r as integer = tmpColor.R
Dim g as integer = tmpColor.G
Dim b as integer = tmpColor.B
and then use these new values within your calculation. It would make the code cleaner some (and much cleaner if you were to put casting within that if statement).
Another option would be to re-order the tests relying on that subtraction, and use the AndAlso operator:
(tmpColor.R - tmpColor.G > 15) And (tmpColor.R > tmpColor.G)
'To
(tmpColor.R > tmpColor.G) AndAlso (tmpColor.R - tmpColor.G > 15)
AndAlso is VB.Net's short-circuiting logical-and operator, and will cause evaluation of the expression to stop at the first False. As all you use is Ands, replacing them all with AndAlso might see a minor performance increase.
A combination of these two items might make the code more readable, overall.

Related

How to create a gap (empty points) in the chart series

I am trying to plot a chart using vb chart. There are some X values missing, which I would like to leave as a blank in the series plot. i.e, The X values start from 0.695, 0.7, 0.705, and so on. But there might be some gaps between them (example: 0.74, 0.745, 1.71, 1.715), which I would like leave as gaps (i.e. 0.745 to 1.71).
I was able to create an array of empty points, if that helps. Below is the code for the same.
Dim interval As Double = 0.0
Dim empty(0) As Double
Dim decimalpart As Integer = 0
interval = freq1(1) - freq1(0)
If interval.ToString().IndexOf(".") = -1 Then
decimalpart = 0 'No decimal part
Else
decimalpart = interval.ToString().Substring(interval.ToString().IndexOf(".") + 1).Length 'To find the number of decimal part
End If
y = 0
For i As Integer = 0 To freq1.Length - 2 'Dont need to access the last data. It would be accessed in the previous loop
If Math.Round((freq1(i + 1) - freq1(i)), decimalpart) > interval Then
empty(y) = freq1(i) + interval
y += 1
ReDim Preserve empty(y)
While (empty(y - 1) + interval < freq1(i + 1))
empty(y) = empty(y - 1) + interval
y += 1
ReDim Preserve empty(y)
End While
End If
Next
ReDim Preserve empty(y - 1)
The above code finds the interval and see if the next value is withing the interval range. Else it would find the values incremented using the interval value. freq1() is the array containing the X-axis values. However, I am not sure on how to remove the X axis values using empty(). (Not sure, if this could be done using Chart.Series().EmptyPointStyle)
I would like to show the gap appearing in the plot of the chart series.
I am not going to pretend what the code you have presented is doing, but showing a gap in a line plot for empty points is accomplished by setting the DataPoint.IsEmpty property to True.
Here is a simple example.
Dim s As New Series
s.ChartType = SeriesChartType.FastLine
s.Color = Color.Black
s.BorderWidth = 2
' make some points
For x As Double = 0.5 To 4 Step 0.025
Dim dp As New DataPoint(x, (2.0 * x + 3))
' apply some filtering criteria to set some points to empty
If dp.XValue >= 1.2 AndAlso dp.XValue < 1.5 Then dp.IsEmpty = True
If dp.XValue >= 3.1 AndAlso dp.XValue < 3.4 Then dp.IsEmpty = True
s.Points.Add(dp)
Next
Chart1.Series.Clear()
Chart1.Legends.Clear()
Chart1.Series.Add(s)
You can read more about this topic: Using Empty Data Points in Chart Controls

Which points are co-linear & in sequence (i.e. which two points I am between)

I have longitude and latitude of my position, and I have a list of positions that is ordered as a list of points(long/lat)) along a road. How do I find out which two points I am between?
If I just search for the two nearest points I will end up with P2 and P3 in my case in the picture.
I want to know how to find out that I'm between point p1 and p2.
The list of points I will search will be database rows containing latitude and longitude so pointers to how to build the sql-query, linq-query or pseudo code, everything that points me to the best solution is welcome. I'm new to geolocation and the math around it so treat me as an newbie. ;)
(The list of points will be ordered so P1 will have an id of 1, p2 will have an id of 2 and so on. )
Bear in mind that what you propose might become really complex (many points under equivalent conditions) and thus delivering an accurate algorithm would require (much) more work. Taking care of simpler situations (like the one in your picture) is not so difficult; you have to include the following:
Convert latitude/longitude values into cartesian coordinates (for ease of calculations; although you might even skip this step). In this link you can get some inspiration on this front; it is in C#, but the ideas are clear anyway.
Iterate through all the available points "by couples" and check whether the point to be analysed (Mypos), falls in the line formed by them, in an intermediate position. As shown in the code below, this calculation is pretty simple and thus you don't need to do any pre-filtering (looking for closer points before).
.
Dim point1() As Double = New Double() {0, 0} 'x,y
Dim point2() As Double = New Double() {0, 3}
Dim pointToCheck() As Double = New Double() {0.05, 2}
Dim similarityRatio As Double = 0.9
Dim minValSimilarDistance As Double = 0.001
Dim similarityDistance As Double = 0.5
Dim eq1 As Double = (point2(0) - point1(0)) * (pointToCheck(1) - point1(1))
Dim eq2 As Double = (point2(1) - point1(1)) * (pointToCheck(0) - point1(0))
Dim maxVal As Double = eq1
If (eq2 > eq1) Then maxVal = eq2
Dim inLine = False
Dim isInBetween As Boolean = False
If (eq1 = eq2 OrElse (maxVal > 0 AndAlso Math.Abs(eq1 - eq2) / maxVal <= (1 - similarityRatio))) Then
inLine = True
ElseIf (eq1 <= minValSimilarDistance AndAlso eq2 <= similarityDistance) Then
inLine = True
ElseIf (eq2 <= minValSimilarDistance AndAlso eq1 <= similarityDistance) Then
inLine = True
End If
If (inLine) Then
'pointToCheck part of the line formed by point1 and point2, but not necessarily between them
Dim insideX As Boolean = False
If (pointToCheck(0) >= point1(0) AndAlso pointToCheck(0) <= point2(0)) Then
insideX = True
Else If (pointToCheck(0) >= point2(0) AndAlso pointToCheck(0) <= point1(0)) Then
insideX = True
End If
if(insideX) Then
If (pointToCheck(1) >= point1(1) AndAlso pointToCheck(1) <= point2(1)) Then
isInBetween = True
ElseIf (pointToCheck(1) >= point2(1) AndAlso pointToCheck(1) <= point1(1)) Then
isInBetween = True
End If
End If
End If
If (isInBetween) Then
'pointToCheck is between point1 and point2
End If
As you can see, I have included various ratios allowing you to tweak the exact conditions (the points will, most likely, not be falling exactly in the line). similarityRatio accounts for "equations" being more or less similar (that is, X and Y values not exactly fitting within the line but close enough). similarityRatio cannot deal properly with cases involving zeroes (e.g., same X or Y), this is what minValSimilarDistance and similarityDistance are for. You can tune these values or just re-define the ratios (with respect to X/Y variations between points, instead of with respect to the "equations").
An equivalent solution in Scala for clarity:
def colinearAndInOrder(a: Point, b: Point, c: Point) = {
lazy val colinear: Boolean =
math.abs((a.lng - b.lng) * (a.lat - c.lat) -
(a.lng - c.lng) * (a.lat - b.lat)) <= 1e-9
lazy val bounded: Boolean =
((a.lat < b.lat && b.lat < c.lat) || (a.lat > b.lat && b.lat > c.lat)) &&
((a.lng < b.lng && b.lng < c.lng) || (a.lng > b.lng && b.lng > c.lng))
close(a,b) || close(b,c) || (colinear && bounded)
}
def close(a: Point, b: Point): Boolean = {
math.abs(a.lat - b.lng) <= 1e-4 && math.abs(a.lat - b.lng) <= 1e-4
}

VB.net loop through if-then statements?

I have written a private sub which gets the current time and works out which time bracket (from a timespan array) the current time falls into. Given that there are ten time brackets I'm testing for, the code is repetitive and only the integer index of the array and the result integer change between each if statement.
If DateTime.Now.TimeOfDay >= tmeToday(0) AndAlso DateTime.Now.TimeOfDay <= tmeToday(1) Then
intPeriodFrid = 0 'ext morning; 8am - 9am
intNextBell = 1
ElseIf DateTime.Now.TimeOfDay >= tmeToday(1) AndAlso DateTime.Now.TimeOfDay <= tmeToday(2) Then
intPeriodFrid = 1 'morning break; 9am - 9:05am
intNextBell = 2
... ridiculous amounts of repetition later
ElseIf DateTime.Now.TimeOfDay >= tmeToday(10) AndAlso DateTime.Now.TimeOfDay <= tmeToday(11) Then
intPeriodFrid = 10 'ext afternoon; 3:10pm - 4:10pm
intNextBell = 11
End If
Then it hit me I could probably do it like this:
For value As Integer = 0 To 10
If DateTime.Now.TimeOfDay >= tmeToday(value) AndAlso DateTime.Now.TimeOfDay <= tmeToday(value + 1) Then
intPeriodFrid = value
intNextBell = (value + 1)
Exit For
End If
Next
This would/will be my first ever use of a loop (I'm ten weeks into a VB.NET based course), so I lack confidence in this as a solution, will it work? Any weaknesses/problems I need to look out for if I implement this?

VBA if condition is true, however actually is false, what's wrong with it?

I wrote code in VBA to extract data from Access database to Excel based on some input parameters. When it comes to If statement, one of the criteria which exam the range of "Speed" variable is true, however, I checked that this criteria should be wrong.
For example, speed=49, VSP=1.5, 1<=Speed<25 in 1st if condition indicates true which is ridiculous, and VSP<0 indicates false, so it goes to 1st elseif condition, 1<=Speed<25 still indicates true and 0<= VSP<3 is also true, then function returns the value from Access database. Else, if speed=49, VSP=6.5, the function still executes the "ElseIf (1 <= Speed < 25) And (0 <= VSP < 3) Then, statement 2" part. It seems it only always regard 1st elseif condition as true.
What's wrong with my if statement? Any advice?
Code:
Function F (ByVal Speed, VSP as single)
.............
If (1 <= Speed < 25) And (VSP < 0) Then
statement 1
ElseIf (1 <= Speed < 25) And (0 <= VSP < 3) Then
statement 2
ElseIf (25<= Speed < 50)) And (0<= VSP <3) Then
statement 3
End if
End function
Nobody has yet pointed how 1 <= Speed < 25 is evaluated. First, 1 <= Speed is evaluated as True or False, then that value is compared with 25. This requires interpreting True or False as an integer. True is interpreted as -1; False is interpreted as 0. Both of these are less than 25, so the expression will always evaluate to True.
This should be the following:
Function F(ByVal Speed, VSP As Single)
If (1 <= Speed And Speed < 25) And (VSP < 0) Then
' statement 1
ElseIf (1 <= Speed And Speed < 25) And (0 <= VSP And VSP < 3) Then
' statement 2
ElseIf (25 <= Speed And Speed < 50) And (0 <= VSP And VSP < 3) Then
' statement 3
End If
End Function
Your if is totally wrong.. you can't write the if in that way...
You should check one condition at each time, or at least, check one condition and then other and then other...
So
If (1 <= Speed < 25) And (VSP < 0) Then
Should be
If (1 <= Speed) and (Speed < 25) And (VSP < 0) Then
I could not understand why you are not getting any error on this...
What you've done, has check for 1<= speed (that could be true) and then has check true < 25... and so on... no good...

How can I convert a decimal to a fraction?

How do I convert a indefinite decimal (i.e. .333333333...) to a string fraction representation (i.e. "1/3"). I am using VBA and the following is the code I used (i get an overflow error at the line "b = a Mod b":
Function GetFraction(ByVal Num As Double) As String
If Num = 0# Then
GetFraction = "None"
Else
Dim WholeNumber As Integer
Dim DecimalNumber As Double
Dim Numerator As Double
Dim Denomenator As Double
Dim a, b, t As Double
WholeNumber = Fix(Num)
DecimalNumber = Num - Fix(Num)
Numerator = DecimalNumber * 10 ^ (Len(CStr(DecimalNumber)) - 2)
Denomenator = 10 ^ (Len(CStr(DecimalNumber)) - 2)
If Numerator = 0 Then
GetFraction = WholeNumber
Else
a = Numerator
b = Denomenator
t = 0
While b <> 0
t = b
b = a Mod b
a = t
Wend
If WholeNumber = 0 Then
GetFraction = CStr(Numerator / a) & "/" & CStr(Denomenator / a)
Else
GetFraction = CStr(WholeNumber) & " " & CStr(Numerator / a) & "/" & CStr(Denomenator / a)
End If
End If
End If
End Function
As .333333333 is not 1/3 you will never get 1/3 but instead 333333333/1000000000 if you do not add some clever "un-rounding" logic.
Here is a solution for handling numbers with periodic decimal representation I remember from school.
A number 0.abcdabcd... equals abcd/9999. So 0.23572357... equals 2357/9999 exactly. Just take that many 9s as your pattern is long. 0.11111... equals 1/9, 0.121212... equals 12/99, and so on. So try just searching a pattern and setting the denominator to the corresponding number. Of course you have to stop after some digits because you will never know if the pattern is repeated for ever or just many times. And you will hit the rounding error in the last digit, so you still need some clever logic.
This only works in Excel-VBA but since you had it tagged "VBA" I will suggest it. Excel has a custom "fraction" format that you can access via "Format Cells" (or ctrl-1 if you prefer). This particular number format is Excel-Specific and so does not work with the VBA.Format function. It does however work with the Excel Formula TEXT(). (Which is the Excel equivalent of VBA.Format. This can be accessed like So:
Sub Example()
MsgBox Excel.WorksheetFunction.Text(.3333,"# ?/?")
End Sub
To show more than one digit (Example 5/12) just up the number of question marks.
Google for "decimal to fraction" and you'll get about a gazillion results.
I really like this one, because it's simple, has source code (in RPL, similar to Forth, ~25 lines), and is pretty fast (it's written to run on a 4-bit, 4MHz CPU). The docs say:
In a book called Textbook of Algebra by G. Chrystal, 1st
edition in 1889, in Part II, Chapter 32, this improved continued fraction
algorithm is presented and proven. Odd to tell, Chrystal speaks of it as if it
were ancient knowledge.
This site seem to have a really nice implementation of this in JavaScript.
I would multiply by 10000000(or whatever you want depending on the precision), then simplify the resulting fraction (ie n*10000000/10000000)
You can approximate it. Essentially cycle through all numerators and denominators until you reach a fraction that is close to what you want.
int num = 1;
int den = 1;
double limit == 0.1;
double fraction = num / den;
while(den < 1000000 ) // some arbitrary large denominator
{
den = den + 1;
for(num = 0; num <= den; num++)
{
fraction = num / den;
if(fraction < n + limit && fraction > n - limit)
return (num + "/" + den);
}
}
This is slow and a brute force algorithm, but you should get the general idea.
In general, it'll be easier if you find the repeating part of the rational number. If you can't find that, you'll have a tough time. Let's say the number if 8.45735735735...
The answer is 8 + 45/100 + 735/999/100 = 8 1523/3330.
The whole number is 8.
Add 45/100 - which is .45, the part before the repeating part.
The repeating part is 735/999. In general, take the repeating part. Make it the numerator. The denominator is 10^(number of repeating digits) - 1.
Take the repeating part and shift it the appropriate number of digits. In this case, two, which means divide by 100, so 735/999/100.
Once you figure those parts out, you just need some code that adds and reduces fractions using greatest common fractions ...
Similar to CookieOfFortune's, but it's in VB and doesn't use as much brute force.
Dim tolerance As Double = 0.1 'Fraction has to be at least this close'
Dim decimalValue As Double = 0.125 'Original value to convert'
Dim highestDenominator = 100 'Highest denominator you`re willing to accept'
For denominator As Integer = 2 To highestDenominator - 1
'Find the closest numerator'
Dim numerator As Integer = Math.Round(denominator * decimalValue)
'Check if the fraction`s close enough'
If Abs(numerator / denominator - decimalValue) <= tolerance Then
Return numerator & "/" & denominator
End If
Next
'Didn't find one. Use the highest possible denominator'
Return Math.Round(denominator * decimalValue) & "/" & highestDenominator
...Let me know if it needs to account for values greater than 1, and I can adjust it.
EDIT: Sorry for the goofed up syntax highlighting. I can't figure out why it's all wrong. If someone knows how I can make it better, please let me know.
Python has a nice routine in its fractions module. Here is the working portion that converts a n/d into the closest approximation N/D where D <= some maximum value. e.g. if you want to find the closest fraction to 0.347, let n=347,d=1000 and max_denominator be 100 and you will obtain (17, 49) which is as close as you can get for denominators less than or equal to 100. The '//' operator is integer division so that 2//3 gives 0, i.e. a//b = int(a/b).
def approxFrac(n,d,max_denominator):
#give a representation of n/d as N/D where D<=max_denominator
#from python 2.6 fractions.py
#
# reduce by gcd and only run algorithm if d>maxdenominator
g, b = n, d
while b:
g, b = b, g%b
n, d = n/g, d/g
if d <= max_denominator:
return (n,d)
nn, dd = n, d
p0, q0, p1, q1 = 0, 1, 1, 0
while True:
a = nn//dd
q2 = q0+a*q1
if q2 > max_denominator:
break
p0, q0, p1, q1 = p1, q1, p0+a*p1, q2
nn, dd = dd, nn-a*dd
k = (max_denominator-q0)//q1
bound1 = (p0+k*p1, q0+k*q1)
bound2 = (p1, q1)
if abs(bound2[0]*d - bound2[1]*n) <= abs(bound1[0]*d - bound1[1]*n):
return bound2
else:
return bound1
1/ .3333333333 = 3 because 1/3 = .3333333333333, so whatever number you get do this,
double x = 1 / yourDecimal;
int y = Math.Ceil(x);
and now Display "1/" + y
It is not allways resoluble, since not all decimals are fractions (for example PI or e).
Also, you have to round up to some length your decimal before converting.
I know this is an old thread, but I came across this problem in Word VBA. There are so many limitations due to the 8 bit (16 digit) rounding, as well as Word VBA making decimals into scientific notation etc.. but after working around all these problems, I have a nice function I'd like to share that offers a few extra features you may find helpful.
The strategy is along the lines of what Daniel Buckner wrote. Basically:
1st) decide if it's a terminating decimal or not
2nd) If yes, just set the decimal tail / 10^n and reduce the fraction.
3rd) If it doesn't terminate, try to find a repeating pattern including cases where the repetition doesn't start right away
Before I post the function, here are a few of my observations of the risks and limitations, as well as some notes that may help you understand my approach.
Risks, limitations, explanations:
-> Optional parameter "denom" allows you to specify the denominator of the fraction, if you'd like it rounded. i.e. for inches you may want 16ths used. The fractions will still be reduced, however, so 3.746 --> 3 12/16 --> 3 3/4
-> Optional parameter "buildup" set to True will build up the fraction using the equation editor, typing the text right into the active document. If you prefer to have the function simply return a flat string representation of the fraction so you can store it programmatically etc. set this to False.
-> A decimal could terminate after a bunch of repetitions... this function would assume an infinite repetition.
-> Variable type Double trades off whole number digit for decimal digits, only allowing 16 digits total (from my observations anyway!). This function assumes that if a number is using all 16 of the available digits then it must be a repeating decimal. A large number such as 123456789876.25 would be mistaken for a repeating decimal, then returned as decimal number upon failing to find a pattern.
-> To express really large terminating decimal out of 10^n, VB can only handle 10^8 is seems. I round the origninal number to 8 decimal places, losing some accuracy perhaps.
-> For the math behind converting repeating patterns to fractions check this link
-> Use Euclidean Algorithm to reduce the fraction
Ok, here it is, written as a Word Macro:
Function as_fraction(number_, Optional denom As Integer = -1, Optional buildup As Boolean = True) As String
'Selection.TypeText Text:="Received: " & CStr(number_) & vbCrLf
Dim number As Double
Dim repeat_digits As Integer, delay_digits As Integer, E_position As Integer, exponent As Integer
Dim tail_string_test As String, tail_string_original As String, num_removed As String, tail_string_removed As String, removed As String, num As String, output As String
output = "" 'string variable to build into the fraction answer
number = CDbl(number_)
'Get rid of scientific notation since this makes the string longer, fooling the function length = digits
If InStr(CStr(number_), "E+") > 0 Then 'no gigantic numbers! Return that scientific notation junk
output = CStr(number_)
GoTo all_done
End If
E_position = InStr(CStr(number), "E") 'E- since postives were handled
If E_position > 0 Then
exponent = Abs(CInt(Mid(CStr(number), E_position + 1)))
num = Mid(CStr(number_), 1, E_position) 'axe the exponent
decimalposition = InStr(num, ".") 'note the decimal position
For i_move = 1 To exponent
'move the decimal over, and insert a zero if the start of the number is reached
If InStr(num, "-") > 0 And decimalposition = 3 Then 'negative sign in front
num = "-0." & Mid(num, InStr(num, ".") - 1, 1) & Mid(num, InStr(num, ".") + 1) 'insert a zero after the negative
ElseIf decimalposition = 2 Then
num = "0." & Mid(num, InStr(num, ".") - 1, 1) & Mid(num, InStr(num, ".") + 1) 'insert in front
Else 'move the decimal over, there are digits left
num = Mid(num, 1, decimalposition - 2) & "." & Mid(num, decimalposition - 1, 1) & Mid(num, decimalposition + 1)
decimalposition = decimalposition - 1
End If
Next
Else
num = CStr(number_)
End If
'trim the digits to 15, since VB rounds the last digit which ruins the pattern. i.e. 0.5555555555555556 etc.
If Len(num) >= 16 Then
num = Mid(num, 1, 15)
End If
number = CDbl(num) 'num is a string representation of the decimal number, just to avoid cstr() everywhere
'Selection.TypeText Text:="number = " & CStr(number) & vbCrLf
'is it a whole number?
If Fix(number) = number Then 'whole number
output = CStr(number)
GoTo all_done
End If
decimalposition = InStr(CStr(num), ".")
'Selection.TypeText Text:="Attempting to find a fraction equivalent for " & num & vbCrLf
'is it a repeating decimal? It will have 16 digits
If denom = -1 And Len(num) >= 15 Then 'repeating decimal, unspecified denominator
tail_string_original = Mid(num, decimalposition + 1) 'digits after the decimal
delay_digits = -1 'the number of decimal place values removed from the tail, in case the repetition is delayed. i.e. 0.567777777...
Do 'loop through start points for the repeating digits
delay_digits = delay_digits + 1
If delay_digits >= Fix(Len(tail_string_original) / 2) Then
'Selection.TypeText Text:="Tried all starting points for the pattern, up to half way through the tail. None was found. I'll treat it as a terminating decimal." & vbCrLf
GoTo treat_as_terminating
End If
num_removed = Mid(num, 1, decimalposition) & Mid(num, decimalposition + 1 + delay_digits) 'original number with decimal values removed
tail_string_removed = Mid(num_removed, InStr(CStr(num_removed), ".") + 1)
repeat_digits = 0 'exponent on 10 for moving the decimal place over
'Selection.TypeText Text:="Searching " & num_removed & " for a pattern:" & vbCrLf
Do
repeat_digits = repeat_digits + 1
If repeat_digits = Len(tail_string_removed) - 1 Or repeat_digits >= 9 Then 'try removing a digit, incase the pattern is delayed
Exit Do
End If
tail_string_test = Mid(num_removed, decimalposition + 1 + repeat_digits)
'Selection.TypeText Text:=vbTab & "Comparing " & Mid(tail_string_removed, 1, Len(tail_string_removed) - repeat_digits) & " to " & tail_string_test & vbCrLf
If Mid(tail_string_removed, 1, Len(tail_string_removed) - repeat_digits) = tail_string_test Then
'Selection.TypeText Text:=num & ", " & Mid(tail_string_removed, 1, Len(tail_string_removed) - repeat_digits) & " vs " & tail_string_test & vbCrLf
GoTo foundpattern
End If
Loop
Loop 'next starting point for pattern
foundpattern:
If delay_digits = 0 Then 'found pattern right away
numerator = CLng(Mid(CStr(number), decimalposition + 1 + delay_digits, CInt(repeat_digits)))
'generate the denominator nines, same number of digits as the numerator
bottom = ""
For i_loop = 1 To repeat_digits
bottom = bottom & "9"
Next
denominator = CLng(bottom)
Else 'there were numbers before the pattern began
numerator = CLng(Mid(num, decimalposition + 1, delay_digits + repeat_digits)) - CLng(Mid(num, decimalposition + 1, delay_digits))
'i.e. x = 2.73232323232... delay_digits = 1, repeat_digits = 2, so numerator = 732 - 7 = 725
bottom = ""
For i_loop = 1 To repeat_digits
bottom = bottom & "9"
Next
For i_loop = 1 To delay_digits
bottom = bottom & "0"
Next
denominator = CLng(bottom)
'i.e. 990... 725/990 = 145/198 = 0.7323232...
End If
Else ' terminating decimal
treat_as_terminating:
'grab just the decimal trail
If denom = -1 Then
number = Math.Round(number, 8) 'reduce to fewer decimal places to avoid overload
'is it a whole number now?
If Fix(number) = number Then 'whole number
output = CStr(number)
GoTo all_done
End If
num = CStr(number)
numerator = CLng(Mid(num, decimalposition + 1))
denominator = 10 ^ (Len(num) - InStr(num, "."))
Else 'express as a fraction rounded to the nearest denom'th reduced
numerator1 = CDbl("0" & Mid(CStr(num), decimalposition))
numerator = CInt(Math.Round(numerator1 * denom))
denominator = CInt(denom)
End If
End If
'reduce the fraction if possible using Euclidean Algorithm
a = CLng(numerator)
b = CLng(denominator)
Dim t As Long
Do While b <> 0
t = b
b = a Mod b
a = t
Loop
gcd_ = a
numerator = numerator / gcd_
denominator = denominator / gcd_
whole_part = CLng(Mid(num, 1, decimalposition - 1))
'only write a whole number if the number is absolutely greater than zero, or will round to be so.
If whole_part <> 0 Or (whole_part = 0 And numerator = denominator) Then
'case where fraction rounds to whole
If numerator = denominator Then
'increase the whole by 1 absolutely
whole_part = (whole_part / Abs(whole_part)) * (Abs(whole_part) + 1)
End If
output = CStr(whole_part) & " "
End If
'if fraction rounded to a whole, it is already included in the whole number
If numerator <> 0 And numerator <> denominator Then
'negative sign may have been missed, if whole number was -0
If whole_part = 0 And number_ < 0 Then
numerator = -numerator
End If
output = output & CStr(numerator) & "/" & CStr(denominator) & " "
End If
If whole_part = 0 And numerator = 0 Then
output = "0"
End If
all_done:
If buildup = True Then 'build up the equation with a pretty fraction at the current selection range
Dim objRange As Range
Dim objEq As OMath
Dim AC As OMathAutoCorrectEntry
Application.OMathAutoCorrect.UseOutsideOMath = True
Set objRange = Selection.Range
objRange.Text = output
For Each AC In Application.OMathAutoCorrect.Entries
With objRange
If InStr(.Text, AC.Name) > 0 Then
.Text = Replace(.Text, AC.Name, AC.Value)
End If
End With
Next AC
Set objRange = Selection.OMaths.Add(objRange)
Set objEq = objRange.OMaths(1)
objEq.buildup
'Place the cursor at the end of the equation, outside of the OMaths object
objRange.OMaths(1).Range.Select
Selection.Collapse direction:=wdCollapseEnd
Selection.MoveRight Unit:=wdCharacter, count:=1
as_fraction = "" 'just a dummy return to make the function happy
Else 'just return a flat string value
as_fraction = output
End If
End Function
I shared an answer at this link : https://stackoverflow.com/a/57517128/11933717
It's also an iterative function, but unlike finding numerator and denominator in a nested loop, it just tests numerators only and so, should be faster.
Here is how it works :
It assumes that, based on the user input x, you want to find 2 integers n / m .
n/m = x , meaning that
n/x should give an almost integer m
Say one needs to find a fraction for x = 2.428571. Putting the int 2 aside for later, the algo starts by setting n and x and iterates n :
// n / x = m ( we need m to be an integer )
// n = 1 ; x = .428571 ;
1 / .428571 = 2.333335 (not close to an integer, n++)
2 / .428571 = 4.666671 (not close to an integer, n++)
3 / .428571 = 7.000007
At this point n = 3, we consider that m = 7.000007 is integer enough --based on some kind of accuracy the programmer decides-- and we reply the user
2.428571 = 2 + 3/7
= 14/7 + 3/7
= 17/7