From 246e2be97d1f26a4c98aa62fe67c5107062adb7d Mon Sep 17 00:00:00 2001 From: raghav7iitbbs Date: Wed, 15 Jan 2025 16:48:34 +0530 Subject: [PATCH] Implemented functionality to ensure unique routes from otp with frequency property in journey legs --- .../MultiModal/Interface/OpenTripPlanner.hs | 7 +- .../External/MultiModal/Interface/Types.hs | 21 ++- .../src/Kernel/External/MultiModal/Utils.hs | 168 ++++++++++++++++-- 3 files changed, 175 insertions(+), 21 deletions(-) diff --git a/lib/mobility-core/src/Kernel/External/MultiModal/Interface/OpenTripPlanner.hs b/lib/mobility-core/src/Kernel/External/MultiModal/Interface/OpenTripPlanner.hs index 2911fd5e2..106ee0253 100644 --- a/lib/mobility-core/src/Kernel/External/MultiModal/Interface/OpenTripPlanner.hs +++ b/lib/mobility-core/src/Kernel/External/MultiModal/Interface/OpenTripPlanner.hs @@ -42,7 +42,10 @@ getTransitRoutes cfg req = do let dateTime = req.departureTime <&> formatUtcDateTime let planClient = fromString (showBaseUrl cfg.baseUrl) let transportModes' = req.transportModes - let numItineraries' = Just 7 + let numItineraries' = Just 25 + let minimumWalkDistance = req.minimumWalkDistance + let permissibleModes = req.permissibleModes + let maxAllowedPublicTransportLegs = req.maxAllowedPublicTransportLegs resp <- liftIO $ planClient @@ -58,4 +61,4 @@ getTransitRoutes cfg req = do case resp of Left _ -> pure Nothing Right plan' -> - pure $ Just $ convertOTPToGeneric plan' + pure $ Just $ convertOTPToGeneric plan' minimumWalkDistance permissibleModes maxAllowedPublicTransportLegs diff --git a/lib/mobility-core/src/Kernel/External/MultiModal/Interface/Types.hs b/lib/mobility-core/src/Kernel/External/MultiModal/Interface/Types.hs index 9888bb1fb..01e0c6a95 100644 --- a/lib/mobility-core/src/Kernel/External/MultiModal/Interface/Types.hs +++ b/lib/mobility-core/src/Kernel/External/MultiModal/Interface/Types.hs @@ -1,21 +1,26 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-orphans #-} module Kernel.External.MultiModal.Interface.Types where +import Data.Aeson import Data.OpenApi hiding (name) import Data.Time (UTCTime) import Deriving.Aeson import EulerHS.Prelude +import Kernel.Beam.Lib.UtilsTH (mkBeamInstancesForEnumAndList) import qualified Kernel.External.Maps.Google.Config as Google import qualified Kernel.External.Maps.Google.MapsClient.Types as GT import qualified Kernel.External.MultiModal.OpenTripPlanner.Config as OTP import qualified Kernel.External.MultiModal.OpenTripPlanner.Types as OTPTypes import qualified Kernel.Types.Distance as Distance import qualified Kernel.Types.Time as Time +import Kernel.Utils.TH (mkHttpInstancesForEnum) newtype MultiModalResponse = MultiModalResponse {routes :: [MultiModalRoute]} deriving (Show, Generic) @@ -41,13 +46,14 @@ data MultiModalAgency = MultiModalAgency { gtfsId :: Maybe Text, name :: Text } - deriving (Show, Generic, ToJSON, FromJSON, ToSchema) + deriving (Eq, Show, Generic, ToJSON, FromJSON, ToSchema) data MultiModalRouteDetails = MultiModalRouteDetails { gtfsId :: Maybe Text, longName :: Maybe Text, shortName :: Maybe Text, - color :: Maybe Text + color :: Maybe Text, + frequency :: Maybe Time.Seconds } deriving (Show, Generic, ToJSON, FromJSON, ToSchema) @@ -79,7 +85,11 @@ data GeneralVehicleType | Walk | Subway | Unspecified - deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema) + deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON, Read, ToSchema, ToParamSchema) + +$(mkHttpInstancesForEnum ''GeneralVehicleType) + +$(mkBeamInstancesForEnumAndList ''GeneralVehicleType) data GetTransitRoutesReq = GetTransitRoutesReq { origin :: GT.WayPointV2, @@ -88,6 +98,9 @@ data GetTransitRoutesReq = GetTransitRoutesReq departureTime :: Maybe UTCTime, mode :: Maybe GT.ModeV2, transitPreferences :: Maybe GT.TransitPreferencesV2, - transportModes :: Maybe [Maybe OTPTypes.TransportMode] + transportModes :: Maybe [Maybe OTPTypes.TransportMode], + minimumWalkDistance :: Distance.Meters, + permissibleModes :: [GeneralVehicleType], + maxAllowedPublicTransportLegs :: Int } deriving (Generic, ToJSON, FromJSON, Show, ToSchema) diff --git a/lib/mobility-core/src/Kernel/External/MultiModal/Utils.hs b/lib/mobility-core/src/Kernel/External/MultiModal/Utils.hs index f35e2f636..cda1988b9 100644 --- a/lib/mobility-core/src/Kernel/External/MultiModal/Utils.hs +++ b/lib/mobility-core/src/Kernel/External/MultiModal/Utils.hs @@ -7,8 +7,13 @@ module Kernel.External.MultiModal.Utils where import qualified Data.Char as Char +import qualified Data.HashMap.Strict as HM +import Data.List (nub, sort) +import qualified Data.Map as Map +import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as TE +import Data.Time.Clock import EulerHS.Prelude (safeHead) import Kernel.External.Maps.Google.MapsClient.Types as GT import Kernel.External.Maps.Google.PolyLinePoints (oneCoordEnc, stringToCoords) @@ -178,7 +183,7 @@ convertGoogleToGeneric gResponse = fromDepartureTime = fromDepartureTime', toArrivalTime = toArrivalTime', toDepartureTime = toDepartureTime', - routeDetails = Nothing + routeDetails = Nothing --[] } : genericLegs mergeWalkingLegs :: [MultiModalLeg] -> [MultiModalLeg] @@ -234,21 +239,89 @@ convertGoogleToGeneric gResponse = else leg2 in adjustedLeg1 : adjustWalkingLegs (adjustedLeg2 : rest) -convertOTPToGeneric :: OTP.OTPPlan -> MultiModalResponse -convertOTPToGeneric otpResponse = +convertOTPToGeneric :: OTP.OTPPlan -> Distance.Meters -> [GeneralVehicleType] -> Int -> MultiModalResponse +convertOTPToGeneric otpResponse minimumWalkDistance permissibleModes maxAllowedPublicTransportLegs = let itineraries = otpResponse.plan.itineraries - genericRoutes = foldr accumulateItineraries [] itineraries + (genericRoutes, frequencyMap) = foldr accumulateItineraries ([], HM.empty) itineraries + --mergedRoutes = map mergeConsecutiveMetroLegs genericRoutes + updatedRoutes = map (updateRouteFrequency frequencyMap) genericRoutes + filteredRoutes = map (removeShortWalkLegs minimumWalkDistance) updatedRoutes + filteredByPermissibleModes = filter (hasOnlyPermissibleModes permissibleModes) filteredRoutes + filteredByMaxPublicTransport = filter (withinMaxAllowedPublicTransportModes maxAllowedPublicTransportLegs) filteredByPermissibleModes + finalRoutes = uniqueRoutes filteredByMaxPublicTransport in MultiModalResponse - { routes = genericRoutes + { routes = finalRoutes } where - accumulateItineraries :: Maybe OTP.OTPPlanPlanItineraries -> [MultiModalRoute] -> [MultiModalRoute] - accumulateItineraries itinerary genericRoutes = + removeShortWalkLegs :: Distance.Meters -> MultiModalRoute -> MultiModalRoute + removeShortWalkLegs threshold route = + let filteredLegs = filter (\leg -> not (leg.mode == Walk && getLegDistance leg < thresholdValue)) route.legs + thresholdValue = fromIntegral $ Distance.getMeters threshold -- Convert threshold to Double for comparison + in route {legs = filteredLegs} + + getLegDistance :: MultiModalLeg -> Double + getLegDistance leg = fromRational $ leg.distance.value.getHighPrecDistance + + -- Filter routes to include only those with permissible modes + hasOnlyPermissibleModes :: [GeneralVehicleType] -> MultiModalRoute -> Bool + hasOnlyPermissibleModes permissibleModesInRoute route = + all (\leg -> leg.mode `elem` permissibleModesInRoute) route.legs + + -- Filter routes with at most a specified number of legs of Public Transport Type: [Bus, MetroRail] + withinMaxAllowedPublicTransportModes :: Int -> MultiModalRoute -> Bool + withinMaxAllowedPublicTransportModes maxAllowed route = + let publicTransportLegs = filter (\leg -> leg.mode `elem` [Bus, MetroRail, Subway]) route.legs + in length publicTransportLegs <= maxAllowed + + -- -- Merge consecutive MetroRail legs in a route + -- mergeConsecutiveMetroLegs :: MultiModalRoute -> MultiModalRoute + -- mergeConsecutiveMetroLegs route = + -- let mergedLegs = mergeMetroLegs route.legs + -- in route {legs = mergedLegs} + + -- -- Recursive function to merge consecutive MetroRail legs + -- mergeMetroLegs :: [MultiModalLeg] -> [MultiModalLeg] + -- mergeMetroLegs [] = [] + -- mergeMetroLegs [leg] = [leg] -- Single leg, no merging needed + -- mergeMetroLegs (leg1 : leg2 : rest) + -- | leg1.mode == MetroRail && leg2.mode == MetroRail && leg1.agency == leg2.agency = + -- let leg1Start = leg1.startLocation + -- leg2Start = leg2.startLocation + -- leg2End = leg2.endLocation + -- encodedPolylineText = encode [leg1Start.latLng, leg2Start.latLng, leg2End.latLng] + -- mergedLeg = + -- MultiModalLeg + -- { distance = + -- Distance.Distance + -- { value = + -- Distance.HighPrecDistance + -- { getHighPrecDistance = fromRational leg1.distance.value.getHighPrecDistance + fromRational leg2.distance.value.getHighPrecDistance + -- }, + -- unit = leg1.distance.unit + -- }, + -- duration = Time.Seconds $ leg1.duration.getSeconds + leg2.duration.getSeconds, + -- polyline = GT.Polyline {encodedPolyline = encodedPolylineText}, + -- mode = MetroRail, + -- startLocation = leg1.startLocation, + -- endLocation = leg2.endLocation, + -- fromStopDetails = leg1.fromStopDetails, + -- toStopDetails = leg2.toStopDetails, + -- routeDetails = leg1.routeDetails ++ leg2.routeDetails, + -- agency = leg1.agency, + -- fromArrivalTime = min <$> leg1.fromArrivalTime <*> leg2.fromArrivalTime, + -- fromDepartureTime = min <$> leg1.fromDepartureTime <*> leg2.fromDepartureTime, + -- toArrivalTime = max <$> leg1.toArrivalTime <*> leg2.toArrivalTime, + -- toDepartureTime = max <$> leg1.toDepartureTime <*> leg2.toDepartureTime + -- } + -- in mergeMetroLegs (mergedLeg : rest) -- Add merged leg and continue + -- | otherwise = leg1 : mergeMetroLegs (leg2 : rest) -- Keep leg1, process the rest + accumulateItineraries :: Maybe OTP.OTPPlanPlanItineraries -> ([MultiModalRoute], HM.HashMap T.Text [UTCTime]) -> ([MultiModalRoute], HM.HashMap T.Text [UTCTime]) + accumulateItineraries itinerary (genericRoutes, freqMap) = case itinerary of - Nothing -> genericRoutes + Nothing -> (genericRoutes, freqMap) Just itinerary' -> let duration = fromMaybe 0.0 itinerary'.duration - (legs, distance) = foldr accumulateLegs ([], 0.0) itinerary'.legs + (legs, distance, updatedFreqMap) = foldr accumulateLegs ([], 0.0, freqMap) itinerary'.legs route = MultiModalRoute { duration = Time.Seconds $ round duration, @@ -264,11 +337,12 @@ convertOTPToGeneric otpResponse = startTime = (millisecondsToUTC . round) <$> itinerary'.startTime, endTime = (millisecondsToUTC . round) <$> itinerary'.endTime } - in route : genericRoutes - accumulateLegs :: Maybe OTP.OTPPlanPlanItinerariesLegs -> ([MultiModalLeg], Double) -> ([MultiModalLeg], Double) - accumulateLegs otpLeg (genericLegs, genericDistance) = + in (route : genericRoutes, updatedFreqMap) + + accumulateLegs :: Maybe OTP.OTPPlanPlanItinerariesLegs -> ([MultiModalLeg], Double, HM.HashMap T.Text [UTCTime]) -> ([MultiModalLeg], Double, HM.HashMap T.Text [UTCTime]) + accumulateLegs otpLeg (genericLegs, genericDistance, updatedFreqMap) = case otpLeg of - Nothing -> (genericLegs, genericDistance) + Nothing -> (genericLegs, genericDistance, updatedFreqMap) Just otpLeg' -> let distance = fromMaybe 0.0 otpLeg'.distance duration = fromMaybe 0.0 otpLeg'.duration @@ -279,6 +353,7 @@ convertOTPToGeneric otpResponse = (startLat, startLng) = (otpLeg'.from.lat, otpLeg'.from.lon) (endLat, endLng) = (otpLeg'.to.lat, otpLeg'.to.lon) routeAgency = otpLeg'.route + maybeLongName = otpLeg'.route >>= \r -> r.longName fromArrivalTime' = Just $ millisecondsToUTC $ round otpLeg'.from.arrivalTime fromDepartureTime' = Just $ millisecondsToUTC $ round otpLeg'.from.departureTime toArrivalTime' = Just $ millisecondsToUTC $ round otpLeg'.to.arrivalTime @@ -290,7 +365,8 @@ convertOTPToGeneric otpResponse = { gtfsId = Just $ T.pack route.gtfsId, longName = fmap T.pack route.longName, shortName = fmap T.pack route.shortName, - color = fmap T.pack route.color + color = fmap T.pack route.color, + frequency = Nothing } Nothing -> Nothing (fromStopCode, fromStopGtfsId, fromStopPlatformCode) = case otpLeg'.from.stop of @@ -329,6 +405,14 @@ convertOTPToGeneric otpResponse = { gtfsId = (\x -> Just $ T.pack x.gtfsId) =<< ag.agency, name = maybe "" (\x -> T.pack x.name) ag.agency } + + -- Update the frequency map only if longName exists + newFreqMap = case (maybeLongName, fromArrivalTime') of + (Just longName, Just time) -> + let key = T.pack longName + in HM.insertWith (\new old -> nub (new ++ old)) key [time] updatedFreqMap + _ -> updatedFreqMap + leg = MultiModalLeg { distance = @@ -370,4 +454,58 @@ convertOTPToGeneric otpResponse = toArrivalTime = toArrivalTime', toDepartureTime = toDepartureTime' } - in (leg : genericLegs, genericDistance + distance) + in (leg : genericLegs, genericDistance + distance, newFreqMap) + + -- Update frequency of each leg in a route using the frequencyMap + updateRouteFrequency :: HM.HashMap T.Text [UTCTime] -> MultiModalRoute -> MultiModalRoute + updateRouteFrequency freqMap route = + let updatedLegs = map updateLegFrequency route.legs + in route {legs = updatedLegs} + where + updateLegFrequency :: MultiModalLeg -> MultiModalLeg + updateLegFrequency leg = + --let updatedRouteDetails = map (updateDetailsFrequency freqMap) (routeDetails leg) + let updatedRouteDetails = updateDetailsFrequency freqMap <$> leg.routeDetails + in leg {routeDetails = updatedRouteDetails} + + updateDetailsFrequency :: HM.HashMap T.Text [UTCTime] -> MultiModalRouteDetails -> MultiModalRouteDetails + updateDetailsFrequency frequencyMap details = + case longName details of + Just longName -> + let key = longName + timestamps = sort $ HM.lookupDefault [] key frequencyMap + frequency = case timestamps of + (t1 : t2 : _) -> Just $ Time.Seconds $ round $ diffUTCTime t2 t1 + _ -> Nothing + in details {frequency = frequency} + Nothing -> details + + -- Function to get the sequence combination for a route + getSequenceCombination :: MultiModalRoute -> T.Text + getSequenceCombination route = + let sequenceCombination = mapMaybe getLongNameFromLeg (route.legs) + in T.intercalate "-" sequenceCombination + where + getLongNameFromLeg :: MultiModalLeg -> Maybe T.Text + getLongNameFromLeg leg = + case routeDetails leg of + Just details -> longName details + Nothing -> Nothing + + -- Function to filter routes with unique sequence combinations + uniqueRoutes :: [MultiModalRoute] -> [MultiModalRoute] + uniqueRoutes routes = + let -- Create a map that tracks sequence combinations + seenCombinations = Map.empty + -- Filter routes based on unique sequence combinations + (newUniqueRoutes, _) = + foldl + ( \(accRoutes, seen) route -> + let seqComb = getSequenceCombination route + in if Map.member seqComb seen + then (accRoutes, seen) + else (accRoutes ++ [route], Map.insert seqComb () seen) + ) + ([], seenCombinations) + routes + in newUniqueRoutes