Home > Enterprise >  Sorting Gantt Bars (vb .net) - simplified
Sorting Gantt Bars (vb .net) - simplified

Time:06-22

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

Proof the code below works

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

CodePudding user response:

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
  • Related