vb.net – Sorting conundrum (try at your peril)

Here you go… The RenderBookings() code is irrelevant – it’s just to show that the sorted data is correct and matches what it should look like. SortBookings() is what you need to look at.

Visual proof (for comparison)

ASPX code…

<%@ Page Language="vb" AutoEventWireup="false" CodeBehind="BookingSorting.aspx.vb" Inherits="Scrap.BookingSorting" %>
<!DOCTYPE html>
<html xmlns="http://www.w3.org/1999/xhtml">
<head runat="server">
    <title></title>
</head>
<body>
    <form id="form1" runat="server">
        <div>
            <h3>Before</h3>
            <asp:GridView ID="gv_Before" runat="server" ></asp:GridView>
            <h3>After</h3>
            <asp:GridView ID="gv_After" runat="server" ></asp:GridView>
            <h3>Proof</h3>
            <asp:Literal ID="lit_Bars" runat="server" />
        </div>
    </form>
</body>
</html>

VB.NET Code

Public Class BookingSorting
    Inherits System.Web.UI.Page

    Private Class Booking
        Public Property BookingUID As Guid
        Public Property Bedroom As String ' AlloIndex
        Public Property PosIndex As Integer
        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
        ' Somewhere to write the list as we sort it
        Dim SortedBookings As List(Of Booking) = New List(Of Booking)

        ' get a unique list of bedrooms
        Dim Beds = (From x In Bookings Select x.Bedroom Distinct).OrderBy(Function(b) b)

        ' Loop bedrooms
        For Each Bed In Beds
            Dim BedBookings = (From x In Bookings Where x.Bedroom = Bed Select x Order By x.DateFrom)
            Dim InsertBookings As New List(Of Booking)
            Dim First As Boolean = True
            ' Loop bookings for each bedroom
            For Each Booking In BedBookings
                If Booking.HasClash And Not First Then
                    Booking.PosIndex = InsertBookings.Count + 1
                    InsertBookings.Add(Booking)
                Else
                    ' Add to this row
                    Booking.PosIndex = 0
                    SortedBookings.Add(Booking)
                End If
                First = False
            Next
            SortedBookings.AddRange(InsertBookings)
        Next
        Bookings = SortedBookings
    End Sub

    Private Sub Test()
        ' 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)))
        gv_Before.DataSource = Bookings
        gv_Before.DataBind()
        SortBookings()
        gv_After.DataSource = Bookings
        gv_After.DataBind()
        RenderBookings()
    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)
            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 width %
                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

    Private Sub BookingSorting_Load(sender As Object, e As EventArgs) Handles Me.Load
        Test()
    End Sub

End Class

Leave a Comment