Obtain Permutations of Items in VBA 6

[rubbernilly]

Is there some code template that will give me permutations of items of 'X' amount.

Given five items I want to return:

12345
12354
12534
15234
12435
14235
13245
21345
etc.

For this thread, the items can be phrased in terms of rows in a DAO.Recordset... any thoughts?

 

[rubbernilly]

OK... so... um... 1 hour into the Great Permutation Festival of 2005, I have a current shortest distance of 48,000 statute miles.

Don't contrast and compare!

Of course, it is running them alphabetically based on my single character assignment, so it will be a while before it gets through them all.

We're also working on code that would check the shortest distance 10 steps at a time... then moving on to the next ten steps. We'll see how that pans out compared with all the other returns people are getting.

 

[BoxHead]

rubbernilly,

I combined what I had with the idea you had brought up of checking a round trip and eliminating the longest leg.

Interesting results.



The sub used the Next Nearest Destination (NND) principle and from each origin, ran the gambit with each of the other cities as the first stop (2352) trips. I added code to the sub so that the origin city would be added in at the end of the journey to close the loop.

The query result sample below shows the total mileage including round trip, the longest leg of the trip, the total distance without the longest leg, the return trip and the mileage without that.

The shortest overall trip without the 'return to start miles' was 12691 miles starting in Minneapolis, HOWEVER, the totals query shows that the trip started in Springfield actually contaims a shorter trip at 11771 miles.

RouteNum,      myOrigin,       Total,     Longest,  -Lngst,    Return,   -Rtn
2,             Springfield,   13691,       1920,     11771,    194,      13497
1,             Madison,       13691,       1920,     11771,    327,      13364
1,             Springfield,   13985,       1920,     12065,    405,      13580
0,             Minneapolis,   13992,       1920,     12072,    612,      13380
10,            Lansing,       13992,       1920,     12072,    226,      13766
11,            Frankfort,     14045,       1920,     12125,    144,      13901
3,             Madison,       14061,       1920,     12141,    294,      13767
1,             Little Rock,   14083,       1920,     12163,    395,      13688

The revised sub is:

Private Sub myTrip()
'this is the version that looks at each city as the origin and then each other city as the first stop before applying the NND principle.
'It also calculates the distance to get back to the origin from the last stop
tStart = Now()
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tblTrips;"
DoCmd.SetWarnings True

Dim myOrigin As String, myRecent As String, myAll As String
Dim myTripNum As Integer, myRteNum
Dim myD As DAO.Database, myR1 As DAO.Recordset, myR2 As DAO.Recordset
Set myD = CurrentDb
Set myR1 = myD.OpenRecordset("SELECT DISTINCT City1 FROM Distances ORDER BY City1;", dbOpenDynaset)
myR1.MoveFirst
   For myRteNum = 0 To myR1.RecordCount - 2
        Do While Not myR1.EOF 'start outer loop

        myOrigin = myR1.Fields(0)
        myRecent = myOrigin
        DoCmd.SetWarnings False
            Do Until myTripNum = myR1.RecordCount - 1        'start inner loop
            Set myR2 = myD.OpenRecordset("SELECT City1, City2, Distance FROM Distances WHERE city1 = '" _
            & myRecent & "' AND city2 <> '" & myRecent & "' " & myAll & " ORDER BY distance;", dbOpenDynaset)
            myTripNum = myTripNum + 1
            myR2.MoveFirst
            If myTripNum = 1 Then
            myR2.Move (myRteNum)
            End If
            DoCmd.RunSQL "INSERT INTO tblTrips (myRouteNum, myOrigin, myStopNum, myStopName,myDistance)" _
            & " SELECT " & myRteNum & ", '" & myOrigin & "', " & myTripNum & ", '" & myR2.Fields(1) & "', " & myR2.Fields(2) & ";"
            myAll = myAll & " AND city2 <> '" & myRecent & "' "
            myRecent = myR2.Fields(1)
            If myTripNum = 48 Then
            DoCmd.RunSQL "INSERT INTO tblTrips (myRouteNum, myOrigin, myStopNum, myStopName,myDistance)" _
            & " SELECT " & myRteNum & ", '" & myOrigin & "', " & myTripNum + 1 & ", '" & myOrigin & "', " _
            & DLookup("[Distance]", "Distances", "[City1] = '" & myR2.Fields(1) & "' AND [City2] = '" & myOrigin & "'") & ";"
            myAll = myAll & " AND city2 <> '" & myRecent & "' "
            End If
            Loop
        myTripNum = 0
        myAll = ""
        myRecent = ""
        myOrigin = ""
        myR1.MoveNext
        Loop
        myTripNum = 0
        myAll = ""
        myRecent = ""
        myOrigin = ""
        myR1.MoveFirst
   Next myRteNum
DoCmd.SetWarnings True

tEnd = Now


End Sub

The SQL for the Totals query is:

SELECT tblTrips.myRouteNum, tblTrips.myOrigin, Sum(tblTrips.myDistance) AS SumOfmyDistance, Max(tblTrips.myDistance) AS LongestLeg, Sum(tblTrips.myDistance)-Max(tblTrips.myDistance) AS LessLongestLeg, Sum(IIf([myorigin]=[mystopname],[mydistance],0)) AS ReturnToStart, Sum([myDistance]-IIf([myorigin]=[mystopname],[mydistance],0)) AS LessReturnToStart
FROM tblTrips
GROUP BY tblTrips.myRouteNum, tblTrips.myOrigin
ORDER BY Sum([myDistance]-IIf([myorigin]=[mystopname],[mydistance],0));

John

When Galileo questioned the accepted principles of the day, his fellow scholars called him a fool.
When he disproved those same principles,
they called him dangerous.

 

[rubbernilly]

So... we've killed that all-iterations code (once again). Overnight, the machine we were running it on got into the tenth step... but we realized that every step was going to be a geometric progression longer, so that was not efficient enough.

The other code we were working on (to test the all of the paths out to 10 to find the shortest... ie, 10¹⁰ options) stopped when we realized that that would not be optimized. The first ten could leave you in Olympia, WA, with the next available jump Lansing, MI... whereas if the code had known that the next jump was going to be that long, it probably would not have offered olympia as the end city of that 10-group. So, in working out how to make that code recursive (so that it would run to the end of the 49 stops), I realized I was re-creating MajP's work.

So we poached.

And changed a bit.

Here is the code that we are using now:

Public Sub subGetRoute(ByVal strStartCity As String, _
                       ByVal strChosenCities As String, _
                       ByVal dblTotalDistance, _
                       ByVal iStep As Integer)
  
Dim rsPossibleCities As DAO.Recordset
Dim strSql As String
Dim strEndCity As String
Dim iRecs As Integer

strSql = "SELECT TOP 6 Distances.* FROM Distances where Distances.City1 = '" & strStartCity & _
        "' AND Distances.City2 NOT IN (" & strChosenCities & ") ORDER BY Distances.Distance"
Set rsPossibleCities = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
If iStep = 48 Then
  If dbShortest = 0 Or (dblTotalDistance < dbShortest And dbShortest > 0) Then
    dbShortest = dblTotalDistance
    sPath = strChosenCities
  End If
End If
Do While Not rsPossibleCities.EOF
  strEndCity = rsPossibleCities.Fields("City2")
  Call subGetRoute(strEndCity, strChosenCities & " '" & strEndCity & "',", dblTotalDistance + rsPossibleCities.Fields("Distance"), iStep + 1)
  rsPossibleCities.MoveNext
Loop
Set rsPossibleCities = Nothing
End Sub

That is the recursive call. As you can see, we are testing 6-steps into the future to see what the best path would be. To change that, just change the select statement in the code. We actually have our best result so far running a SELECT TOP 2 for Augusta. Current best distance: 10,676

To call the above code, I have this procedure:

Public Sub FeedCityToRoute(sFeedCity)
Dim rs As DAO.Recordset

subGetRoute sFeedCity, "'" & sFeedCity & "',", 0, 0

Set rs = CurrentDb.OpenRecordset("ShortestRoutes")

With rs
  .AddNew
    !StartCity = sFeedCity
    !TotalDistance = dbShortest
    !RoutePath = sPath
  .Update
End With

Set rs = Nothing

MsgBox "Done. Remove this box for multiple city processing." & vbCrLf & sFeedCity & ": " & _
       dbShortest, vbOKOnly

End Sub

So, for example, you can enter into the immediate window:

FeedCityToRoute "Albany

 

[BoxHead]

rubbernilly,

10,676! You're making progress.

I would urge you to pull the distance from the endCity to the StartCity into your results. Closing that loop takes your one resulting route and lets you analyze 48 routes using the same sequence.

If the distance between your endCity and Augusta is less than any of the incremental distances, it would identify and even shorter route.


HTH

John

"I could have fired him because he cut the board 2' 5" long when I asked for 25 inches.
I could have fired him because he threw that board aside to find another one when it only needed 4" cut off of it.
I had to fire him beacause when he threw the board, I heard him say, 'Stupid wood!'" -The Foreman

 

[rubbernilly]

Boxhead, can you see a way to do it with the code I've posted?

It seems like I've been looking at this so long, I can't see exactly where to change it.

Here is the current code we are running (with a couple of optimizations over the previous posting of the code to knock out some known-longer iterations):

Public Sub subGetRoute(ByVal strStartCity As String, _
                       ByVal strChosenCities As String, _
                       ByVal dblTotalDistance, _
                       ByVal iStep As Integer)
  
Dim rsPossibleCities As DAO.Recordset
Dim strSql As String
Dim strEndCity As String
Dim iRecs As Integer

strSql = "SELECT TOP 6 Distances.* FROM Distances where Distances.City1 = '" & strStartCity & _
        "' AND Distances.City2 NOT IN (" & strChosenCities & ") ORDER BY Distances.Distance"
Set rsPossibleCities = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
If iStep = 48 Then
  If dbShortest = 0 Or (dblTotalDistance < dbShortest And dbShortest > 0) Then
    dbShortest = dblTotalDistance
    sPath = strChosenCities
    Debug.Print sPath & vbcrlf & dbshortest
    Beep
  End If
End If
Do While Not rsPossibleCities.EOF
  If dblTotalDistance+rsPossibleCities.Fields("City2")>dbshortest And dbshortest>0 then
    Goto exit_subGetRoute
  End if
  strEndCity = rsPossibleCities.Fields("City2")
  Call subGetRoute(strEndCity, strChosenCities & " '" & strEndCity & "',", dblTotalDistance + rsPossibleCities.Fields("Distance"), iStep + 1)
  rsPossibleCities.MoveNext
Loop

exit_subGetRoute:
Set rsPossibleCities = Nothing
End Sub

My friend and I have been discussing the way circles apply to direct paths. Will the smallest-circle-route-without-its-longest-leg (ie, a direct path), always be the shortest route?

Let me put it another way...

Let's say you have iterated *all* of the full circle routes, and have them ordered from smallest to greatest distance.

Will the following ever be true:
[tt](Circle(0).TotalDistance - Circle(0).LongestLeg) > (Circle(1).TotalDistance - Circle(1).LongestLeg)[/tt]

Thinking about it one way, it seems like there are times when it would be true. Thinking about it another way, I think it could never be true.

 

[BoxHead]

rubbernilly,

I'm not sure how to adjust the code for grabbing the return trip. Somewhere in your FeedCityToRoute sub with the addNew steps. It would require adding a field to your table ShortestRoutes.

It might be easier to do it after the fact with a dlookup to grab the distance between the StartCity and the EndCity and comparing that to the other distances.

As far as the circle issue

Will the smallest-circle-route-without-its-longest-leg (ie, a direct path), always be the shortest route?

No. When I ran my sub closing the circle, my shortest circuit was 13352 miles with a starting point in Salt Lake City. The longest leg in that trip was 912 miles bringing the total for a one-way trip through that sequence to 12440.

I had a circuit starting in Madison that was 13691 miles long, but the longest leg in that sequence was 1920 miles so it identified a one-way trip totaling 11771.

What this served to prove was that the NND process I was using doesn't guarantee the best results.


"I could have fired him because he cut the board 2' 5" long when I asked for 25 inches.
I could have fired him because he threw that board aside to find another one when it only needed 4" cut off of it.
I had to fire him beacause when he threw the board, I heard him say, 'Stupid wood!'" -The Foreman

 

[MajP]

Here is the solution I come up with. 10563 Nm or 12156 statute miles. The conversion that everyone is using for distance is incorrect. The conversion of minutes to nautical miles works for minutes of lattitude but not longitude. I converted using polar coordinates for a more accurate solution. This solution takes 20 minutes to run on a 4 year old pc. This is a loop so you can start anywhere in it.


Start End City Dist Total Dist

Little Rock Topeka AP 354 354
Topeka AP Lincoln Co (S) 137 491
Lincoln Co (S) Des Moines AP 168 659
Des Moines AP Jefferson City 219 878
Jefferson City Springfield AP 160 1038
Springfield AP Indianapolis AP 180 1218
Indianapolis AP Frankfort 131 1349
Frankfort Columbus AP (S) 167 1516
Columbus AP (S) Charleston AP 132 1648
Charleston AP Raleigh/Durham) 233 1881
Raleigh/Durham Richmond AP 138 2019
Richmond AP Washington 95 2114
Washington Annapolis 25 2139
Annapolis Dover AFB 61 2200
Dover AFB Trenton Co 84 2284
Trenton Co Harrisburg AP 106 2390
Harrisburg AP Albany AP (S) 234 2624
Albany AP (S) Hartford 92 2716
Hartford Providence AP 63 2779
Providence AP Boston AP 49 2828
Boston AP Concord AP 62 2890
Concord AP Montpelier 86 2976
Montpelier Augusta AP 135 3111
Augusta AP Lansing AP 749 3860
Lansing AP Madison AP (S) 241 4101
Madison AP Minneapolis 228 4329
Minneapolis/St. Paul AP Pierre 349 4678
Pierre AP Bismarck AP (S) 167 4845
Bismarck AP (S) Cheyenne 438 5283
Cheyenne Denver AP 97 5380
Denver AP Santa Fe CO 293 5673
Santa Fe CO Phoenix AP (S) 371 6044
Phoenix AP (S) Salt Lake City 508 6552
Salt Lake City) Boise AP (S) 291 6843
Boise AP (S) Helena AP 294 7137
Helena AP Olympia AP 516 7653
Olympia AP Salem AP 142 7795
Salem AP Carson City 431 8226
Carson City Sacramento AP 103 8329
Sacramento AP Oklahoma City) 1335 9664
Oklahoma City ) Austin AP 353 10017
Austin AP Baton Rouge AP 391 10408
Baton Rouge AP Jackson AP 139 10547
Jackson AP Montgomery AP 217 10764
Montgomery AP Atlanta AP (S) 143 10907
Atlanta AP (S) Columbia AP 191 11098
Columbia AP Tallahassee AP 312 11410
Tallahassee AP) Nashville AP 419 11829
Nashville AP Little Rock AP 327 12156

10563 Nm

 

[MajP]

Here is the function for distance between two lat long given as decimal lat long. South and West are negative.

Function polarDistance(decLatStart As Single, decLongStart As Single, decLatEnd As Single, decLongEnd As Single) As Single
Const decToRad = 3.14159265358979 / 180
Const radiusOfEarth = 3963.1
'radiusOfEarth =3963.1 statute miles, 3443.9 nautical miles, or 6378 km
Dim radLatStart As Single
Dim radLongStart As Single
Dim radLatEnd As Single
Dim radLongEnd As Single
radLatStart = decLatStart * decToRad
radLongStart = decLongStart * decToRad
radLatEnd = decLatEnd * decToRad
radLongEnd = decLongEnd * decToRad
polarDistance = ArcCos(Cos([radLatStart]) * Cos([radLongStart]) * Cos([radLatEnd]) * Cos([radLongEnd]) + Cos([radLatStart]) * Sin([radLongStart]) * Cos([radLatEnd]) * Sin([radLongEnd]) + Sin([radLatStart]) * Sin([radLatEnd])) * radiusOfEarth
End Function

Function ArcCos(X As Single) As Single
    ArcCos = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
End Function

 

[MajP]

I believe that my distances between nodes are correct. You can check your values at:

http://www.indo.com/cgi-bin/dist?place1=38:51:00N++77:02:00w&

or

http://jan.ucc.nau.edu/~cvm/latlongdist.html

I tried the calculator on a few of my values and they matched.

 

[BoxHead]

Dead On! MajP!!

17:06 and the exact same results.

That polarDistance function was a real gift. Thank you (with a star for your collection.)

Now for rubbernilly's purposes, we can take out the longest leg (1335 miles from Sacramento to Oklahoma City) and the shorten the one way trip to 10,821 miles starting in Oklahoma City and ending in Sacramento.

Even shorter - at 10,615 miles - is the NND route started in Montgomery. The original route defined by NND was 12526 miles round trip. The longest leg was 1911 miles between Sacramento and Nashville. So, by beginning in Nashville and ending in Sacramento, the trip is:

 Nashville > 213 >  Atlanta > 191 >  Columbia > 312 >  Tallahassee > 182 >  Montgomery > 375 >  Little Rock > 208 >  Jackson > 139 >  Baton Rouge > 391 >  Austin > 353 >  Oklahoma City > 276 >  Topeka > 137 >  Lincoln > 168 >  Des Moines > 219 >  Jefferson City > 160 >  Springfield > 180 >  Indianapolis > 131 >  Frankfort > 167 >  Columbus > 132 >  Charleston > 233 >  Raleigh > 138 >  Richmond > 95 >  Washington > 25 >  Annapolis > 61 >  Dover > 84 >  Trenton > 106 >  Harrisburg > 234 >  Albany > 92 >  Hartford > 63 >  Providence > 49 >  Boston > 62 >  Concord > 86 >  Montpelier > 135 >  Augusta > 749 >  Lansing > 241 >  Madison > 228 >  Minneapolis > 349 >  Pierre > 167 >  Bismarck > 438 >  Cheyenne > 97 >  Denver > 293 >  Santa Fe > 371 >  Phoenix > 508 >  Salt Lake City > 291 >  Boise > 294 >  Helena > 516 >  Olympia > 142 >  Salem > 431 >  Carson City > 103 >  Sacramento

"I could have fired him because he cut the board 2' 5" long when I asked for 25 inches.
I could have fired him because he threw that board aside to find another one when it only needed 4" cut off of it.
I had to fire him beacause when he threw the board, I heard him say, 'Stupid wood!'" -The Foreman

 

[rubbernilly]

Well, the shortest path we came up with this week was ~10,300, but that was with the non-polar distances AND it was not the end of the permutative search. We ended up killing that process before the search finished, so I can't say what the shortest path would have been, nor can I say what the path was except that I know it started in Augusta.

I'll have to go back and rerun all of our distances to be sure I'm accurate with what everyone else is returning.

MajP - does your polarDistance formula return NM or SM? And are you saying that conversion of NM to statute miles will not be accurate for a straight-line, non-lattitudinal vector even after we render it with the polar-distance formula? If so, then we should all be reporting in NM, I think.

 

[MajP]

If you read the function you will see that you can change the radiusOftheEarth to SM, NM, or KM

Const radiusOfEarth = 3963.1
'radiusOfEarth =3963.1 statute miles, 3443.9 nautical miles, or 6378 km

Think about if you were 2 feet south from the North pole. Take one big step to the East or West. You would traverse a few hundred degrees of longitude. Now go to the equator and head east or west. It will take 1.15 nM, (I think) to go just one minute of longitude. Since we are a good ways from the Equator especially Olympia, Albany etc., 1.15 is conservative (and should be variable), and not accurate. NM or SM or KM are all accurate, but you have to use the polar formula.

 

[rubbernilly]

Majp... I'm confused.

I created a new table called PolarDistance with Fields:

City1         Text*255
City2         Text*255
Distance      Double
MajPDistance  Single

Your formula looked a little different from what I found for Great Circle distance calculations, which was:

(SinA * SinB) + (CosA * CosB * CosC)

...where A is the Lat of City1, B is the Lat of City2, and C is the difference between the Longs of City1 and City2.

After that, everything looks the same for my formula except that where you use the radius of the earth, I am using a derived value based on the definition of a Nautical Mile (one minute at the equator):

Cos^-1(Value) * 60 * 180/pi

So my constant for the radius of the earth, 60 * 180/pi, turns out to be slightly different than yours. You had 3443.9 NM, I have about 3437.75. That's not a big difference, and if it were the only difference, we would be able to tell since it would produce a steady grade of difference between our two values. The greater the distance between the two cities, the greater the difference in our calculated differences. However, that is not the case.

I copied your code verbatim into a module, and I also created my own function. My function would feed the "Distance" field (Double), yours would feed the "MajpDistance" field (Single, since that was the output of your function).

Not only are our numbers different - and they are wildly different - yours does not even match your last post for the trip. You listed Tallahassee to Nashville as a leg of 419 miles, but using your code I got a value of 141.6483.

Using my code I got 363.07-ish. But sometimes you were higher than I, and sometimes lower. I think there is something funny in your code, and that maybe you didn't use it before you posted your Little Rock circuit...?

I checked flight-planning software available to members of AOPA (Aircraft Owner/Pilot Associataion) that plots Great Circle distances for two cities, and the numbers I got were within decimal places of accuracy.

Here is the code that I used. Did I apply your function incorrectly?

[green]'MajP's function[/green]
Function polarDistance(decLatStart As Single, decLongStart As Single, decLatEnd As Single, decLongEnd As Single) As Single
Const decToRad = 3.14159265358979 / 180
Const radiusOfEarth = 3443.9
'radiusOfEarth =3963.1 statute miles, 3443.9 nautical miles, or 6378 km
Dim radLatStart As Single
Dim radLongStart As Single
Dim radLatEnd As Single
Dim radLongEnd As Single
radLatStart = decLatStart * decToRad
radLongStart = decLongStart * decToRad
radLatEnd = decLatEnd * decToRad
radLongEnd = decLongEnd * decToRad
polarDistance = ArcCos(Cos([radLatStart]) * Cos([radLongStart]) * Cos([radLatEnd]) * Cos([radLongEnd]) + Cos([radLatStart]) * Sin([radLongStart]) * Cos([radLatEnd]) * Sin([radLongEnd]) + Sin([radLatStart]) * Sin([radLatEnd])) * radiusOfEarth
End Function

'[green]Cos[sup]-1[/sup](X) from help file[/green]
Function ArcCos(X As Double) As Double
  ArcCos = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
End Function

'[green]my function[/green]
Function GetPolarDistance(decWestCity1 As Double, decNorthCity1 As Double, _
                          decWestCity2 As Double, decNorthCity2 As Double) As Double
Const decToRad As Double = 3.14159265358979 / 180
Const radiusOfEarth As Double = 60 / decToRad
'radiusOfEarth = 69 statute miles, 60 nautical miles, or 111 km
Dim rWestCity1 As Double
Dim rNorthCity1 As Double
Dim rWestCity2 As Double
Dim rNorthCity2 As Double
rWestCity1 = decWestCity1 * decToRad
rNorthCity1 = decNorthCity1 * decToRad
rWestCity2 = decWestCity2 * decToRad
rNorthCity2 = decNorthCity2 * decToRad

GetPolarDistance = ArcCos((Sin(rNorthCity1) * Sin(rNorthCity2)) + (Cos(rNorthCity1) * Cos(rNorthCity2) * Cos(rWestCity1 - rWestCity2))) * radiusOfEarth

End Function

[green]'my code to populate my table[/green]
Public Sub GenerateDistances()
Dim rs1 As DAO.Recordset, rs2 As DAO.Recordset
Dim rsDist As DAO.Recordset
Set rs1 = CurrentDb.OpenRecordset("Cities", dbOpenSnapshot)
Set rs2 = CurrentDb.OpenRecordset("Cities", dbOpenSnapshot)
Set rsDist = CurrentDb.OpenRecordset("PolarDistances")
While Not rs1.EOF
    While Not rs2.EOF
        If rs1!City <> rs2!City Then
            rsDist.AddNew
                rsDist!City1 = rs1!City
                rsDist!City2 = rs2!City
                rsDist!Distance = GetPolarDistance(rs1!West, rs1!North, rs2!West, rs2!North)
                rsDist!majpDistance = polarDistance(rs1!West, rs1!North, rs2!West, rs2!North)
            rsDist.Update
        End If
        rs2.MoveNext
    Wend
    rs1.MoveNext
    rs2.MoveFirst
Wend
Set rs1 = Nothing
Set rs2 = Nothing
Set rsDist = Nothing
End Sub

Here is a sample of the data from the table so you can see how different we are:

City1	City2	        Distance		MajPDistance
Albany	Annapolis	261.135375182862	176.2552
Albany	Atlanta		740.071311156757	645.4684
Albany	Augusta		197.729566927181	242.2008
Albany	Austin		1365.71432852577	1429.076
Albany	Baton Rouge	1107.25881749444	1041.398
Albany	Bismarck	1167.12601566514	1618.923
Albany	Boise		1836.72999027191	2549.491
Albany	Boston		124.412038340754	166.4421
Albany	Carson City	2068.07471004871	2761.639
Albany	Charleston	441.941541103352	471.8528
Albany	Cheyenne	1379.60487232177	1864.145
Albany	Columbia	629.744866667136	453.2937
Albany	Columbus	440.703481024986	546.8431
Albany	Concord		104.511650560964	138.4814
Albany	Denver		1404.89940280098	1866.682
Albany	Des Moines	884.073782865019	1193.091
Albany	Dover		229.757697896041	115.5152
Albany	Frankfort	575.882483958062	668.6093
Albany	Harrisburg	202.937953036087	182.4783
Albany	Hartford	79.5617537033506	71.33547
Albany	Helena		1629.87561341705	2294.789
Albany	Indianapolis	590.903024889168	750.7397
Albany	Jackson		992.98374847346		978.6664
Albany	Jefferson City	871.540207834653	1104.665
Albany	Lansing		475.391933672301	649.1598
Albany	Lincoln		1029.61738916198	1379.305
Albany	Little Rock	984.601636610333	1106.822
Albany	Madison		681.678837886655	933.6691
Albany	Minneapolis	848.208287451863	1166.973
Albany	Montgomery	860.715210577584	759.9042
Albany	Montpelier	103.395142489812	81.1599
Albany	Nashville	716.270416332485	776.0505
Albany	Oklahoma City	1187.99897321767	1427.966
Albany	Olympia		2069.08353804072	2949.404
Albany	Phoenix		1871.30561689639	2289.413
Albany	Pierre		1150.46565761489	1591.688
Albany	Providence	121.534022480808	143.4158
Albany	Raleigh/Durham	473.164437123302	314.6622
Albany	Richmond	354.177308625487	226.2673
Albany	Sacramento	2157.76009575364	2865.27
Albany	Salem		2101.21309619604	2957.791
Albany	Salt Lake City	1697.80933683251	2293.75
Albany	Santa Fe	1550.66510644857	1936.606
Albany	Springfield	735.171457078689	953.73
Albany	Tallahassee	898.285814268909	646.9596
Albany	Topeka		1011.34093327677	1311.821
Albany	Trenton		158.085124849205	71.2433
Albany	Washington, Nat	276.212958777673	203.006

Here are the resources I used:

GREAT CIRCLE CALC:

http://people.hofstra.edu/geotrans/eng/ch1en/conc1en/greatcircle.html

NAUTICAL MILE:

http://en.wikipedia.org/wiki/Nautical_mile

 

[MajP]

Your using my function wrong somewhere. If you go up to my prior post, you can see that I go from Hartford to Albany, and Albany to Harrisburg. The distances listed are 234 and 92 not 182 and 71 as you listed. I used those two web page distance calculators and also got a distance of 234 and 92.
From the web site:

Distance between  42 45' 0"N  73 48' 0"w and  41 44' 0"n  72 39' 0"w is
91.7203 statute miles

This calculation assumes the earth is a perfect sphere
with a radius of 3963.1 statute miles

[URL unfurl="true"]http://jan.ucc.nau.edu/~cvm/latlongdist.html[/URL]

Maybe we are talking two different things. I went to this site also.

http://www.fai.org/distance_calculation/

Which is an aviation site and got a value of 418 for Nashville to Tenessee just like my code. So my distances checks with these calculators. Send me the link to your calculator, maybe it is a great circle route versus a linear route.

We have our arguments switched as well. Unlikely, but any chance you are running my function with your argument order

 

[rubbernilly]

That was the trick. I *was* feeding the arguments to your function in the wrong order. I reran the data again and now we are much more closely in line. There is the expected gradient of diversion with your code using your constant for the radius of the earth and mine using my constant (just a little different). Here is a snippet of the data:

City1 City2 Distance MajPDistance
Albany Annapolis 261.135375182857 261.6026
Albany Atlanta 740.071311156757 741.3959
Albany Augusta 197.729566927188 198.0833
Albany Austin 1365.71432852577 1368.159
Albany Baton Rouge 1107.25881749444 1109.241
Albany Bismarck 1167.12601566514 1169.215
Albany Boise 1836.72999027191 1840.017
Albany Boston 124.412038340753 124.6349
Albany Carson City 2068.07471004871 2071.776


You can see the greater the distance, the greater our diversion.

I'll take these numbers back now and see what route I come up with.

 

[MajP]

It is still all an approximation anyways, unless you can get the true radius for each point. The earth is not a sphere. I was using the equatorial radius which is 3963 (center of earth to point on equator), but the polar radius is 3949. The average within the US would be something between 3963 and 3949. so actually I should use 3,959, the ellipsoid quadratic mean radius which is probably the best approximation.

 

[MichaelRed]

an alternative, and slightly smaller routine for the "polar" distance calculations:

Public Function basWayPointDist(sglLat1 As Single, sglLon1 As Single, sglLat2 As Single, sglLon2 As Single) As Single


    Dim sglAvgLat As Single     'Used to get the Cos for Longitude
    Dim sglMilesPerDegLon       'Actual Miles per Degree for the Longitude
    Dim sglDistEW As Single
    Dim sglDistNS As Single
    Dim sglPi As Single

    sglPi = (22 / 7)

    sglAvgLat = Abs(sglLat1 + sglLat2) / 2
    sglMilesPerDegLon = Cos((sglPi / 180) * sglAvgLat) * 69
    sglDistEW = Abs((sglLon1 - sglLon2)) * sglMilesPerDegLon
    sglDistNS = Abs(sglLat1 - sglLat2) * 69

    basWayPointDist = Sqr((sglDistNS ^ 2) + (sglDistEW ^ 2))

End Function

I did modify it somewhat -to be "compatible / comparable" to the above, and made it a few lines longer than necessary just for ease of interpertation. From some obscure text on geography, a degree of latitude is 'assumed' to be constant at ~~ 69 Miles ~~ 111 KM), while a degree of longitude varrys from this vvalue (at the equator) to ~~ 0 (at the poles). Using simple interpolation of the latitude (avgLat) and linear proportionality, the above associates closely with the values (at least the VERY few I checked) with MajP's posting above.





MichaelRed

 

[rubbernilly]

That's actaully very interesting, Michael... and very cool that there are now 3 completely different formulas for determining the distance using polar coordinates. We are getting some very promising results with these new polar coordinates. I wrote some code to interface with my previous code to start 'en media res,' so to speak. The code lets you set any number of start cities to "hard code" those as the start.

That is, you tell the code that you know the first x cities are these particular x, and it continues from there.

Using the code, I believe our current best is about 8600 miles, but I'll have to double check that. I know that it started in Augusta, and fed 12 cities down to Richmond. Here is the code:

Public Sub EnMediaRes()
Dim rs As DAO.Recordset
Dim a As Integer, dbCurrentDistance As Double
Dim sVisitedCities() As String

dbShortest = 9300
sVisitedCities() = Split("Albany,Montpelier,Augusta,Concord,Boston,Providence,Hartford,Trenton,Harrisburg,Dover,Annapolis,Richmond", ",")

For a = 0 To UBound(sVisitedCities) - 1
  dbCurrentDistance = dbCurrentDistance + DLookup("Distance", "Distances", "City1 = '" & _
                      sVisitedCities(a) & "' AND City2 = '" & sVisitedCities(a + 1) & "'")
Next a

subGetRoute sVisitedCities(UBound(sVisitedCities)), _
            "'" & Join(sVisitedCities, "','") & "',", _
            dbCurrentDistance, UBound(sVisitedCities)

Set rs = CurrentDb.OpenRecordset("ShortestRoutes")
With rs
  .AddNew
    !StartCity = sVisitedCities(UBound(sVisitedCities))
    !TotalDistance = dbShortest
    !RoutePath = sPath
  .Update
End With
Set rs = Nothing
MsgBox "Done. Remove this box for multiple city processing." & vbCrLf & _
       sVisitedCities(UBound(sVisitedCities)) & ": " & dbShortest, vbOKOnly
End Sub

 

[BoxHead]

Hi, rubbernilly,

I'm wondering if you or anyone else has made any progress on defining a better process.

I know the mileage calulation has been an issue, but it still seems that you either have to try all permutations of the 37 remaining caps (13,763,753,091,226,300,000,000,000,000,000,000,000,000,000) or continue randomly until you feel your answer is good enough.

What I've tried without success (but I'm hoping it can add to the discussion) is
1) Trying to avoid moving in the shortest wrong direction, move from city A to B and select C based on it's combined distance from A and B.
2) Predetermining the order based on total possible miles for each city. The idea was to eliminate the mile-eaters like Olympia (average trip 1755 mi) before considering ones like Springfield (Avg:756).
3) Including the West and North coordinates for City2 in the distance table to divide the country into quadrants based on the average North and West location. Always look for a city in current quadrat before moving to next section.
4) Created a city - a point as far north and west as any city - and tried to always move away from that point to avoid backtracking.

Like I said, none of these showed much improvement and none of them showed any consistent change.

If you look at the minimum trip to each city and add those up, it's 7,490 miles (using your coordinates and MajP's mile calculation). If you're at 8600 miles, I have to wonder how much longer does it make sense to run the code? Will you ever get to a point where you know that your answer is correct or will the answer become the lowest-attained calculation at the point you have to make a decision?

Are there other methods tried by any of the posters that have worked or failed? My next thought is to scribe a single path across the country and calculate the deviation of each stop from that path, and then scribe a triangle and a diamond, etc.

If people have already tried these things and could share their findings it might lead to a better solution overall.

Thanks,


John











"I could have fired him because he cut the board 2' 5" long when I asked for 25 inches.
I could have fired him because he threw that board aside to find another one when it only needed 4" cut off of it.
I had to fire him beacause when he threw the board, I heard him say, 'Stupid wood!'" -The Foreman

 

[MajP]

Boxhead,
There are many better heuristics already defined. The original process we used was a "nearest neighbor heuristic". This solution is known as a "Greedy" solution because it finds the best solution for each step. Sometimes these greedy algorithms can produce the best overall solution.
The good news is that better solutions often need a starting point, such as our greedy solution. Two other types of solutions usually used in this case are "insertion" and "exchange" heuristics. The insertion heuristic deal with moving a node into another location, the exchange heuristics look at reconnecting pairs (or larger groups).
I am working on coding a "2-Opt exchange", hopefully have it done soon. Here is a website if you want to try some of the other algorithms. Maybe try a Lin-Kernighan exchange. I like to see that in Access.