# ============================================================
# SIMPLE RIDE-HAILING APPLICATION (SWIFTRIDE)
# ============================================================
# ============================================================
# 1. USER DATABASE
# ============================================================
users <- data.frame(
phone = "09012345678",
email = "yourfather@gmail.com",
password = "LazyheadedAkin",
stringsAsFactors = FALSE
)
# ============================================================
# 2. TRIP HISTORY DATABASE
# ============================================================
trip_history <- data.frame(
phone = character(),
pickup = character(),
destination = character(),
distance_km = numeric(),
fare = numeric(),
driver = character(),
driver_id = character(),
status = character(),
stringsAsFactors = FALSE
)
# ============================================================
# 3. DRIVER DATABASE
# ============================================================
drivers <- data.frame(
driver_id = c(
"DRV001",
"DRV002",
"DRV003",
"DRV004",
"DRV005"
),
driver_name = c(
"Driver 1",
"Driver 2",
"Driver 3",
"Driver 4",
"Driver 5"
),
available = c(
TRUE,
TRUE,
TRUE,
TRUE,
TRUE
),
# TRUE = accepts
# FALSE = rejects
accept = c(
FALSE,
TRUE,
TRUE,
TRUE,
TRUE
),
stringsAsFactors = FALSE
)
# ============================================================
# 4. ROUTE DATABASE
# ============================================================
routes <- data.frame(
start = c(
"Fajuyi",
"Fajuyi",
"Adebayo",
"Adebayo",
"Ajilosun",
"Ajilosun",
"Bodija",
"Bodija"
),
end = c(
"Adebayo",
"Ajilosun",
"Fajuyi",
"Ajilosun",
"Fajuyi",
"Adebayo",
"Fajuyi",
"Adebayo"
),
km = c(
2.5,
3.2,
2.5,
1.8,
3.2,
1.8,
4.5,
3.0
),
stringsAsFactors = FALSE
)
# ============================================================
# 5. DISTANCE FUNCTION
# ============================================================
AutoKM <- function(
start_location,
end_location,
manual_km = NULL
) {
# Search normal direction
result <- routes[
routes$start == start_location &
routes$end == end_location,
]
if (nrow(result) > 0) {
return(result$km[1])
}
# Search reverse direction
reverse_result <- routes[
routes$start == end_location &
routes$end == start_location,
]
if (nrow(reverse_result) > 0) {
return(reverse_result$km[1])
}
# If route is unknown
if (!is.null(manual_km)) {
if (!is.numeric(manual_km) ||
manual_km <= 0) {
stop(
"Manual distance must be greater than zero."
)
}
return(manual_km)
}
return(NA)
}
# ============================================================
# 6. FARE FUNCTION
# ============================================================
CalculateFare <- function(
distance_km,
base_fare = 300,
price_per_km = 120,
minimum_fare = 500
) {
fare <- base_fare +
(distance_km * price_per_km)
fare <- max(
fare,
minimum_fare
)
return(
round(fare, 2)
)
}
# ============================================================
# 7. SIGN UP FUNCTION
# ============================================================
SignUp <- function() {
cat("\n")
cat("====================================\n")
cat(" SIGN UP\n")
cat("====================================\n")
phone <- readline(
"Enter your phone number: "
)
email <- readline(
"Enter your email: "
)
password <- readline(
"Create a password: "
)
# ----------------------------------------------------------
# CHECK FOR EMPTY FIELDS
# ----------------------------------------------------------
if (
phone == "" ||
email == "" ||
password == ""
) {
cat(
"\nAll fields are required.\n"
)
return(FALSE)
}
# ----------------------------------------------------------
# CHECK GMAIL FORMAT
# ----------------------------------------------------------
if (
!grepl(
"^[A-Za-z0-9._%+-]+@gmail\\.com$",
email
)
) {
cat(
"\nInvalid Gmail. Please enter a Gmail address ending exactly with @gmail.com.\n"
)
return(FALSE)
}
# ----------------------------------------------------------
# CHECK PASSWORD LENGTH
# Password must be between 4 and 8 characters
# ----------------------------------------------------------
if (
nchar(password) < 4 ||
nchar(password) > 8
) {
cat(
"\nPassword must be between 4 and 8 characters.\n"
)
return(FALSE)
}
# ----------------------------------------------------------
# CHECK FOR LETTER
# Password must contain at least one letter
# ----------------------------------------------------------
if (
!grepl(
"[A-Za-z]",
password
)
) {
cat(
"\nPassword must contain at least one letter.\n"
)
return(FALSE)
}
# ----------------------------------------------------------
# CHECK FOR NUMBER
# Password must contain at least one number
# ----------------------------------------------------------
if (
!grepl(
"[0-9]",
password
)
) {
cat(
"\nPassword must contain at least one number.\n"
)
return(FALSE)
}
# ----------------------------------------------------------
# CHECK FOR SPECIAL CHARACTER
# Password must contain at least one special character
# ----------------------------------------------------------
if (
!grepl(
"[^A-Za-z0-9]",
password
)
) {
cat(
"\nPassword must contain at least one special character.\n"
)
return(FALSE)
}
# ----------------------------------------------------------
# CHECK IF PHONE ALREADY EXISTS
# ----------------------------------------------------------
if (
phone %in% users$phone
) {
cat(
"\nThis phone number is already registered.\n"
)
return(FALSE)
}
# ----------------------------------------------------------
# ADD NEW USER
# ----------------------------------------------------------
new_user <- data.frame(
phone = phone,
email = email,
password = password,
stringsAsFactors = FALSE
)
users <<- rbind(
users,
new_user
)
cat(
"\nAccount created successfully!\n"
)
return(TRUE)
}
# ============================================================
# 8. LOGIN FUNCTION
# ============================================================
Login <- function() {
cat("\n")
cat("====================================\n")
cat(" LOGIN\n")
cat("====================================\n")
phone <- readline(
"Enter your phone number: "
)
password <- readline(
"Enter your password: "
)
# Check if user exists
user_found <- users[
users$phone == phone,
]
if (
nrow(user_found) == 0
) {
cat(
"\nAccount not found.\n"
)
return(NULL)
}
# Check password
if (
user_found$password[1] == password
) {
cat(
"\nLogin successful!\n"
)
return(phone)
} else {
cat(
"\nIncorrect password.\n"
)
return(NULL)
}
}
# ============================================================
# 9. FIND DRIVER FUNCTION
# ============================================================
# ANY AVAILABLE DRIVER CAN BE CHOSEN AT RANDOM
# DRIVER 1 IS NOT ALWAYS FIRST
# ============================================================
FindDriver <- function() {
# Get all currently available drivers
available_drivers <- drivers[
drivers$available == TRUE,
]
# Check if any driver is available
if (
nrow(available_drivers) == 0
) {
cat(
"\nNo drivers are currently available.\n"
)
return(NULL)
}
cat("\n")
cat(
"Searching for an available driver...\n"
)
# ----------------------------------------------------------
# RANDOMIZE DRIVER ORDER
# ----------------------------------------------------------
# Randomly arrange the available drivers
random_order <- sample(
1:nrow(available_drivers)
)
available_drivers <- available_drivers[
random_order,
,
drop = FALSE
]
# ----------------------------------------------------------
# SEND RIDE REQUEST TO RANDOM DRIVERS
# ----------------------------------------------------------
for (
i in 1:nrow(available_drivers)
) {
current_driver <-
available_drivers[i, ]
cat("\n")
cat(
"Sending request to ",
current_driver$driver_name,
"...\n",
sep = ""
)
# --------------------------------------------------------
# DRIVER RESPONSE
# --------------------------------------------------------
if (
current_driver$accept == TRUE
) {
cat(
current_driver$driver_name,
" accepted the ride.\n"
)
return(current_driver)
} else {
cat(
current_driver$driver_name,
" rejected the ride.\n"
)
cat(
"Searching for another driver...\n"
)
}
}
# ----------------------------------------------------------
# NO DRIVER ACCEPTED
# ----------------------------------------------------------
cat(
"\nNo driver accepted the ride.\n"
)
return(NULL)
}
# ============================================================
# 10. REQUEST RIDE FUNCTION
# ============================================================
RequestRide <- function(
logged_in_phone
) {
cat("\n")
cat("====================================\n")
cat(" REQUEST A RIDE\n")
cat("====================================\n")
# ----------------------------------------------------------
# PICKUP
# ----------------------------------------------------------
pickup <- readline(
"Enter pickup location: "
)
# ----------------------------------------------------------
# DESTINATION
# ----------------------------------------------------------
destination <- readline(
"Enter destination: "
)
# ----------------------------------------------------------
# CHECK LOCATIONS
# ----------------------------------------------------------
if (
pickup == "" ||
destination == ""
) {
cat(
"\nPickup and destination are required.\n"
)
return()
}
# ----------------------------------------------------------
# DISTANCE
# ----------------------------------------------------------
cat(
"\nCalculating distance...\n"
)
distance <- AutoKM(
pickup,
destination
)
# ----------------------------------------------------------
# IF ROUTE IS NOT FOUND
# ----------------------------------------------------------
if (
is.na(distance)
) {
cat(
"\nThis route is not currently in the system.\n"
)
answer <- readline(
"Do you know the distance in km? (yes/no): "
)
if (
tolower(answer) == "yes"
) {
manual_input <- readline(
"Enter distance in km: "
)
manual_km <- as.numeric(
manual_input
)
if (
is.na(manual_km) ||
manual_km <= 0
) {
cat(
"\nInvalid distance.\n"
)
return()
}
distance <- manual_km
} else {
cat(
"\nRide request cancelled.\n"
)
return()
}
}
cat(
"Distance:",
distance,
"km\n"
)
# ----------------------------------------------------------
# FARE
# ----------------------------------------------------------
fare <- CalculateFare(
distance
)
cat(
"Estimated fare: ₦",
format(
fare,
big.mark = ","
),
"\n",
sep = ""
)
# ----------------------------------------------------------
# CONFIRM RIDE
# ----------------------------------------------------------
cat("\n")
confirm <- readline(
"Do you want to confirm this ride? (yes/no): "
)
if (
tolower(confirm) != "yes"
) {
cat(
"\nRide request cancelled.\n"
)
return()
}
cat(
"\nRide request confirmed!\n"
)
# ----------------------------------------------------------
# FIND DRIVER
# ----------------------------------------------------------
driver <- FindDriver()
if (
is.null(driver)
) {
cat(
"\nRide could not be matched with a driver.\n"
)
return()
}
# ----------------------------------------------------------
# TRIP
# ----------------------------------------------------------
cat("\n")
cat("====================================\n")
cat(" TRIP\n")
cat("====================================\n")
cat(
"Driver:",
driver$driver_name,
"\n"
)
cat(
"Pickup:",
pickup,
"\n"
)
cat(
"Destination:",
destination,
"\n"
)
cat(
"Distance:",
distance,
"km\n"
)
cat(
"Fare: ₦",
format(
fare,
big.mark = ","
),
"\n",
sep = ""
)
cat(
"\nTrip started...\n"
)
readline(
"Press ENTER when trip is completed..."
)
cat(
"\nTrip completed successfully!\n"
)
# ----------------------------------------------------------
# SAVE TRIP
# ----------------------------------------------------------
new_trip <- data.frame(
phone = logged_in_phone,
pickup = pickup,
destination = destination,
distance_km = distance,
fare = fare,
driver = driver$driver_name,
status = "Completed",
stringsAsFactors = FALSE
)
trip_history <<- rbind(
trip_history,
new_trip
)
cat(
"\nFare recorded successfully.\n"
)
}
# ============================================================
# 11. VIEW TRIP HISTORY
# ============================================================
ViewTrips <- function(
logged_in_phone
) {
cat("\n")
cat("====================================\n")
cat(" TRIP HISTORY\n")
cat("====================================\n")
history <- trip_history[
trip_history$phone ==
logged_in_phone,
]
if (
nrow(history) == 0
) {
cat(
"You have no previous trips.\n"
)
return()
}
print(
history[
,
c(
"pickup",
"destination",
"distance_km",
"fare",
"driver",
"status"
)
]
)
}
# ============================================================
# 12. HOME MENU
# ============================================================
HomeMenu <- function(
logged_in_phone
) {
while (TRUE) {
cat("\n")
cat("====================================\n")
cat(" HOME\n")
cat("====================================\n")
cat("1. Request a Ride\n")
cat("2. View Trip History\n")
cat("3. Logout\n")
choice <- readline(
"Choose an option: "
)
# --------------------------------------------------------
# REQUEST RIDE
# --------------------------------------------------------
if (
choice == "1"
) {
RequestRide(
logged_in_phone
)
# --------------------------------------------------------
# TRIP HISTORY
# --------------------------------------------------------
} else if (
choice == "2"
) {
ViewTrips(
logged_in_phone
)
# --------------------------------------------------------
# LOGOUT
# --------------------------------------------------------
} else if (
choice == "3"
) {
cat(
"\nYou have been logged out.\n"
)
break
} else {
cat(
"\nInvalid option. Please try again.\n"
)
}
}
}
# ============================================================
# 13. MAIN APPLICATION
# ============================================================
RideApp <- function() {
cat("\n")
cat("============================================\n")
cat(" WELCOME TO SWIFTRIDE \n")
cat("============================================\n")
while (TRUE) {
cat("\n")
cat("1. Sign Up\n")
cat("2. Login\n")
cat("3. Exit\n")
choice <- readline(
"Choose an option: "
)
# --------------------------------------------------------
# SIGN UP
# --------------------------------------------------------
if (
choice == "1"
) {
SignUp()
# --------------------------------------------------------
# LOGIN
# --------------------------------------------------------
} else if (
choice == "2"
) {
logged_in_phone <- Login()
if (
!is.null(logged_in_phone)
) {
HomeMenu(
logged_in_phone
)
}
# --------------------------------------------------------
# EXIT
# --------------------------------------------------------
} else if (
choice == "3"
) {
cat("\n")
cat(
"Thank you for using swiftride.\n"
)
break
} else {
cat(
"\nInvalid option.\n"
)
}
}
}
# ============================================================
# START THE APPLICATION
# ============================================================
# Run the application only when using R interactively.
# This prevents R Markdown from getting stuck during knitting.
if (
interactive()
) {
RideApp()
}