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..1bad5d531 100644 --- a/lib/mobility-core/src/Kernel/External/MultiModal/Interface/OpenTripPlanner.hs +++ b/lib/mobility-core/src/Kernel/External/MultiModal/Interface/OpenTripPlanner.hs @@ -43,6 +43,7 @@ getTransitRoutes cfg req = do let planClient = fromString (showBaseUrl cfg.baseUrl) let transportModes' = req.transportModes let numItineraries' = Just 7 + let minimumWalkDistance = req.minimumWalkDistance resp <- liftIO $ planClient @@ -58,4 +59,4 @@ getTransitRoutes cfg req = do case resp of Left _ -> pure Nothing Right plan' -> - pure $ Just $ convertOTPToGeneric plan' + pure $ Just $ convertOTPToGeneric plan' minimumWalkDistance 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 85cf13b21..535e27b2c 100644 --- a/lib/mobility-core/src/Kernel/External/MultiModal/Interface/Types.hs +++ b/lib/mobility-core/src/Kernel/External/MultiModal/Interface/Types.hs @@ -47,7 +47,8 @@ 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) @@ -60,13 +61,12 @@ data MultiModalLeg = MultiModalLeg endLocation :: GT.LocationV2, fromStopDetails :: Maybe MultiModalStopDetails, toStopDetails :: Maybe MultiModalStopDetails, - routeDetails :: [MultiModalRouteDetails], + routeDetails :: Maybe MultiModalRouteDetails, agency :: Maybe MultiModalAgency, fromArrivalTime :: Maybe UTCTime, fromDepartureTime :: Maybe UTCTime, toArrivalTime :: Maybe UTCTime, - toDepartureTime :: Maybe UTCTime, - frequency :: Maybe Time.Seconds + toDepartureTime :: Maybe UTCTime } deriving (Show, Generic, ToJSON, FromJSON, ToSchema) @@ -89,6 +89,7 @@ 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 } 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 1225619da..c653f26bf 100644 --- a/lib/mobility-core/src/Kernel/External/MultiModal/Utils.hs +++ b/lib/mobility-core/src/Kernel/External/MultiModal/Utils.hs @@ -8,7 +8,7 @@ where import qualified Data.Char as Char import qualified Data.HashMap.Strict as HM -import Data.List (sort) +import Data.List (nub, sort) import qualified Data.Map as Map import Data.Maybe import qualified Data.Text as T @@ -183,8 +183,7 @@ convertGoogleToGeneric gResponse = fromDepartureTime = fromDepartureTime', toArrivalTime = toArrivalTime', toDepartureTime = toDepartureTime', - routeDetails = [], - frequency = Nothing + routeDetails = Nothing --[] } : genericLegs mergeWalkingLegs :: [MultiModalLeg] -> [MultiModalLeg] @@ -224,8 +223,7 @@ convertGoogleToGeneric gResponse = fromDepartureTime = leg1.fromDepartureTime, toArrivalTime = leg2.toArrivalTime, toDepartureTime = leg2.toDepartureTime, - routeDetails = leg1.routeDetails, - frequency = Nothing + routeDetails = leg1.routeDetails } adjustWalkingLegs :: [MultiModalLeg] -> [MultiModalLeg] adjustWalkingLegs [] = [] @@ -241,60 +239,69 @@ convertGoogleToGeneric gResponse = else leg2 in adjustedLeg1 : adjustWalkingLegs (adjustedLeg2 : rest) -convertOTPToGeneric :: OTP.OTPPlan -> MultiModalResponse -convertOTPToGeneric otpResponse = +convertOTPToGeneric :: OTP.OTPPlan -> Distance.Meters -> MultiModalResponse +convertOTPToGeneric otpResponse minimumWalkDistance = let itineraries = otpResponse.plan.itineraries (genericRoutes, frequencyMap) = foldr accumulateItineraries ([], HM.empty) itineraries - mergedRoutes = map mergeConsecutiveMetroLegs genericRoutes - updatedRoutes = map (updateRouteFrequency frequencyMap) mergedRoutes - finalRoutes = uniqueRoutes updatedRoutes + --mergedRoutes = map mergeConsecutiveMetroLegs genericRoutes + updatedRoutes = map (updateRouteFrequency frequencyMap) genericRoutes + filteredRoutes = map (removeShortWalkLegs minimumWalkDistance) updatedRoutes + finalRoutes = uniqueRoutes filteredRoutes in MultiModalResponse { routes = finalRoutes } where - -- Merge consecutive MetroRail legs in a route - mergeConsecutiveMetroLegs :: MultiModalRoute -> MultiModalRoute - mergeConsecutiveMetroLegs route = - let mergedLegs = mergeMetroLegs route.legs - in route {legs = mergedLegs} + 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} - -- 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, - frequency = max <$> leg1.frequency <*> leg2.frequency - } - in mergeMetroLegs (mergedLeg : rest) -- Add merged leg and continue - | otherwise = leg1 : mergeMetroLegs (leg2 : rest) -- Keep leg1, process the rest + getLegDistance :: MultiModalLeg -> Double + getLegDistance leg = fromRational $ leg.distance.value.getHighPrecDistance + + -- -- 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 @@ -340,11 +347,13 @@ convertOTPToGeneric otpResponse = toDepartureTime' = Just $ millisecondsToUTC $ round otpLeg'.to.departureTime routeDetails = case otpLeg'.route of Just route -> - [ MultiModalRouteDetails + Just + MultiModalRouteDetails { 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 @@ -388,7 +397,7 @@ convertOTPToGeneric otpResponse = newFreqMap = case (maybeLongName, fromArrivalTime') of (Just longName, Just time) -> let key = T.pack longName - in HM.insertWith (++) key [time] updatedFreqMap + in HM.insertWith (\new old -> nub (new ++ old)) key [time] updatedFreqMap _ -> updatedFreqMap leg = @@ -430,35 +439,45 @@ convertOTPToGeneric otpResponse = fromArrivalTime = fromArrivalTime', fromDepartureTime = fromDepartureTime', toArrivalTime = toArrivalTime', - toDepartureTime = toDepartureTime', - frequency = Nothing + toDepartureTime = toDepartureTime' } 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 freqMap) route.legs + 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} - -- Update frequency for a single leg - updateLegFrequency :: HM.HashMap T.Text [UTCTime] -> MultiModalLeg -> MultiModalLeg - updateLegFrequency freqMap leg = - case listToMaybe $ mapMaybe longName (routeDetails leg) of --case routeDetails leg >>= longName of - Just longNameText -> - let key = longNameText - timestamps = sort $ HM.lookupDefault [] key freqMap - frequency = case timestamps of - (t1 : t2 : _) -> Just $ Time.Seconds $ round $ diffUTCTime t2 t1 - _ -> Nothing - in leg {frequency = frequency} - Nothing -> leg + 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 (listToMaybe . mapMaybe longName . routeDetails) (route.legs) + 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]