Sorting Gantt Bars (vb .net) - simplified [duplicate] - vb.net

Question

This question already has answers here:
Sorting conundrum (try at your peril) <VB .NET>
(3 answers)
Closed 8 months ago.
Ok, i can see this question is problematic, so I've attempted to explain it in a simplified way, with more code. I suppose this boils down to list reordering and/or reallocation.
I've inserted some of the code from the app to hopefully help.
As mentioned, any time-range overlaps within the same posIndex needs to have an increment of 1 added to its PosIndex. In addition, an increase to all others below it must move by 1 also. As the code iterates through and finds another overlap that has the same PosIndex (not from one above), it again moves it by one, and all others below it. Those on the same index that are not overlapping must have their PosINdex untouched. Only by overlaps above it should their PosIndex increase by 1, pushing them down.
I hope this explanation helps. I'm really, really stuck with this.
I've left the old post below, if it helps.
Module ttest
Public Class barAllocations
Dim lstBars As List(Of barAllocations)
Public Property barText As String
Public Property FromTime() As DateTime
Public Property ToTime() As DateTime
Public Property PosIndex() As Integer
Public Sub addAlloBar(ByVal setBarText As String, ByVal FromTime As DateTime, ToTime As DateTime, PosIndex As Integer)
Dim alloBar As New barAllocations
alloBar.barText = setBarText
alloBar.FromTime = FromTime
alloBar.ToTime = ToTime
alloBar.PosIndex = PosIndex
lstBars.Add(alloBar)
End Sub
Public Sub sortList()
Dim prevIndex As Integer
Dim prevFromDT As DateTime
Dim prevToDT As DateTime
For Each bar As barAllocations In lstBars
If bar.ToTime > prevFromDT And bar.FromTime < prevToDT And bar.PosIndex = prevIndex Then
bar.PosIndex += 1
For Each bars As barAllocations In lstBars
If bar.PosIndex > prevIndex Then bars.PosIndex += 1
Next
End If
prevFromDT = bar.FromTime
prevToDT = bar.ToTime
prevIndex = bar.PosIndex
Next
End Sub
End Class
Private Sub barAdd()
Dim startDT As DateTime = Now().AddHours(-48)
Dim endDT As DateTime = startDT.AddHours(12)
Dim allogrid As New barAllocations
allogrid.addAlloBar("test1", startDT, endDT, 0)
allogrid.addAlloBar("test2", startDT, endDT, 0)
allogrid.addAlloBar("test3", startDT.AddHours(12), endDT.AddHours(12), 0)
allogrid.addAlloBar("test4", startDT.AddHours(24), endDT.AddHours(24), 0)
allogrid.addAlloBar("test5", startDT.AddHours(5), endDT.AddHours(5), 5)
allogrid.addAlloBar("test6", startDT.AddHours(2), endDT.AddHours(2), 5)
allogrid.addAlloBar("test7", startDT.AddHours(1), endDT.AddHours(1), 6)
allogrid.addAlloBar("test8", startDT.AddHours(5), endDT.AddHours(5), 6)
allogrid.addAlloBar("test9", startDT.AddHours(7), endDT.AddHours(7), 7)
allogrid.addAlloBar("test10", startDT.AddHours(8), endDT.AddHours(8), 7)
allogrid.addAlloBar("test11", startDT.AddHours(10), endDT.AddHours(10), 8)
allogrid.addAlloBar("test12", startDT.AddHours(1), endDT.AddHours(1), 8)
allogrid.addAlloBar("test13", startDT.AddHours(22), endDT.AddHours(34), 8)
allogrid.addAlloBar("test14", startDT.AddHours(20), endDT.AddHours(32), 8)
allogrid.addAlloBar("test15", startDT.AddHours(6), endDT.AddHours(6), 9)
allogrid.addAlloBar("test16", startDT.AddHours(11), endDT.AddHours(11), 9)
allogrid.sortList()
End Sub
End Module
////////////////OLD POST/////////////////
I am in the middle of creating a booking app, using a Gantt view to visualize bookings. I draw rectangles where the bookings are to take place based on a date range.
The problem I am having is sorting overlaps. There can be two bookings for the same bed at the same time. What I am trying to do is if there is an overlap, move the bar down one space, but also move all other bars by one space also (the grid and bed row lines will be adjusted at a later point, widening them, to incorporate 2 bars at once).
The bars are placed by assigning a PosIndex, so row 1 is PosIndex 0.
I've been really struggling with this for several days now to no avail.
I thought about using rectangles for intersection detection, which works well, but I'm not able to sort the bars properly. As you can see from the picture, there are overlaps that have not been separated and I have no clue how to do it.
Sorry if my explanation is vague, so please ask for more info if required.
Here's the code i've been working on:
Dim lst As List(Of barAllocation) = lstBars
Dim prevIndex As Integer
Dim prevRec As Rectangle
Dim msg As String = ""
lst = lst.OrderBy(Function(x) x.PosIndex).ThenBy(Function(y) y.FromTime).ToList
For Each bar In lst
Dim tsDate As TimeSpan = bar.ToTime - bar.FromTime
Dim recstart As Integer = bar.ToTime.Month & bar.ToTime.Day & bar.ToTime.Hour & bar.ToTime.Minute
Dim barRec As New Rectangle(recstart, bar.PosIndex * 10, tsDate.TotalMinutes, 10)
If prevRec.IntersectsWith(barRec) Then
If prevIndex = bar.PosIndex Then
If bar.PosIndex = 0 Then
bar.PosIndex += 1
barChanged = bar.PosIndex
Else
barChanged = bar.PosIndex
bar.PosIndex += 1
End If
End If
End If
If bar.PosIndex > barChanged Then bar.PosIndex += 1
prevRec = barRec
prevIndex = bar.PosIndex
Example of App

Answer 1

Here is a working solution for you. The principle is clear, you just need to port it to winforms and render it differently if you need to there.
Public Class _Default
Inherits System.Web.UI.Page
Private Class Booking
Public Property BookingUID As Guid
Public Property Bedroom As String
Public Property BookingName As String
Public Property DateFrom As Date
Public Property DateTo As Date
Public Property HasClash As Boolean = False
Public Sub New(Bedroom As String, BookingName As String, DateFrom As Date, DateTo As Date)
BookingUID = Guid.NewGuid
Me.Bedroom = Bedroom
Me.BookingName = BookingName
Me.DateFrom = DateFrom
Me.DateTo = DateTo
End Sub
End Class
Private Bookings As List(Of Booking) = New List(Of Booking)
Private Sub SortBookings()
' Simple sort
Bookings = (From x In Bookings Select x Order By x.DateFrom, x.DateTo).ToList
' Check for clashes (will force booking onto a new line in the chart
For Each Booking In Bookings
If (From x In Bookings Where x.DateFrom < Booking.DateTo And x.DateTo > Booking.DateFrom And x.Bedroom = Booking.Bedroom And x.BookingUID <> Booking.BookingUID).Any Then
Booking.HasClash = True
End If
Next
End Sub
Private Sub RenderBookings()
Dim s As New StringBuilder
Dim TotalDays As Integer = 0
' get a unique list of bedrooms
Dim Beds = (From x In Bookings Select x.Bedroom Distinct).OrderBy(Function(b) b)
Dim MinDate = (From x In Bookings Select x.DateFrom).Min
Dim MaxDate = (From x In Bookings Select x.DateTo).Max
s.AppendLine("<table style=""border:solid 1px black;"" cellpadding=""2"" cellspacing=""0"" border=""1"">")
' header rows
s.AppendLine("<tr><td rowspan=""2"">Bedroom</td>")
Dim Day, Hour As Integer
For Day = 0 To DateDiff(DateInterval.Day, MinDate, MaxDate) + 1
s.AppendLine("<td colspan=""24"" style=""text-align:center;"">" & MinDate.Date.AddDays(Day).ToString("dd/MM/yyyy") & "</td>")
TotalDays += 1
Next
s.AppendLine("</tr><tr>")
For Day = 0 To DateDiff(DateInterval.Day, MinDate, MaxDate) + 1
For Hour = 0 To 23
s.AppendLine("<td style=""text-align:center;"">" & Hour.ToString.PadLeft(2, "0") & "</td>")
Next
Next
s.AppendLine("</tr>")
' Loop bedrooms
For Each Bed In Beds
s.AppendLine("<tr style=""height:30px;""><td>" & Bed & "</td><td style=""position:relative;"" colspan=""" & TotalDays * 24 & """>")
Dim BedBookings = (From x In Bookings Where x.Bedroom = Bed Select x Order By x.DateFrom)
Dim InsertRows As String = ""
Dim First As Boolean = True
' Loop bookings for each bedroom
For Each Booking In BedBookings
' divide 100 % by the time period in minutes we're trying to cover
Dim Scale As Decimal = (100 / (TotalDays * 24 * 60)) ' 100% / total minutes in the row
' How many whole days are there between this booking and our MinDate.Date?
Dim OffsetDays As Integer = Math.Floor((Booking.DateFrom.Date - MinDate.Date).TotalDays)
' Calculate the left %
Dim Left As Decimal = ((OffsetDays * 24 * 60) + (Booking.DateFrom - Booking.DateFrom.Date).TotalMinutes) * Scale
' Calculate the witdht %
Dim Width As Decimal = (Booking.DateTo - Booking.DateFrom).TotalMinutes * Scale
' Get our Bar HTML
Dim Bar As String = "<div style=""overflow:hidden;position:absolute;border:solid 1px red;background-color:navy;color:#fff;top:3px;width:" & Width & "%;left:" & Left & "%"" title=""" & Booking.DateFrom.ToString("dd/MM/yyyy HH:mm") & " - " & Booking.DateTo.ToString("dd/MM/yyyy HH:mm") & " - " & Booking.Bedroom & """>" & Booking.BookingName & "</div>"
If Booking.HasClash And Not First Then
' We need an insert row here because it's a clash for the same room
InsertRows &= "<tr style=""height:30px;""><td></td><td style=""position:relative;"" colspan=""" & TotalDays * 24 & """>"
InsertRows &= Bar
InsertRows &= "</tr>"
Else
' Add to this row
s.AppendLine(Bar)
End If
First = False
Next
s.AppendLine("</td></tr>{INSERTROWS}")
' Insert our clashing rows
s = s.Replace("{INSERTROWS}", InsertRows)
Next
s.AppendLine("</table>")
lit_Bars.Text = s.ToString
End Sub
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
' CREATE SOME FAKE BOOKINGS
Bookings.Add(New Booking("Bedroom 01", "Mr Jones", Date.Today.AddHours(9), Date.Today.AddHours(15)))
Bookings.Add(New Booking("Bedroom 02", "Mr & Mrs Williams", Date.Today.AddHours(8), Date.Today.AddHours(20)))
Bookings.Add(New Booking("Bedroom 03", "Mrs Ave", Date.Today.AddHours(10), Date.Today.AddHours(17)))
Bookings.Add(New Booking("Bedroom 04", "Mr Aubury", Date.Today.AddHours(12), Date.Today.AddHours(22)))
Bookings.Add(New Booking("Bedroom 05", "Mr King", Date.Today.AddHours(14), Date.Today.AddHours(20)))
' Clashes here
Bookings.Add(New Booking("Bedroom 06", "Miss Uber", Date.Today.AddHours(7), Date.Today.AddHours(13)))
Bookings.Add(New Booking("Bedroom 06", "Dr Jones", Date.Today.AddHours(6), Date.Today.AddHours(10)))
Bookings.Add(New Booking("Bedroom 06", "Mr Davis", Date.Today.AddHours(9), Date.Today.AddHours(30)))
Bookings.Add(New Booking("Bedroom 07", "Miss Davies", Date.Today.AddHours(8), Date.Today.AddHours(12)))
Bookings.Add(New Booking("Bedroom 08", "Mrs Amber", Date.Today.AddHours(6), Date.Today.AddHours(14)))
' Clashes here
Bookings.Add(New Booking("Bedroom 09", "Mr & Mrs Red", Date.Today.AddHours(10), Date.Today.AddHours(17)))
Bookings.Add(New Booking("Bedroom 09", "Mr Green", Date.Today.AddHours(2), Date.Today.AddHours(16)))
Bookings.Add(New Booking("Bedroom 09", "Mrs Brown", Date.Today.AddHours(7), Date.Today.AddHours(40)))
Bookings.Add(New Booking("Bedroom 10", "Mr Orange", Date.Today.AddHours(14), Date.Today.AddHours(19)))
Bookings.Add(New Booking("Bedroom 10", "Miss Pink", Date.Today.AddHours(26), Date.Today.AddHours(40)))
Bookings.Add(New Booking("Bedroom 11", "Miss Nathan", Date.Today.AddHours(13), Date.Today.AddHours(28)))
Bookings.Add(New Booking("Bedroom 12", "Mr Black", Date.Today.AddHours(7), Date.Today.AddHours(18)))
SortBookings()
RenderBookings()
End Sub
End Class

Answer 2

Well, i come up with a sort of solution, but it just seems very unnecessary coding. It doesn't deal with more than 2 entries on the same index at all, but i shouldn't need anymore than 2 assigned to each index
if anyone has any better ideas, love to here it.
For Each bar In lst
If prevFromDT < bar.ToTime And prevToDT > bar.FromTime And prevIndex = bar.PosIndex Then
bar.overLap = True
End If
next
For Each tsk In lst
If tsk.overLap Then
For Each tsk1 In lst
If tsk1.PosIndex > tsk.PosIndex Then tsk1.PosIndex += 1
Next
End If
Next
For Each tsk In lst
If tsk.overLap Then
tsk.PosIndex += 1
End If
Next