区間の包含関係 - abwiki @ ウィキ (ActiveBasic非公式wiki)

/***********************************************************
contain.c -- 区間の包含関係
***********************************************************/
#N88BASIC

Type interval
left As Long
right As Long
End Type

'
Sub bsort(base As *interval, num As DWord, size As DWord, f As VoidPtr)
Dim compare As *Function(a As *interval, b As *interval) As Long
compare = f

Dim i As Integer, j As Integer, k As Integer
Dim x As interval
k = num - 1
While k >= 0
j = -1 '番兵のセット
For i = 1 To k + 1
'隣通しの比較と交換
If cmp(VarPtr(base[i - 1]), VarPtr(base[i])) = 1 Then
j = i - 1
x = a[j]
a[j] = a[i]
a[i] = x
End If
Next i
k = j
Wend

End Sub

Function cmp(x As *interval, y As *interval) As Long
if x->left > y->left Then cmp = 1 : Exit Function
if x->left < y->left Then cmp = -1 : Exit Function
if x->right > y->right Then cmp = 1 : Exit Function
if x->right < y->right Then cmp = -1 : Exit Function
cmp = 0
End Function



Sub mark(n As Long, a As *interval, contained As *Long)
Dim i As Long, maxright As Long

bsort(a, n, SizeOf(interval), AddressOf(cmp))
maxright = a[0].right
contained[0] = FALSE

For i=1 To n-1
if a[i].right <= maxright then
contained[i] = TRUE
Else
maxright = a[i].right
contained[i] = FALSE
End If
Next
End Sub

Const N = 20


Dim a[N] As interval
Dim contained[N] As Long

main()

Sub main()
Dim i As Long, x As Long, y As Long

i = 0
While (i < N)
x = rand() / (RAND_MAX / 100 + 1)
y = rand() / (RAND_MAX / 100 + 1)
if x < y Then
a[i].left = x : a[i].right = y : i++
End If
Wend

mark(N, a, contained)
For i=1 To N-1

Print "(";a[i].left;",";a[i].right;")";
If contained[i] = TRUE Then
Print "*"
Else
Print " "
End If
Next
End Sub