Equation solver , find intersection from infinite line to shape vba/java

[Olivia86]

I'm trying to implement this situation inside an actual VBA/java program.

https://www.geogebra.org/calculator/qranh66u

I need to acquire the intersections point created by the shape and the intersection line. I surfed the web and studied newton's method and other approaches, but they seem all too complex or hardly implementable.

Is there a way to find the intersection point given the equation you see in the link?


From eq1 to f, I have to find A and B

for example:

eq1: (((abs(x))/(a)))^(2 ((a)/(r)))+(((abs)/(b)))^(2 ((b)/(r)))=1

intersection with

f: y=tan(15 ((π)/(180))) x

when a = 900
and b = 400
and r=5
it
generates
POINT A (-4,-1.07) and point B ( 4+1.07)

I need to implement this function in a program, so when I change "f" or "eq1" parameters I get the new points

Java or VBA but VBA is preferable


So if you can give me some info, or at least where to watch it would be great. Thanks!

 

[Agent666]

Here's something I prepared earlier.... VBA to return all intersections for two lines with X/Y coordinates

Links in code to certain articles/algorithms on which it is based

Code could definitely be simplified, I tend to refactor a lot of stuff so I can use it in multiple functions without repeating.

Try this:-
Link to example

Public Function geo_line_complex_intersect(xy_line_1 As Variant, xy_line_2 As Variant, Optional compact_results As Boolean = True) As Variant
'function to return all XY intersections between two defined continuous lines or broken lines
'leave blank rows or #NA between line coordinates to use individual unconnected lines as inputs

'create array from input data
    xy_line_1 = array_convert_rng_to_array(xy_line_1)
    xy_line_2 = array_convert_rng_to_array(xy_line_2)

    On Error GoTo 0
    Dim line_1_count As Long
    Dim line_2_count As Long
    Dim i As Long
    Dim count_x As Long
    Dim count_y As Long
    Dim x1_line_1 As Double
    Dim x2_line_1 As Double
    Dim x1_line_2 As Double
    Dim x2_line_2 As Double
    Dim y1_line_1 As Double
    Dim y2_line_1 As Double
    Dim y1_line_2 As Double
    Dim y2_line_2 As Double
    Dim xy_intersection(1 To 1, 1 To 2) As Variant
    Dim xy_intersection_results As Variant
    Dim x_intersection As Double
    Dim y_intersection As Double
    Dim line_1_segment(1 To 2, 1 To 2)
    Dim line_2_segment(1 To 2, 1 To 2)
    Dim temp

    'replace any #NA errors with equivalent of 'Empty'/vbNullString
    xy_line_1 = array_replace_errors(xy_line_1)
    xy_line_2 = array_replace_errors(xy_line_2)

    'loop through first line line segments and check for intersections with all segments of second line
    For line_1_count = 1 To UBound(xy_line_1) - 1
        'create line 1 segment array
        line_1_segment(1, 1) = xy_line_1(line_1_count, 1)
        line_1_segment(2, 1) = xy_line_1(line_1_count + 1, 1)
        line_1_segment(1, 2) = xy_line_1(line_1_count, 2)
        line_1_segment(2, 2) = xy_line_1(line_1_count + 1, 2)

        'check if line 1 segment includes blank/empty coordinate rows, and skip processing this line segment
        If array_value_in_array(vbNullString, line_1_segment) Then GoTo skip_line_1

        For line_2_count = 1 To UBound(xy_line_2) - 1
            'create line 2 segment array
            line_2_segment(1, 1) = xy_line_2(line_2_count, 1)
            line_2_segment(2, 1) = xy_line_2(line_2_count + 1, 1)
            line_2_segment(1, 2) = xy_line_2(line_2_count, 2)
            line_2_segment(2, 2) = xy_line_2(line_2_count + 1, 2)

            'check if line 2 segment includes blank/empty coordinate rows, and skip processing this line segment
            If array_value_in_array(vbNullString, line_2_segment) Then GoTo skip_line_2

            'check and determine intersection point coordinates
            temp = geo_line_intersect(line_1_segment, line_2_segment)

            'create intersection coordinates results array
            If i = 0 Then
                'first intersection
                xy_intersection(1, 1) = temp(0)
                xy_intersection(1, 2) = temp(1)
                xy_intersection_results = xy_intersection
                i = 1
            Else
                'subsequent intersections
                xy_intersection(1, 1) = temp(0)
                xy_intersection(1, 2) = temp(1)
                xy_intersection_results = CombineArrays(xy_intersection_results, xy_intersection)
            End If
skip_line_2:
        Next line_2_count
skip_line_1:
    Next line_1_count

    'compact results removing any #NA rows/results
    If compact_results Then
        xy_intersection_results = array_remove_error_rows(xy_intersection_results)
    End If

    'return results
    geo_line_complex_intersect = xy_intersection_results

End Function

Public Function geo_line_intersect(xy_line_1 As Variant, xy_line_2 As Variant) As Variant
'test to determine if two lines intersect based on XY coordinates, returns XY coordinate of intersection point if
'line segments cross each other. Otherwise returns NA errors
'Refer [URL unfurl="true"]https://en.wikipedia.org/wiki/Line-line_intersection[/URL]

'create array from input data
    xy_line_1 = array_convert_rng_to_array(xy_line_1)
    xy_line_2 = array_convert_rng_to_array(xy_line_2)

    'setup variables for individual points
    Dim x1_line_1 As Double
    Dim x2_line_1 As Double
    Dim x1_line_2 As Double
    Dim x2_line_2 As Double
    Dim y1_line_1 As Double
    Dim y2_line_1 As Double
    Dim y1_line_2 As Double
    Dim y2_line_2 As Double
    Dim x_intersection As Double
    Dim y_intersection As Double

    Dim t As Double
    Dim u As Double
    Dim denominator As Double

    'read individual points coords
    x1_line_1 = xy_line_1(1, 1)
    x2_line_1 = xy_line_1(2, 1)
    x1_line_2 = xy_line_2(1, 1)
    x2_line_2 = xy_line_2(2, 1)
    y1_line_1 = xy_line_1(1, 2)
    y2_line_1 = xy_line_1(2, 2)
    y1_line_2 = xy_line_2(1, 2)
    y2_line_2 = xy_line_2(2, 2)

    'denominator, if denominator is zero then lines are parallel
    denominator = (x1_line_1 - x2_line_1) * (y1_line_2 - y2_line_2) - (y1_line_1 - y2_line_1) * (x1_line_2 - x2_line_2)

    If denominator <> 0 Then
        'lines are not parallel
        t = ((x1_line_1 - x1_line_2) * (y1_line_2 - y2_line_2) - (y1_line_1 - y1_line_2) * (x1_line_2 - x2_line_2)) / denominator
        u = -((x1_line_1 - x2_line_1) * (y1_line_1 - y1_line_2) - (y1_line_1 - y2_line_1) * (x1_line_1 - x1_line_2)) / denominator
    Else
        'line segments are parallel
        geo_line_intersect = Array(CVErr(xlErrNA), CVErr(xlErrNA))
        Exit Function
    End If

    'check if lines intersect
    If u >= 0 And u <= 1 And t >= 0 And t <= 1 Then
        'line segments do intersect
        'intersection point coordinates
        x_intersection = x1_line_1 + t * (x2_line_1 - x1_line_1)
        y_intersection = y1_line_1 + t * (y2_line_1 - y1_line_1)
        geo_line_intersect = Array(x_intersection, y_intersection)
    Else
        'line segments do not intersect
        geo_line_intersect = Array(CVErr(xlErrNA), CVErr(xlErrNA))
    End If

End Function

Public Function array_remove_error_rows(arr As Variant) As Variant
'Function to remove rows that contain an error in array

    arr = array_convert_rng_to_array(arr)

    Dim temp_arr As Variant
    Dim valid_count As Long
    Dim row_count As Long
    Dim row1 As Long
    Dim row2 As Long
    Dim col_count As Long
    Dim col_loop As Long
    Dim col1 As Long
    Dim col2 As Long

    'establish array limits for 1st and 2nd dimensions
    row1 = LBound(arr, 1)
    row2 = UBound(arr, 1)
    col1 = LBound(arr, 2)
    col2 = UBound(arr, 2)

    'determine number of valid points and write to array removing #NA results
    valid_count = LBound(arr, 1) - 1

    For row_count = row1 To row2
        For col_count = col1 To col2
            If IsError(arr(row_count, col_count)) Then
                GoTo skip_row
            End If
            'at end of row (at last column) execute following if there were no errors in the row of data and
            're-write entire row values to new row position
            If col_count = col2 Then    'last column
                valid_count = valid_count + 1
                'loop through all columns at current row and populate values to new position
                For col_loop = col1 To col2
                    arr(valid_count, col_loop) = arr(row_count, col_loop)
                Next col_loop
            End If
        Next col_count
skip_row:
    Next row_count

    'resize results array to remove trailing #NA results
    temp_arr = arr
    ReDim arr(row1 To valid_count, col1 To col2)
    For row_count = row1 To valid_count
        For col_count = col1 To col2
            arr(row_count, col_count) = temp_arr(row_count, col_count)
        Next col_count
    Next row_count

    'return results
    array_remove_error_rows = arr

End Function

Public Function array_value_in_array(value_to_be_found As Variant, arr As Variant) As Boolean
'Function to check if a value is in an array of values

    Dim element As Variant
    On Error GoTo error_handling:
    For Each element In arr
        If element = value_to_be_found Then
            array_value_in_array = True
            Exit Function
        End If
    Next element
    Exit Function
error_handling:
    On Error GoTo 0
    array_value_in_array = False

End Function

Function array_convert_rng_to_array(arr As Variant)
'function to convert ranges to arrays

    Dim temp As Variant
    'if already an array exit function returning same array
    If IsArray(arr) Then
        array_convert_rng_to_array = arr
        Exit Function
    End If

    'convert range input into array
    If arr.Columns.Count = 1 And arr.Rows.Count = 1 Then
        temp = arr.Value2
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = temp
        array_convert_rng_to_array = arr
    Else
        array_convert_rng_to_array = arr.Value2
    End If

End Function

Public Function array_replace_errors(arr As Variant) As Variant
'Function to replace all array values that are errors with 'Empty'/check if a value is in an array of values

    arr = array_convert_rng_to_array(arr)

    Dim row_count As Long
    Dim col_count As Long

    'loop through all elements in array and replace any errors with 'Empty'/vbNullString
    For row_count = LBound(arr, 1) To UBound(arr, 1)
        For col_count = LBound(arr, 2) To UBound(arr, 2)
            If IsError(arr(row_count, col_count)) Then arr(row_count, col_count) = vbNullString
        Next col_count
    Next row_count

    'return results
    array_replace_errors = arr

End Function

Function CombineArrays(a As Variant, b As Variant, Optional stacked As Boolean = True) As Variant
'assumes that A and B are 2-dimensional variant arrays
'if stacked is true then A is placed on top of B
'in this case the number of rows must be the same,
'otherwise they are placed side by side A|B
'in which case the number of columns are the same
'LBound can be anything but is assumed to be
'the same for A and B (in both dimensions)
'False is returned if a clash

    Dim lb As Long, m_A As Long, n_A As Long
    Dim m_B As Long, n_B As Long
    Dim m As Long, n As Long
    Dim i As Long, j As Long, k As Long
    Dim c As Variant

    If TypeName(a) = "Range" Then a = a.Value
    If TypeName(b) = "Range" Then b = b.Value

    lb = LBound(a, 1)
    m_A = UBound(a, 1)
    n_A = UBound(a, 2)
    m_B = UBound(b, 1)
    n_B = UBound(b, 2)

    If stacked Then
        m = m_A + m_B + 1 - lb
        n = n_A
        If n_B <> n Then
            CombineArrays = False
            Exit Function
        End If
    Else
        m = m_A
        If m_B <> m Then
            CombineArrays = False
            Exit Function
        End If
        n = n_A + n_B + 1 - lb
    End If
    ReDim c(lb To m, lb To n)
    For i = lb To m
        For j = lb To n
            If stacked Then
                If i <= m_A Then
                    c(i, j) = a(i, j)
                Else
                    c(i, j) = b(lb + i - m_A - 1, j)
                End If
            Else
                If j <= n_A Then
                    c(i, j) = a(i, j)
                Else
                    c(i, j) = b(i, lb + j - n_A - 1)
                End If
            End If
        Next j
    Next i
    CombineArrays = c
End Function

https://engineervsheep.com

 

[IDS]

Another Excel spreadsheet to find intersection points of straight lines can be downloaded from:

https://newtonexcelbach.com/2018/12/27/more-updates-to-arcspline-and-ip2/

To use either of these for the problem in the original post the coordinates need to be defined for all of the lines to be intersected, and the formula generating the "rectangular" shape involves very high powers that are likely to cause numerical problems with most equation solvers.

Because in this case the rectangle is vertical, if the x value of the vertical legs can be found it is a simple matter of substituting that into the equation for the sloping line.

By trial and error (and looking at the results in the link) I found that for the given a, b and r values the vertical legs of the rectangle are at x = +-900 and the intersection points are therefore at y = +-241.1542732

Excel goalseek also (eventually) came up with a result close to x=900 for the vertical lines.

I'm wondering if the example is a practical problem, or just one taken from the link? For most problems involving intersections of curvilinear equations there are automated numerical solutions that will work better than they do for this case.



Doug Jenkins
Interactive Design Services

http://newtonexcelbach.wordpress.com/

 

[Agent666]

Because in this case the rectangle is vertical, if the x value of the vertical legs can be found it is a simple matter of substituting that into the equation for the sloping line.

Unless the sloping line misses one or both vertical parts of the rectangle and that is important?
Then you'll get a result by substituting the X value, but it will be incorrect assuming Olivia86 is after the exact intersections. Like you I don't know if this is simply a pure geometry problem, or a way of solving another separate problem by utilising the geometry. Your suggestion may be appropriate within the bound of the problem the OP is trying to solve, but you need to be aware of the potential to report an incorrect result if intersections with the horizontal part of the rectangle are important tot the solution?

https://engineervsheep.com

 

[IDS]

Unless the sloping line misses one or both vertical parts of the rectangle and that is important?

Sure, but if you have the coordinates of the four corners it's easy to check for that, and if you don't you can't use our intersection spreadsheets either.

Doug Jenkins
Interactive Design Services

http://newtonexcelbach.wordpress.com/

 

[Olivia86]

Hi everyone, there is a lot of material here. Thanks for your effort.

Actually, I'm just using X= 900 and X=900, finding the intersection of y=mx and x=y/m, then I'm setting the boundary to exit the various loop. But I'm still in developing, it's just conceptual.