RosettaCodeData/Task/Nonoblock/FreeBASIC/nonoblock.basic

92 lines
2.8 KiB
Plaintext

Function minsized(arr() As Integer) As String
Dim result As String = ""
For i As Integer = Lbound(arr) To Ubound(arr)
result &= String(arr(i), "#")
If i < Ubound(arr) Then result &= "."
Next
Return result
End Function
Function minlen(arr() As Integer) As Integer
Dim sum As Integer = 0
For i As Integer = Lbound(arr) To Ubound(arr)
sum += arr(i)
Next
Return sum + Ubound(arr)
End Function
Sub sequences(blockseq() As Integer, numblanks As Integer, result() As String)
Dim As Integer i, leftspace, rightspace, allbuthead()
Dim As String header
If Ubound(blockseq) = -1 Then
Redim result(0)
result(0) = String(numblanks, ".")
Elseif minlen(blockseq()) = numblanks Then
Redim result(0)
result(0) = minsized(blockseq())
Else
Redim allbuthead(Ubound(blockseq) - 1)
For i = 1 To Ubound(blockseq)
allbuthead(i - 1) = blockseq(i)
Next
For leftspace = 0 To (numblanks - minlen(blockseq()))
header = String(leftspace, ".") & String(blockseq(0), "#") & "."
rightspace = numblanks - Len(header)
If Ubound(allbuthead) = -1 Then
If rightspace <= 0 Then
Redim Preserve result(Ubound(result) + 1)
result(Ubound(result)) = Left(header, numblanks)
Else
Redim Preserve result(Ubound(result) + 1)
result(Ubound(result)) = header & String(rightspace, ".")
End If
Elseif minlen(allbuthead()) = rightspace Then
Redim Preserve result(Ubound(result) + 1)
result(Ubound(result)) = header & minsized(allbuthead())
Else
Dim As String subresult()
sequences(allbuthead(), rightspace, subresult())
For i= Lbound(subresult) To Ubound(subresult)
Redim Preserve result(Ubound(result) + 1)
result(Ubound(result)) = header & subresult(i)
Next
End If
Next
End If
End Sub
Sub nonoblocks(bvec() As Integer, longi As Integer)
Dim As Integer i
Dim As String seq()
Print !"\nWith blocks [ ";
For i = Lbound(bvec) To Ubound(bvec)
Print Chr(8); bvec(i); " ";
Next i
Print Chr(8); " ] and "; longi; " cells:"
If longi < minlen(bvec()) Then
Print "No solution"
Else
sequences(bvec(), longi, seq())
For i = Lbound(seq) To Ubound(seq)
Print seq(i)
Next
End If
End Sub
Dim bvec1(1) As Integer = {2, 1}
Dim bvec2() As Integer
Dim bvec3(0) As Integer = {8}
Dim bvec4(3) As Integer = {2, 3, 2, 3}
Dim bvec5(1) As Integer = {2, 3}
nonoblocks(bvec1(), 5)
nonoblocks(bvec2(), 5)
nonoblocks(bvec3(), 10)
nonoblocks(bvec4(), 15)
nonoblocks(bvec5(), 5)
Sleep