Convert Integer Formatted Degrees Decimal Minutes to Decimal Degrees (strange usecase) - latitude-longitude

I have a radio with GPS APRS that's storing a fixed location as a 4 byte integer and I'm trying to retrieve them back as decimal degrees.
The software for the radio will display the value as a unintuitive decimal. e.g 12° 34.567 is displayed as 12.34567.
Which makes it look like it's in decimal degrees, but it's really degrees decimal minutes.
Ideally I want to read the 4 bytes as an int32 and convert them back to DDM, then to DD and back to int32 to pass to the radio.
I have managed to do just that but there is cases where it doesn't return the correct value.
I've tried dividing the integer based on number of digits. 1234567 / 100000 = 12.34567 or 123456 / 10000 = 12.3456 but that doesn't always work.
Sample code will generate a random set of DD co-ordinates, convert them to the Int32 format the radio uses and then attempts to get the DD co-ordinates back.. which works about 50% of the time.
Using substrings obviously isn't the way to go about it but as mention, I have tried using division and can get the same results as the code below but still fails too often to be reliable. I'm probably overlooking something simple but trying to get a decimal from an integer when it can be 1.0, 10.0 or 100.0 doesn't seem very intuitive :)
//Generate a random set of DD co-ordinates
double Lat_DD = Math.Round(GetRandomNumber(-89.99999, 89.99999), 5); textBox2.Text = Lat_DD.ToString();
double Long_DD = Math.Round(GetRandomNumber(-179.99999, 179.99999), 5); textBox3.Text = Long_DD.ToString();
//Get N_S_E_W direction
string Lat_N_S = (Lat_DD >= 0 ? "N" : "S");
string Long_E_W = (Long_DD >= 0 ? "E" : "W");
//Make negative co-ordinate positive
Lat_DD = Math.Abs(Lat_DD);
Long_DD = Math.Abs(Long_DD);
//Get degrees
int lat_degrees = (int)Math.Truncate(Lat_DD);
int long_degrees = (int)Math.Truncate(Long_DD);
//Get decimal minutes
double lat_decimal_minutes = Math.Truncate(Math.Round((Lat_DD - lat_degrees) * 60.0, 3) * 100.0);
double long_decimal_minutes = Math.Truncate(Math.Round((Long_DD - long_degrees) * 60.0, 3) * 100.0);
//Format degrees + decimal minutes as int32
int lat_ddm = Convert.ToInt32(string.Format("{0}{1}", lat_degrees, lat_decimal_minutes));
int lon_ddm = Convert.ToInt32(string.Format("{0}{1}", long_degrees, long_decimal_minutes));
//Show the result in textboxes
textBox4.Text = lat_ddm + " " + Lat_N_S;
textBox5.Text = lon_ddm + " " + Long_E_W;
//Get decimal minutes from the int32 DDM - probably not the way to do it :)
double latddm = Convert.ToDouble(lat_ddm.ToString().Substring(lat_ddm.ToString().Length - 4, 4));
double londdm = Convert.ToDouble(lon_ddm.ToString().Substring(lon_ddm.ToString().Length - 4, 4));
//Left over values = degrees
double latd = Convert.ToDouble(lat_ddm.ToString().Replace(latddm.ToString(),""));
double lond = Convert.ToDouble(lon_ddm.ToString().Replace(londdm.ToString(), ""));
//Calculate decimal
latddm = Math.Truncate(Math.Round((latddm / 60.0), 3) * 1000.0);
londdm = Math.Truncate(Math.Round((londdm / 60.0), 3) * 1000.0);
//Make degrees negative if S or W
if (Lat_N_S=="S") latd = latd * -1;
if (Long_E_W == "W") lond = lond * -1;
//Show the decimal degrees result
textBox6.Text = string.Format("{0}.{1}", latd, latddm);
textBox7.Text = string.Format("{0}.{1}", lond, londdm);

Related

Inserting a If then statement for custom VB code

I have queried a report that shows the width, height, and thickness of the windows which was in decimal format, until I inserted custom VB code in SSRS to change those decimals to fractions, And one particular fraction that suppose to say "5/23" is showing as "39/250" and I am wondering I can put a IF statement in to get 39/250 to say 5/23.
Fraction:
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(Decimal.Round(Convert.ToDecimal(Num,Nothing), 3))
DecimalNumber = Decimal.Round(Convert.ToDecimal(Num,Nothing),3) - Fix(Decimal.Round(Convert.ToDecimal(Num,Nothing),3))
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
End While
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
I'm guessing you really want 5/32, not the 5/23 because 5/23 = 0.2173913043478261 while 5/32 = 0.15625 which seems to be the number you want. What you need to do is adjust your rounding to five decimal points. I believe these two lines just need the 3s switched to 5s. It's possible you may need more like a 6 for this case, but since 5/32 has 5 digits right of the decimal point, I would guess this would fix your problem.
WholeNumber = Fix(Decimal.Round(Convert.ToDecimal(Num,Nothing), 5))
DecimalNumber = Decimal.Round(Convert.ToDecimal(Num,Nothing),5) - Fix(Decimal.Round(Convert.ToDecimal(Num,Nothing),5))

Calculating distance in kilometers between coordinates

I'm trying to calculate distance in kilometers between two geographical coordinates using the haversine formula.
Code:
Dim dbl_dLat As Double
Dim dbl_dLon As Double
Dim dbl_a As Double
dbl_P = WorksheetFunction.Pi / 180
dbl_dLat = dbl_P * (dbl_Latitude2 - dbl_Latitude1)
dbl_dLon = dbl_P * (dbl_Longitude2 - dbl_Longitude1)
dbl_a = Sin(dbl_dLat / 2) * Sin(dbl_dLat / 2) + Cos(dbl_Latitude1 * dbl_P) * Cos(dbl_Latitude2 * dbl_P) * Sin(dbl_dLon / 2) * Sin(dbl_dLon / 2)
dbl_Distance_KM = 6371 * 2 * WorksheetFunction.Atan2(Sqr(dbl_a), Sqr(1 - dbl_a))
I'm testing with these coordinates:
dbl_Longitude1 = 55.629178
dbl_Longitude2 = 29.846686
dbl_Latitude1 = 37.659466
dbl_Latitude2 = 30.24441
And the code returns 20015.09, which is obviously wrong. It should be 642 km according to Yandex maps.
Where am I wrong? Are the longitude and latitude in wrong format?
As far as I can tell, the issue is that the order of arguments to atan2() varies by language. The following works* for me:
Option Explicit
Public Sub Distance()
Dim dbl_Longitude1 As Double, dbl_Longitude2 As Double, dbl_Latitude1 As Double, dbl_Latitude2 As Double
dbl_Longitude1 = 55.629178
dbl_Longitude2 = 29.846686
dbl_Latitude1 = 37.659466
dbl_Latitude2 = 30.24441
Dim dbl_dLat As Double
Dim dbl_dLon As Double
Dim dbl_a As Double
Dim dbl_P As Double
dbl_P = WorksheetFunction.Pi / 180
dbl_dLat = dbl_P * (dbl_Latitude2 - dbl_Latitude1) 'to radians
dbl_dLon = dbl_P * (dbl_Longitude2 - dbl_Longitude1) 'to radians
dbl_a = Sin(dbl_dLat / 2) * Sin(dbl_dLat / 2) + _
Cos(dbl_Latitude1 * dbl_P) * Cos(dbl_Latitude2 * dbl_P) * Sin(dbl_dLon / 2) * Sin(dbl_dLon / 2)
Dim c As Double
Dim dbl_Distance_KM As Double
c = 2 * WorksheetFunction.Atan2(Sqr(1 - dbl_a), Sqr(dbl_a)) ' *** swapped arguments to Atan2
dbl_Distance_KM = 6371 * c
Debug.Print dbl_Distance_KM
End Sub
*Output: 2507.26205401321, although gcmap.com says the answer is 2512 km. This might be a precision issue --- I think it's close enough to count as working. (Edit it might also be that gcmap uses local earth radii rather than the mean radius; I am not sure.)
Explanation
I found this description of the haversine formula for great-circle distance, which is what you are implementing. The JavaScript implementation on that page gives this computation for c:
var c = 2 * Math.atan2(Math.sqrt(a), Math.sqrt(1-a));
In JavaScript, atan2() takes parameters y, x. However, in Excel VBA, WorksheetFunction.Atan2 takes parameters x, y. Your original code passed Sqr(dbl_a) as the first parameter, as it would be in JavaScript. However, Sqr(dbl_a) needs to be the second parameter in Excel VBA.
A comment on naming
Building on #JohnColeman's point, there are lots of ways to name variables. In this case, I would recommend using the prefixes for unit rather than for type: e.g., deg_Latitude1, RadPerDeg = Pi/180, and rad_dLat = RadPerDeg * (deg_Latitude2 - deg_Latitude1). I personally think that helps avoid unit-conversion mishaps.
My VBA code that returns the answer in feet; However 'd' is the answer in kilometers.
Imports System.Math
Module Haversine
Public Function GlobalAddressDistance(sLat1 As String, sLon1 As String, sLat2 As String, sLon2 As String) As String
Const R As Integer = 6371
Const cMetersToFeet As Single = 3.2808399
Const cKiloMetersToMeters As Integer = 1000
Dim a As Double = 0, c As Double = 0, d As Double = 0
'Convert strings to numberic double values
Dim dLat1 As Double = Val(sLat1)
Dim dLat2 As Double = Val(sLat2)
Dim dLatDiff As Double = DegreesToRadians(CDbl(sLat2) - CDbl(sLat1))
Dim dLonDiff As Double = DegreesToRadians(CDbl(sLon2) - CDbl(sLon1))
a = Pow(Sin(dLatDiff / 2), 2) + Cos(DegreesToRadians(dLat1)) * Cos(DegreesToRadians(dLat2)) * Pow(Sin(dLonDiff / 2), 2)
c = 2 * Atan2(Sqrt(a), Sqrt(1 - a))
d = R * c
'Convert kilometers to feet
Return Format((d * cKiloMetersToMeters * cMetersToFeet), "0.##").ToString
End Function
Private Function DegreesToRadians(ByVal dDegrees As Double) As Double
Return (dDegrees * PI) / 180
End Function
End Module

How do I convert longitude and latitude to GPS Exif byte array

I am trying to put latitude = 8°50'34.46" and longitude = 125° 9'50.82" into the exif file of an image. i'm using vb.net.
I'm not having problem converting the degrees and minutes into bytes because it is a whole number but when i convert the seconds (34.46") which has decimal values into bytes. it gives different result like 0.9856.
Please help me guys how to convert numbers with decimal values into bytes.
here the code:
Private Shared Function intToByteArray(ByVal int As Int32) As Byte()
' a necessary wrapper because of the cast to Int32
Return BitConverter.GetBytes(int)
End Function
Private Shared Function doubleToByteArray(ByVal dbl As Double) As Byte()
Return BitConverter.GetBytes(Convert.ToDecimal(dbl))
End Function
Private Shared Function doubleCoordinateToRationalByteArray(ByVal doubleVal As Double) As Byte()
Dim temp As Double
temp = Math.Abs(doubleVal)
Dim degrees = Math.Truncate(temp)
temp = (temp - degrees) * 60
Dim minutes = Math.Truncate(temp)
temp = (temp - minutes) * 60
Dim seconds = temp
Dim result(24) As Byte
Array.Copy(intToByteArray(degrees), 0, result, 0, 4)
Array.Copy(intToByteArray(1), 0, result, 4, 4)
Array.Copy(intToByteArray(minutes), 0, result, 8, 4)
Array.Copy(intToByteArray(1), 0, result, 12, 4)
Array.Copy(doubleToByteArray(seconds), 0, result, 16, 4)
Array.Copy(intToByteArray(1), 0, result, 20, 4)
Return result
End Function
According to this specification, longitude and latitude are encoded as a
PropertyTagTypeRational
Specifies that the value data member is an array of pairs of unsigned long integers. Each pair represents a fraction; the first integer is the numerator and the second integer is the denominator.
The encoded layout should be (24 bytes total)
Byte Offset Length Encoding Field
0 4 uint Degrees Nominator
4 4 uint Degrees Denominator
8 4 uint Minutes Nominator
12 4 uint Minutes Denominator
16 4 uint Seconds Nominator
20 4 uint Seconds Denominator
Given that your input is using whole degrees and minutes and not fractions, your encoding for those two will work fine, by using the value of 1 as the denominator.
For the seconds, that you have as a floating point value, this is not the case. You will have to encode it as a rational, using a nominator and denominator part.
I am not sure what the precision is that you would like to have, but given your example of 34.46 seconds, it would seem that multiplying by 1000 and using 1000 for the denominator would be more than good enough:
Dim secondsNominator = Math.Truncate(1000 * seconds)
Dim secondsDenoninator = 1000
Then your encoding function becomes:
Private Shared Function doubleCoordinateToRationalByteArray(ByVal doubleVal As Double) As Byte()
Dim temp As Double
temp = Math.Abs(doubleVal)
Dim degrees = Math.Truncate(temp)
temp = (temp - degrees) * 60
Dim minutes = Math.Truncate(temp)
temp = (temp - minutes) * 60
Dim secondsNominator = Math.Truncate(1000 * temp)
Dim secondsDenoninator = 1000
Dim result(24) As Byte
' Degrees (nominator, and 1 for denominator)
Array.Copy(intToByteArray(degrees), 0, result, 0, 4)
Array.Copy(intToByteArray(1), 0, result, 4, 4)
' Minutes (nominator, and 1 for denominator)
Array.Copy(intToByteArray(minutes), 0, result, 8, 4)
Array.Copy(intToByteArray(1), 0, result, 12, 4)
' Seconds (1000 for denominator: ms resolution)
Array.Copy(intToByteArray(secondsNominator), 0, result, 16, 4)
Array.Copy(intToByteArray(secondsDenominator), 0, result, 20, 4)
Return result
End Function
The GPS latitude and longitude for exif data are "rational" data type, or two 32-bit integers. To represent 34.46, for example, you could use the two 32-bit integers 3,446 (numerator) and 100 (denominator), or 344,600 and 10,000. For the integer value of degrees, for example you could use 8 with a denominator of 1.
You can get the exif specification here.

Convert GPS Degrees Minutes Seconds to Decimal Degrees

I have a formula that I am using to calculate decimal degrees from gps coordinates.
GPS Coordinates:
3800.5825,N
08735.5417,W
Formula:
Private Function DMStoDD(ByVal toConvert As Double, ByVal Dir As String) As Double
Dim DD As Double
Dim deg As Double
Dim min As Double
Dim sec As Double
deg = CDbl(toConvert.ToString.Substring(0, 2))
min = CDbl(toConvert.ToString.Substring(2, 2))
sec = CDbl(toConvert.ToString.Split(".")(1)) * 0.01
DD = deg + (min / 60) + (sec / 3600)
'Negative for West
If Dir = "W" Then DD = DD * -1
Return DD
End Function
Returns:
38.0161805555556
-87.5983805555556 (negative for west)
The results are very close, but not quite right. I believe that they are just a little bit North West of where they actually should fall. I have searched and looked at a lot of different formulas, but from what I've read, I think that mine should be right. Thanks in advance for the help.
Your formula looks wrong, the part with the seconds! it tries a DMS to Degrees conversion. But you coordinates are in DM notation ( Degrees + Decimal minutes)
so you need a DM to DEG conversion.
08735.5417,W = 87deg 35.5147 minutes W
just do 87 + 35.5147/60, then multiply with -1

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