Income Tax Visual Basic (1 Viewer)

[b.rodgers]

Hi everyone again! This is the second and last assignment I need help on for visual basic. It says, "The flowchart below calculates a person’s state income tax. Write a program corresponding to the flowchart." I have attached the flowchart below.

Thanks again.

 

[MajP]

So lets see the code you have so far? You might find something a little more involved, but here is a basic method I use for that tax problem

Const Infinity = 1E+308
Private m_Edges As Edges
'Need an NxN of the vertices not just the real edges
'------------ Procedures ----------------------------------------------
Public Sub InitializeFloyd_Marshall(TheEdges As Edges)
  Dim I As Long
  Dim j As Long
  Dim startKeys() As Variant
  Dim endKeys() As Variant
  Set Me.Edges = TheEdges
  startKeys = Me.Edges.startKeys
 
  For I = 0 To UBound(startKeys)
    endKeys = Me.Edges.endKeys(CStr(startKeys(I)))
    For j = 0 To UBound(endKeys)
      Me.Edges.Item(CStr(startKeys(I)), CStr(endKeys(j))).ShortestPathDistance = Me.Edges.Item(CStr(startKeys(I)), CStr(endKeys(j))).EdgeDistance
     Next j
  Next I
  Me.Edges.Item(CStr(startKeys(0)), CStr(endKeys(0))).ShortestPathDistance = 0
      
End Sub
Public Property Get Edges() As Edges
  Set Edges = m_Edges
End Property

Public Property Set Edges(ByVal TheEdges As Edges)
  Set m_Edges = TheEdges
End Property


Public Sub SolveAllPaths()
  Dim colOut As Collection
  Dim Neighbors() As Variant
  Dim SpanningVertex As Vertex
  Dim VisitedVertex As Vertex
  Dim TempVertex As Vertex
  Dim I_Key As String
  Dim J_Key As String
  Dim K_key As String
  Dim I As Integer
  Dim j As Integer
  Dim k As Integer
  Dim The_keys() As Variant
  Dim distance_i_j As Double
  Dim distance_i_k As Double
  Dim distance_k_j As Double
  Dim newDistance As Double
  Dim n As Long
 
  n = Me.Edges.count
  The_keys = Me.Edges.startKeys
  For k = 0 To n - 1
    K_key = The_keys(k)
    For I = 0 To n - 1
       I_Key = The_keys(I)
       For j = 0 To n - 1
         J_Key = The_keys(j)
         distance_i_j = Me.Edges.Item(I_Key, J_Key).ShortestPathDistance
         distance_i_k = Me.Edges.Item(I_Key, K_key).ShortestPathDistance
         distance_k_j = Me.Edges.Item(K_key, J_Key).ShortestPathDistance
         If distance_i_k = Infinity Or distance_k_j = Infinity Then
             newDistance = Infinity
         Else
             newDistance = distance_i_k + distance_k_j
         End If
         If newDistance < distance_i_j Then
              'Debug.Print "i,j,k " & I_Key & " " & J_Key & " " & K_key & " dist " & newDistance
             Me.Edges.Item(I_Key, J_Key).ShortestPathDistance = newDistance
             Me.Edges.Item(I_Key, J_Key).NextVertexKey = K_key
         End If
       Next j
    Next I
  Next k
End Sub
Public Function GetPath(startKey As String, endkey As String) As String
  Dim Path As String
  If startKey = endkey Then
    Path = ""
  Else
    Path = Trim(RecursePath(startKey, endkey))
  End If
  If Path <> "" Then
   Path = " " & Path & " "
  Else
   Path = " "
  End If
  If Path = "No path" Then
    GetPath = Path
  Else
    GetPath = "Path: " & startKey & Path & endkey
  End If
End Function
Public Function GetShortestPathDistance(startKey As String, endkey As String) As Double
 If startKey = endkey Then
   GetShortestPathDistance = 0
 Else
   GetShortestPathDistance = Me.Edges.Item(startKey, endkey).ShortestPathDistance
 End If
End Function
Private Function RecursePath(startKey As String, endkey As String) As String
 'recursively reconstruct shortest path from i to j using A and Nxt
 Dim TmpStartKey As String
 If Me.Edges.Exists(startKey, endkey) Then
   If Me.Edges.Item(startKey, endkey).ShortestPathDistance = Infinity Then
     RecursePath = "No path"
   Else
      TmpStartKey = Me.Edges.Item(startKey, endkey).NextVertexKey
      If TmpStartKey = "" Then  'The path from i to j is shortest and exists
       RecursePath = ""
      Else
       'Debug.Print startKey & " " & TmpStartKey
       RecursePath = RecursePath(startKey, TmpStartKey) & " " & TmpStartKey & " " & RecursePath(TmpStartKey, endkey)
       RecursePath = Trim(RecursePath)
      End If
   End If
 Else
   RecursePath = "No path"
 End If
End Function

Public Function GetPathNames(startKey As String, endkey As String) As String
  Dim PathNames As String
  If startKey = endkey Then
    PathNames = ""
  Else
    PathNames = Trim(RecursePathNames(startKey, endkey))
  End If
  If PathNames <> "" Then
   PathNames = " " & PathNames & " "
  Else
   PathNames = " "
  End If
  If PathNames = "No path" Then
    GetPathNames = PathNames
  Else
    GetPathNames = "PathNames: " & Me.Edges.Item(startKey, startKey).StartVertexName & PathNames & Me.Edges.Item(endkey, endkey).EndVertexName
  End If
End Function

Private Function RecursePathNames(startKey As String, endkey As String) As String
 'recursively reconstruct shortest path from i to j using A and Nxt
 Dim TmpStartKey As String
 If Me.Edges.Exists(startKey, endkey) Then
   If Me.Edges.Item(startKey, endkey).ShortestPathDistance = Infinity Then
     RecursePathNames = "No path"
   Else
      TmpStartKey = Me.Edges.Item(startKey, endkey).NextVertexKey
      If TmpStartKey = "" Then  'The path from i to j is shortest and exists
       RecursePathNames = ""
      Else
       'Debug.Print startKey & " " & TmpStartKey
       RecursePathNames = RecursePathNames(startKey, TmpStartKey) & " " & Me.Edges.Item(TmpStartKey, TmpStartKey).StartVertexName & " " & RecursePathNames(TmpStartKey, endkey)
       RecursePathNames = Trim(RecursePathNames)
      End If
   End If
 Else
   RecursePathNames = "No path"
 End If
End Function

 

[MajP]

Sorry you would need this too

Const Infinity = 1E+308
Private m_Edges As Edges
Private m_Vertices As Vertices
Private m_startKey As String
Private m_endKey As String

'------------ Procedures ----------------------------------------------
Public Sub InitializeDijkstra(TheVertices As Vertices, TheEdges As Edges)
  Set Me.Vertices = TheVertices
  Set Me.Edges = TheEdges
End Sub
Public Property Get Edges() As Edges
  Set Edges = m_Edges
End Property

Public Property Set Edges(ByVal TheEdges As Edges)
  Set m_Edges = TheEdges
End Property
Public Property Get Vertices() As Vertices
  Set Vertices = m_Vertices
End Property

Public Property Set Vertices(ByVal TheVertices As Vertices)
  Set m_Vertices = TheVertices
End Property
Public Sub RunShortestPath(startKey As String, endkey As String)
  Dim Path As String
  Dim ShortestDistance As Double
  Dim Neighbors() As Variant
  Dim SpanningVertex As Vertex
  Dim VisitedVertex As Vertex
  Dim TempVertex As Vertex
  Dim MinDistance As Double
  Dim I As Integer
  m_startKey = startKey
  m_endKey = endkey
  'If startKey = endkey Then
  '  MsgBox "Start and End Keys must be different", vbInformation
  '  Exit Sub
  'End If
  Set TempVertex = Me.Vertices.Item(startKey)
  TempVertex.VisitedDistance = 0 ' Set the starting vertex distance to 0
   Do ' Until reaching EndKey
     MinDistance = Infinity
     For I = 1 To Me.Vertices.count
       Set TempVertex = Me.Vertices.Item(I)
       If TempVertex.NeighborsVisited = False Then
         If TempVertex.VisitedDistance < MinDistance Then
           MinDistance = TempVertex.VisitedDistance
           Set SpanningVertex = TempVertex
           'Debug.Print "SPANNING " & SpanningVertex.VertexKey
         End If
       End If
     Next I
     SpanningVertex.NeighborsVisited = True
     If SpanningVertex.VertexKey = endkey Then Exit Do
     If MinDistance = Infinity Then
       'GetShortestPath = "The end vertex is diconnected and cannot be reached"
       'MsgBox "The end vertex is diconnected and cannot be reached", vbInformation
       Exit Sub
     End If
    'You selected this one to span its neighbors
    'Debug.Print "before"
    If Me.Edges.StartVertices.Exists(SpanningVertex.VertexKey) Then 'Needed in case of disconnected node.
        Neighbors = Me.Edges.endKeys(CStr(SpanningVertex.VertexKey))
        'Debug.Print "after neighbors"
         For I = 0 To UBound(Neighbors)
          Set VisitedVertex = Me.Vertices.Item(Neighbors(I))
          MinDistance = SpanningVertex.VisitedDistance + Me.Edges.Item(SpanningVertex.VertexKey, VisitedVertex.VertexKey).EdgeDistance
          If VisitedVertex.VisitedDistance > MinDistance Then
             VisitedVertex.VisitedDistance = MinDistance
             Set VisitedVertex.PreviousVertex = SpanningVertex
          End If
        Next I
    End If
    Loop
  
End Sub
Public Property Get ShortestPath_IDs() As String
  Dim TempVertex As Vertex
  Dim Path As String
  Set TempVertex = Me.Vertices.Item(m_endKey)
  If m_startKey = m_endKey Then
    ShortestPath_IDs = m_startKey & "," & m_endKey
    Exit Property
  End If
  Path = TempVertex.VertexKey
   'Read the previous node starting from the end key
   Do
    Set TempVertex = TempVertex.PreviousVertex
    If TempVertex Is Nothing Then
      ShortestPath_IDs = "No Path"
      Exit Sub
    End If
    Path = TempVertex.VertexKey & "," & Path
    'Debug.Print TempVertex.VertexKey
   Loop Until TempVertex.VertexKey = m_startKey
   ShortestPath_IDs = Path
End Property
Public Property Get ShortestPath_Names() As String
  Dim TempVertex As Vertex
  Dim Path As String
  Set TempVertex = Me.Vertices.Item(m_endKey)
  If m_startKey = m_endKey Then
    ShortestPath_Names = Me.Vertices.Item(m_startKey).Vertexname & "," & Me.Vertices.Item(m_endKey).Vertexname
    Exit Property
  End If
  Path = TempVertex.Vertexname
   'Read the previous node starting from the end key
   Do
    Set TempVertex = TempVertex.PreviousVertex
    If TempVertex Is Nothing Then
      ShortestPath_Names = "No Path"
      Exit Sub
    End If
    Path = TempVertex.Vertexname & ", " & Path
    'Debug.Print TempVertex.VertexKey
   Loop Until TempVertex.VertexKey = m_startKey
   ShortestPath_Names = Path
End Property
Public Property Get ShortestPathDistance() As Double
    If m_startKey = m_endKey Then
      ShortestPathDistance = 0
    Exit Property
  End If
   ShortestPathDistance = Me.Vertices.Item(m_endKey).VisitedDistance
End Property

 

[Rene vK]

Easy money

 

[arnelgp]

It's not about the "shortest path", it's about calculating one's income tax.
the solution is simple, but you need to pay attention to your prof while
at class (no cp).

 

[Dreamweaver]

Thanks @MajP Thats one for my code library the misses asked me about calculting her tax the other day I will of course tell her I didn't do it

Sorry don't do a lot with classes can both your posts be put in one clsss?

 

[Uncle Gizmo]

I agree with ArnelGP, it is a student question and therefore it needs a simple answer not a class module.

However it is an unwritten rule that we don't do the work for students, we guide them through the way to think about the problem.

The first step in the flowchart is asking for an input, and this could be be done with a simple input box.

InputBox function (Visual Basic for Applications)

Office VBA reference topic

docs.microsoft.com

The next step, and several of the other steps are choices of yes or no and these are usually best tackled with an if statement:-

MS Access: IF-THEN-ELSE Statement

This MSAccess tutorial explains how to use the Access IF-THEN-ELSE statement with syntax and examples. The Microsoft Access IF-THEN-ELSE statement can only be used in VBA code.

www.techonthenet.com

This one is probably a little more complicated with the Else IF which is probably not necessary for the student answer required.

It is very important that you make an attempt to put something together with the information provided here.

Post your results, whether it works or not and I'm sure you will get as much help as you need to perfect it.

 

[Uncle Gizmo]

Regarding the flowchart, I've never seem empty circles employed for providing a junction. I think it's an excellent idea! I can see myself using that in future flowcharts!

 

[Uncle Gizmo]

I also note that you have put the question in the visual basic section, visual basic is slightly different to Microsoft Access, mainly in that the interface is different.

The essence of the code is very similar in both visual basic and Microsoft Access (which uses visual basic for applications). You could probably provide your answer in MS Access, but you might need to clarify this point before you proceed much further with your assignment.

 

[Dreamweaver]

I thought they had ended VB?

 

[Uncle Gizmo]

If you do decide to continue with Microsoft Access, then you might find my blog "VBA beginners" helpful:-

VBA Beginner – Nifty Access

www.niftyaccess.com

 

[CJ_London]

can easily be done in a query

 

[MajP]

Oh my God. I am laughing so hard. I guess I should have added a sarcasm emoticon. Which is this according to Wikipedia.
If you post two of your homework problems, provide no effort, and expect someone to do it for you than you may get a sarcastic response. The fact that I threw up some real complicated code and some of you thought I was serious is hilarious.

 

[Minty]

@MajP WIll that code work out the Great Arc tax for me?

 

[MajP]

@MajP WIll that code work out the Great Arc tax for me?

It will but you need to add

Private Function GetPolarDistance(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
    GetPolarDistance = ArcCos((Cos([radLatStart]) * Cos([radLongStart]) * Cos([radLatEnd]) * Cos([radLongEnd])) + Cos([radLatStart]) * Sin([radLongStart]) * Cos([radLatEnd]) * Sin([radLongEnd]) + (Sin([radLatStart]) * Sin([radLatEnd]))) * radiusOfEarth
    '                     (cos($a1)*            cos($b1)*             cos($a2)*          cos($b2)          + cos($a1)*            sin($b1)*              cos($a2)*          sin($b2) +          sin($a1)*             sin($a2)        ) * $r
    '                 acos((cos($a) *           cos($b) *             cos($c) *          cos($d)) +          (cos($a) *           sin($b) *              cos($c) *           sin($d)) +         (sin($a) *            sin($c)) ) * $r
End Function
Private Function ArcCos(X As Single) As Single
    If Abs(X) <> 1 Then
        ArcCos = 1.5707963267949 - Atn(X / Sqr(1 - X * X))
    Else
        ArcCos = 3.14159265358979 * Sgn(X)
    End If
    'ArcCos = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
End Function

 

[Uncle Gizmo]

The fact that I threw up some real complicated code and some of you thought I was serious is hilarious.

I knew exactly what you were doing, sad really.

 

[Dreamweaver]

I'm having a bad day that's my excuse But it was interesting code lol

 

[Uncle Gizmo]

I should have added a sarcasm emoticon. Which is this according to Wikipedia.

I use that all the time, like a signature. I never realised it represented sarcasm! I think I might have to change my signature!

 

[Rene vK]

Oh my God. I am laughing so hard. I guess I should have added a sarcasm emoticon. Which is this according to Wikipedia.
If you post two of your homework problems, provide no effort, and expect someone to do it for you than you may get a sarcastic response. The fact that I threw up some real complicated code and some of you thought I was serious is hilarious.

that's why I reacted with: easy money But you did good!

 

[CJ_London]

Suspect the OP finished the course around 2 years ago

edit: and your post looks suspiciously like an attempt to spam