RosettaCodeData/Task/Functional-coverage-tree/FreeBASIC/functional-coverage-tree.basic

155 lines
5.0 KiB
Plaintext

Type FCNode
As String nombre
As Integer weight
As Double coverage
As FCNode Ptr children(Any)
As FCNode Ptr parent
Declare Constructor(nombre As String, weight As Integer, coverage As Double)
Declare Sub addChildren(nodes() As FCNode Ptr)
Declare Sub setCoverage(value As Double)
Declare Sub updateCoverage()
Declare Sub show(level As Integer)
End Type
Constructor FCNode(nombre As String, weight As Integer, coverage As Double)
this.nombre = nombre
this.weight = weight
this.coverage = coverage
this.parent = 0
End Constructor
Sub FCNode.addChildren(nodes() As FCNode Ptr)
For i As Integer = 0 To Ubound(nodes)
nodes(i)->parent = @This
Redim Preserve this.children(Ubound(this.children) + 1)
this.children(Ubound(this.children)) = nodes(i)
Next
this.updateCoverage()
End Sub
Sub FCNode.setCoverage(value As Double)
If this.coverage <> value Then
this.coverage = value
If this.parent <> 0 Then this.parent->updateCoverage()
End If
End Sub
Sub FCNode.updateCoverage()
Dim As Double v1 = 0
Dim As Integer v2 = 0
For i As Integer = 0 To Ubound(this.children)
v1 += this.children(i)->weight * this.children(i)->coverage
v2 += this.children(i)->weight
Next
If v2 <> 0 Then this.setCoverage(v1 / v2)
End Sub
Sub FCNode.show(level As Integer)
Dim As Integer indent, nl, i
indent = level * 4
nl = Len(this.nombre) + indent
Print Space(indent); this.nombre; Space(32 - nl); "|"; Using "#####"; this.weight;
Print Using " | #.###### |"; this.coverage
If Ubound(this.children) = -1 Then Return
For i = 0 To Ubound(this.children)
this.children(i)->show(level + 1)
Next
End Sub
Function newFCN(nombre As String, weight As Integer, coverage As Double) As FCNode Ptr
Return New FCNode(nombre, weight, coverage)
End Function
Dim houses(1) As FCNode Ptr
houses(0) = newFCN("house1", 40, 0)
houses(1) = newFCN("house2", 60, 0)
Dim house1(7) As FCNode Ptr
house1(0) = newFCN("bedrooms", 1, 0.25)
house1(1) = newFCN("bathrooms", 1, 0)
house1(2) = newFCN("attic", 1, 0.75)
house1(3) = newFCN("kitchen", 1, 0.1)
house1(4) = newFCN("living_rooms", 1, 0)
house1(5) = newFCN("basement", 1, 0)
house1(6) = newFCN("garage", 1, 0)
house1(7) = newFCN("garden", 1, 0.8)
Dim house2(2) As FCNode Ptr
house2(0) = newFCN("upstairs", 1, 0)
house2(1) = newFCN("groundfloor", 1, 0)
house2(2) = newFCN("basement", 1, 0)
Dim h1Bathrooms(2) As FCNode Ptr
h1Bathrooms(0) = newFCN("bathroom1", 1, 0.5)
h1Bathrooms(1) = newFCN("bathroom2", 1, 0)
h1Bathrooms(2) = newFCN("outside_lavatory", 1, 1)
Dim h1LivingRooms(3) As FCNode Ptr
h1LivingRooms(0) = newFCN("lounge", 1, 0)
h1LivingRooms(1) = newFCN("dining_room", 1, 0)
h1LivingRooms(2) = newFCN("conservatory", 1, 0)
h1LivingRooms(3) = newFCN("playroom", 1, 1)
Dim h2Upstairs(3) As FCNode Ptr
h2Upstairs(0) = newFCN("bedrooms", 1, 0)
h2Upstairs(1) = newFCN("bathroom", 1, 0)
h2Upstairs(2) = newFCN("toilet", 1, 0)
h2Upstairs(3) = newFCN("attics", 1, 0.6)
Dim h2Groundfloor(5) As FCNode Ptr
h2Groundfloor(0) = newFCN("kitchen", 1, 0)
h2Groundfloor(1) = newFCN("living_rooms", 1, 0)
h2Groundfloor(2) = newFCN("wet_room_&_toilet", 1, 0)
h2Groundfloor(3) = newFCN("garage", 1, 0)
h2Groundfloor(4) = newFCN("garden", 1, 0.9)
h2Groundfloor(5) = newFCN("hot_tub_suite", 1, 1)
Dim h2Basement(2) As FCNode Ptr
h2Basement(0) = newFCN("cellars", 1, 1)
h2Basement(1) = newFCN("wine_cellar", 1, 1)
h2Basement(2) = newFCN("cinema", 1, 0.75)
Dim h2UpstairsBedrooms(3) As FCNode Ptr
h2UpstairsBedrooms(0) = newFCN("suite_1", 1, 0)
h2UpstairsBedrooms(1) = newFCN("suite_2", 1, 0)
h2UpstairsBedrooms(2) = newFCN("bedroom_3", 1, 0)
h2UpstairsBedrooms(3) = newFCN("bedroom_4", 1, 0)
Dim h2GroundfloorLivingRooms(3) As FCNode Ptr
h2GroundfloorLivingRooms(0) = newFCN("lounge", 1, 0)
h2GroundfloorLivingRooms(1) = newFCN("dining_room", 1, 0)
h2GroundfloorLivingRooms(2) = newFCN("conservatory", 1, 0)
h2GroundfloorLivingRooms(3) = newFCN("playroom", 1, 0)
Dim cleaning As FCNode Ptr = newFCN("cleaning", 1, 0)
house1(1)->addChildren(h1Bathrooms())
house1(4)->addChildren(h1LivingRooms())
houses(0)->addChildren(house1())
h2Upstairs(0)->addChildren(h2UpstairsBedrooms())
house2(0)->addChildren(h2Upstairs())
h2Groundfloor(1)->addChildren(h2GroundfloorLivingRooms())
house2(1)->addChildren(h2Groundfloor())
house2(2)->addChildren(h2Basement())
houses(1)->addChildren(house2())
cleaning->addChildren(houses())
Dim As Double topCoverage = cleaning->coverage
Print "TOP COVERAGE = ";
Print Using "########.######"; topCoverage
Print
Print "NAME HIERARCHY | WEIGHT | COVERAGE |"
cleaning->show(0)
h2Basement(2)->setCoverage(1) ' change Cinema node coverage to 1
Dim As Double diff = cleaning->coverage - topCoverage
Print
Print "If the coverage of the Cinema node were increased from 0.75 to 1"
Print "the top level coverage would increase by ";
Print Using "##.###### to ##.######"; diff; (topCoverage + diff)
h2Basement(2)->setCoverage(0.75) ' restore to original value if required
Sleep