financial forecasting Mobile Massage Business
Janis Harris
2026-01-10
This is part 3 to mobile massage business analysis of data after removing the seven duplicates in the consent forms of those who had previous consent forms and it was skewing the data for real results. Lets see how the real results are now with this data. The other file had 533 observations but should have had 488. Those 7 duplicates were doubled every time each one received a massage they would have an additional 1-2 more entries for how many consent forms they had that were added on when merging by full name. New file without duplicates is here.
This R project is a project to see how a mobile massage business data that has been anonymized can turn into less a side hussle and more an actual small business. The data starts with personal identifiers removed to protect private client data, but keep the financial aspect from income and the permissions and consents approved from multiple different consent forms and locals of Corona CA during schedule changes that impacted the business like diminishing availability as progressing through school while working and motivation to work at building clientele and losing clients as well as having to rebuild clients while working part time and advertising on a few sites like Spa Finder, and free business lisings on Yelp and Google.
The business started with its first client in May 2019 prepandemic closures and saw an uptick in services for mobile massage following safety protocols during the pandemic and slightly afterwards for those who spent time and money getting mommy makeover plastic surgery and liposuction and needing lymphatic massages regularly. The school began with prerequisite courses in the summer of 2021 to start September 2021 through September 2024. The consent form was changed some times and lengthy. Most questions were on health and permission or consents to have them recommend business and most were optional other than their removed personal information and consent. Some didn’t upload to the database retrieval and storage online site due to client printing out form and only selecting which options they wanted. There were only a handful of those clients as most went through answering the multiple questions that could take a while to read the 26 item terms of service and sign. Those had to be input manually and some were also not in the database because they were dropped due to putting a different name and manually had to extract the data from their client folder within the clients folder of clients. That process of cleaning and preparing data took hours to do as combining by full name on consent form and income form from personal excel table didn’t match and some dropped, hence manually finding those items using the which() within dataframe to find the matches and not matched and shrink that data of not matched down to zero. However, when combining the 488 transactions for service May 2019 through Jan 2026, some folks have multiple consent forms from gaps in massage treatment and filling out again or erroring in the initial input and those were dropped and one with most information kept unless the consent form had a huge time gap of years or months between each one for same client. But something in this data is still duplicating many more observations at 533 instead of 488 when only a couple of people filled out multiple consent forms with a gap. And some folks used the page on site for consent form but selected a different consent form than the top page ‘new client’ form and scrolled down to the health and/or wellness forms that had different questions. The older form was from 2019-2021 and some intersection between old and new on data selected and answered. Jotform data form company used and lowest cost one for this small business allows 5 forms, so altered and new forms were at times archived and then put back into service. All information to run forecasts and time series analysis on making profits and some filled in optional consents for type of modalities as in types of massage modality like Swedish, acupressure, sports, prenatal, and so on preferred, or massage tools as in are elbows ok, pressure from light to super deep, bundled packages like savings where these were also only offered before and while massage wasn’t too busy. There was a buy 10 lymphatic drainage massages for $45 each but pay upfront $450 and get the credits for each massage, There was the family massage that the price changed structure from $35-50 per family member in 4 hours of massage, some special discounts later off the regular price that started at $60 but around 2023-2024 prices increased to $80/hour and 90 minutes from $80 to $120 per hour. All that information is in the self explanatory feature of the data. Tipping was optional as well but only because prices set and other than expenses kept. Discounts stopped once it was clear that folks mostly bought the mobile massage service for birthdays and special occasions or the packages for bundled options and some referred clients. The return is kept for each client and if they didn’t return yet, no is put in the return feature for that client on last visit. The dates of service, application for consent to massage submission, and date since last massage as well as days and years since last massage. There is a feature for whether like to massage client again and only 3 have a no because they are either too stressful in not allowing parking, flaking, making me feel unsafe or uncomfortable, or giving wrong address. That is there so that if making email mailers, phone calls, text messaging, or mailed in promotional offers that they don’t get put on the list of people to contact. There will be multiple receipts on later transactions with same receipt number because each person is counted and has a consent form and received service at that household at that appointment. You will see amounts paid and remaining features that relate to the income and splits how payment made and the remaining balance might have some errors in it. There are only negative payments when someone bought a package but couldn’t finish it and needed more availability so refunded them the balance if my unavailable schedule was reason why, but tacked on discount to each used service then refunded balance if it was due to client’s unavailability to complete the package as planned. Gratuities were tracked and if you see nothing in the feature it is because there was none given, some folk don’t like to add gratuity and mostly the package deals on lymphatic massage are the folk who didn’t tip and also since prices went up and cost was very low that bundled package was discontinued around the time that chiropractic school started. If you have any questions on the data, the feature column tries to explain as best it can, and many were summarized and shortened, some input manually to answer the optional feature that represents that consent form question more like a survey, and others will have the same input as these were selected as input, some were input text boxes the client could respond with own input. The consent forms are necessary to weed out and exclude creeps, weirdo, criminals, and other sort as crazy folk don’t typically spend 20 minutes of their time and a small non-refundable deposit of 25 USD per hour or 40 USD per 90 minutes plus additional cost on driving outside the 30 minutes to service address and back which increased from 10 USD each way using mapquest or google maps to 20 USD per half hour outside given 30 minutes. When company first started service provider was willing to drive an hour away and back but traffic really upset and influenced choice to not drive beyond the given 30 minutes without monetary compensation as prices low and adding on additonal drive money also validates they keep their appointment as not refunded. There aren’t that many clients but most are quality clients and idea clients for this respectable mobile massage business that is a female owned and operated sole proprietorship and not an Limited Liability Company.
Injury has kept the mobile massage provider from working and getting paid by day job so she must try to increase her income by contacting former clients and offering wellness plans and bundled package discounts to her previous contacts and maybe to encourage them visiting her social media sites to write a good comment to attract more business. Expenses weren’t added because those are tallied up from insurance, licensing, liablility and auto insurance, goDaddy website costs, personalized business website name cost annually, jotform and dropbox hosting online, software like microsoft monthly subscription, Amazon subscription for free delivery of tools replaced or new investments, website name annual cost, cell phone utilities, laundry soap, dryer sheets, fuel, car wear and tear if needed that year, lease cost per year if used, business costs, replacing worn supplies like linens and top cover or massage table, lotion, oil, aromatherapy, additional service tools like hot stone kits, towel warmers, new tools like lipocavitation machine, massage hyperpercussion tool, instrument assisted soft tissue mobilization tools and kits, cupping supplies, physiotherapy tools like resistance bands, foam roller, yoga mat, etc. and so on.
Get file (here)[https://docs.google.com/spreadsheets/d/1KeMR8UpPeQ_iHEhmLB50oRHEEgosgUTf50SM45O0geI/edit?usp=sharing].
library(prophet)## Loading required package: Rcpp## Loading required package: rlanglibrary(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)Data <- read.csv("anonymizedIncomeConsentMergeNoDuplicates488Not533.csv", sep=',', header=T, na.strings=c('',' ','na','NA'))
str(Data)## 'data.frame': 488 obs. of 73 variables:
## $ SalesReceiptNumber : int 100 101 102 103 104 105 106 107 108 109 ...
## $ dateOfService : chr "5/20/2019" "5/22/2019" "5/24/2019" "5/27/2019" ...
## $ StartTime : chr "4:00 PM" "1:00 PM" "9:00 AM" "4:30 PM" ...
## $ EndTime : chr "8:00 PM" "3:00 PM" "10:30 AM" "6:00 PM" ...
## $ newReturn : chr "new" "new" "new" "new" ...
## $ returned : chr "yes" "yes" "yes" "no" ...
## $ referred : chr "no" "no" "no" "no" ...
## $ DateLastServiceReturned : chr NA NA NA NA ...
## $ daysPassedBetweenServices : int 0 0 0 0 5 30 0 0 0 28 ...
## $ weeksPassedBetweenServices : int 0 0 0 0 1 4 0 0 0 4 ...
## $ todaysDate : chr "1/8/2026" "1/8/2026" "1/8/2026" "1/8/2026" ...
## $ daysSinceTodayAndDateOfThisService : int 2425 2423 2421 2418 2416 2395 2388 2381 2380 2367 ...
## $ weeksSinceTodayAndDateOfThisService : int 346 346 346 345 345 342 341 340 340 338 ...
## $ likeToSeeAgain : chr "yes" "no" "yes" "yes" ...
## $ City : chr "Fontana" "Chino Hills" "Corona" "Corona" ...
## $ ZipCode : int 92335 91709 92882 92879 92882 92335 91709 92880 92882 92335 ...
## $ MassagePackage : chr "Family Massage Special" "1 1/2 Hour Customized Massage-Pretal" "1 1/2 Hour Customized Massage-Deep Tissue" "1 1/2 Hour Customized Massage-Head Aches" ...
## $ ServiceCost : chr "145.00" "80.00" "80.00" "80.00" ...
## $ driveTimeBeyond30minBothWays : int NA NA NA NA NA NA NA NA NA NA ...
## $ Discount : num NA NA 12 12 16 15 8.25 10 NA 10 ...
## $ TypeOfDiscount : chr NA NA "15% stress ruins life" "15% furbabies Mama and Papa" ...
## $ AmountPaid_NotCreditUsed : num 145 80 68 68 64 ...
## $ CreditPaid_monthlyOrPkg : int NA NA NA NA NA NA NA NA NA NA ...
## $ AmountPaid_As_Income : num 185 120 102 90 100 ...
## $ clientRemainingCreditBalance : int NA NA NA NA NA NA NA NA NA NA ...
## $ Gratuity : num 40 40 22 10 20 ...
## $ FSA_HSA : num 95 NA NA NA NA 130 NA NA NA 135 ...
## $ SpaFinderGiftCard : int 50 NA 50 NA 40 NA NA 64 NA NA ...
## $ otherGiftCard : int NA NA NA 80 NA NA NA NA NA NA ...
## $ creditCard : num NA NA NA NA NA NA 83 NA 63 NA ...
## $ cash : int 40 120 18 10 44 40 NA NA NA 40 ...
## $ zelle : num NA NA NA NA NA NA NA NA NA NA ...
## $ check : num NA NA NA NA NA NA NA NA NA NA ...
## $ TypePayment : chr "95 FSA, 50 SpaFinder, Cash tip" "Cash" "50 SpaFinder, 18 cash, cash tip" "Target Visa credit gift card, 10 cash" ...
## $ Submission.Date : chr "5/19/2019" "5/22/2019" "5/23/2019" "5/27/2019" ...
## $ consentForm_formType : chr "oldForm" "oldForm" "oldForm" "oldForm" ...
## $ manualInputMissingInDataBaseSourceOrPrinted : chr "no" "no" "no" "no" ...
## $ receivedMassageFromMe : chr "Yes" "Yes" "Yes" "Yes" ...
## $ Birth.Date : chr "10/13/1986" "6/1/1979" "12/14/1983" "9/20/1990" ...
## $ ageAtSubmission : int 32 39 35 28 35 32 26 22 57 32 ...
## $ termsAgreedTo : chr "Yes" "Yes" "Yes" "Yes" ...
## $ termsSignature : chr "on consent form different terms in file" "on consent form different terms in file" "on consent form different terms in file" "on consent form different terms in file" ...
## $ dateAgreedSigned : chr "5/19/2019" "5/22/2019" "5/23/2019" "5/27/2019" ...
## $ femaleOrMaleTherapistPreference : chr NA NA NA NA ...
## $ lotionOrOilPreference : chr NA NA NA NA ...
## $ describeWhyMobileMassagePreferred : chr NA NA NA NA ...
## $ painScale1least_10worst : int 2 9 8 5 8 2 4 3 NA 2 ...
## $ healthConditionsPrecautions : chr NA "Sciatica" NA "Migraines\nBruise easily" ...
## $ sleep1poor_10BestEver : int 7 10 7 3 7 7 10 4 5 7 ...
## $ stress1none_10extremely : int 3 5 4 4 4 3 3 4 3 3 ...
## $ Pressure : chr "Light\nmedium" "deep tissue" "deep tissue" "medium" ...
## $ massageModalitiesPreferred : chr "Swedish (speed and pressure of application vary and don't have to be fixed, such as deep tissue with strong app"| __truncated__ "Accupressure (deep tissue massage with thumbs or elbows along long muscles of body and the deeper muscle layers"| __truncated__ "Swedish (speed and pressure of application vary and don't have to be fixed, such as deep tissue with strong app"| __truncated__ "Swedish (speed and pressure of application vary and don't have to be fixed, such as deep tissue with strong app"| __truncated__ ...
## $ areasToAvoid : chr NA NA NA NA ...
## $ massageStyleToolsPreferred : chr "thumbs (common)\nforearms (for deeper medium pressure, but not deep pressure unless the sides of body like the "| __truncated__ "feet (for accupressure of large muscle areas like upper back, thighs, hamstrings, and hips)" "thumbs (common)\nknuckles (also common if MT has long nails)\nfists ( for gathering tissue layers and rolling o"| __truncated__ "thumbs (common)\npalms of hands (for firm, light, and medium pressure)\nelbows (for deeper pressure)\nforearms "| __truncated__ ...
## $ massageGoals : chr "relaxed state of mind" "increased range of motion" "relaxed state of mind\nless to no pain in areas of my body that ache\nless inflammation from stress" "relaxed state of mind\nless to no pain in areas of my body that ache\nless inflammation from stress" ...
## $ additonalServices : chr NA NA NA NA ...
## $ howHeardAboutCompany : chr "Internet" "Internet" "Internet" "Internet" ...
## $ willingToRecommendCompany : chr "Maybe" "Yes" NA "Yes" ...
## $ OKtoContactEmailTextPhone : chr NA NA NA NA ...
## $ BioPsychoSocialModelOfPain_massageExpectations : chr NA NA NA NA ...
## $ lastMassageWhen : chr NA NA NA NA ...
## $ lastMassageComplaints : chr NA NA NA NA ...
## $ lastMassageReceivedWhere : chr NA NA NA NA ...
## $ minorNameIfParentPresentWholeTimeForMinorMassage : logi NA NA NA NA NA NA ...
## $ whyChildMassageAndHasChildEverHadMassageBefore : logi NA NA NA NA NA NA ...
## $ minorDOBifForMinor : chr NA NA NA NA ...
## $ massagePraisesWhatYouLikeAboutMassageBenefitsYou : chr NA NA NA NA ...
## $ talkingDuringMassageOK_isYes_or_Not_isNo : chr NA NA NA NA ...
## $ pressureHealthPrecautionsDescribedNowWhatPressurePreferred: chr NA NA NA NA ...
## $ genderPreferredWarningPrecautionOnMalesFemalesRespect : chr NA NA NA NA ...
## $ whySelectThisMassageCompany : chr NA NA NA NA ...
## $ yourGender : chr NA NA NA NA ...
## $ bundledMassagePackageSavingsInterestedIn : chr NA NA NA NA ...Change Date into Date columns.
dates <- grep('date',colnames(Data))
Dates <- grep('Date',colnames(Data))
DateColumns <- colnames(Data)[c(dates,Dates)]
DateColumns## [1] "dateOfService" "dateAgreedSigned"
## [3] "DateLastServiceReturned" "todaysDate"
## [5] "daysSinceTodayAndDateOfThisService" "weeksSinceTodayAndDateOfThisService"
## [7] "Submission.Date" "Birth.Date"DateColumnsToChange <- DateColumns[-c(5,6)]
DateColumnsToChange## [1] "dateOfService" "dateAgreedSigned"
## [3] "DateLastServiceReturned" "todaysDate"
## [5] "Submission.Date" "Birth.Date"Data$dateOfService[1:10]## [1] "5/20/2019" "5/22/2019" "5/24/2019" "5/27/2019" "5/29/2019" "6/19/2019"
## [7] "6/26/2019" "7/3/2019" "7/4/2019" "7/17/2019"Change 4 digit year into 2 digit year to use date features in as.Date function.
Data$dateOfService <- format(as.Date(Data$dateOfService, "%m/%d/%Y"),"%m/%d/%y")
Data$dateOfService[1:10]## [1] "05/20/19" "05/22/19" "05/24/19" "05/27/19" "05/29/19" "06/19/19"
## [7] "06/26/19" "07/03/19" "07/04/19" "07/17/19"Good that it was able to convert the 4 digit year into 2 digits.
Data$dateOfService <- as.Date(Data$dateOfService, "%m/%d/%y")
str(Data$dateOfService)## Date[1:488], format: "2019-05-20" "2019-05-22" "2019-05-24" "2019-05-27" "2019-05-29" ...The years are correct as another try with just above code before converting to 2 digit year gave all the same year.
summary(Data$dateOfService)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## "2019-05-20" "2021-02-26" "2021-08-07" "2022-04-24" "2023-01-07" "2026-01-07"summary(Data[,c(DateColumnsToChange)])## dateOfService dateAgreedSigned DateLastServiceReturned
## Min. :2019-05-20 Length:488 Length:488
## 1st Qu.:2021-02-26 Class :character Class :character
## Median :2021-08-07 Mode :character Mode :character
## Mean :2022-04-24
## 3rd Qu.:2023-01-07
## Max. :2026-01-07
## todaysDate Submission.Date Birth.Date
## Length:488 Length:488 Length:488
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
## Seems like it worked so we will do the same to the other date columns
to change them from character to date objects. “dateAgreedSigned”
[3] “DateLastServiceReturned” “todaysDate”
[5] “consentFormSubmissionDate” “Birth.Date”
Data$dateAgreedSigned <- as.Date(format(as.Date(Data$dateAgreedSigned, "%m/%d/%Y"), "%m/%d/%y"), "%m/%d/%y")
str(Data$dateAgreedSigned)## Date[1:488], format: "2019-05-19" "2019-05-22" "2019-05-23" "2019-05-27" "2019-05-23" ...summary(Data$dateAgreedSigned)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## "2019-05-19" "2020-11-22" "2020-12-08" "2021-12-08" "2022-02-14" "2025-12-29"
## NA's
## "2"error1 <- Data[is.na(Data$dateAgreedSigned),]
error1## SalesReceiptNumber dateOfService StartTime EndTime newReturn returned
## 24 123 2020-07-30 6:00 PM 7:00 PM new yes
## 28 126 2020-08-23 11:00 AM 12:00 PM return no
## referred DateLastServiceReturned daysPassedBetweenServices
## 24 <NA> <NA> 0
## 28 <NA> 7/30/2020 24
## weeksPassedBetweenServices todaysDate daysSinceTodayAndDateOfThisService
## 24 0 1/8/2026 1988
## 28 3 1/8/2026 1964
## weeksSinceTodayAndDateOfThisService likeToSeeAgain City ZipCode
## 24 284 yes Corona 92882
## 28 281 yes Corona 92882
## MassagePackage ServiceCost driveTimeBeyond30minBothWays
## 24 One Hour Persolized Massage 60.00 NA
## 28 One Hour Persolized Massage 60.00 NA
## Discount TypeOfDiscount AmountPaid_NotCreditUsed CreditPaid_monthlyOrPkg
## 24 NA <NA> 100 NA
## 28 NA <NA> 100 NA
## AmountPaid_As_Income clientRemainingCreditBalance Gratuity FSA_HSA
## 24 100 NA 40 NA
## 28 100 NA 40 NA
## SpaFinderGiftCard otherGiftCard creditCard cash zelle check
## 24 NA NA NA 100 NA NA
## 28 NA NA NA 100 NA NA
## TypePayment Submission.Date consentForm_formType
## 24 cash 7/30/2020 handwritten printed old form
## 28 cash, paid by husband Anthony 7/30/2020 handwritten printed old form
## manualInputMissingInDataBaseSourceOrPrinted receivedMassageFromMe Birth.Date
## 24 yes Yes 7/30/1991
## 28 yes Yes 7/30/1991
## ageAtSubmission termsAgreedTo
## 24 29 Yes
## 28 29 Yes
## termsSignature dateAgreedSigned
## 24 sneaky printed out but avoided checking and signing box <NA>
## 28 sneaky printed out but avoided checking and signing box <NA>
## femaleOrMaleTherapistPreference lotionOrOilPreference
## 24 <NA> <NA>
## 28 <NA> <NA>
## describeWhyMobileMassagePreferred painScale1least_10worst
## 24 <NA> NA
## 28 <NA> NA
## healthConditionsPrecautions sleep1poor_10BestEver stress1none_10extremely
## 24 <NA> NA NA
## 28 <NA> NA NA
## Pressure massageModalitiesPreferred areasToAvoid massageStyleToolsPreferred
## 24 medium <NA> <NA> <NA>
## 28 medium <NA> <NA> <NA>
## massageGoals additonalServices howHeardAboutCompany
## 24 <NA> <NA> <NA>
## 28 <NA> <NA> <NA>
## willingToRecommendCompany OKtoContactEmailTextPhone
## 24 <NA> <NA>
## 28 <NA> <NA>
## BioPsychoSocialModelOfPain_massageExpectations lastMassageWhen
## 24 <NA> <NA>
## 28 <NA> <NA>
## lastMassageComplaints lastMassageReceivedWhere
## 24 <NA> <NA>
## 28 <NA> <NA>
## minorNameIfParentPresentWholeTimeForMinorMassage
## 24 NA
## 28 NA
## whyChildMassageAndHasChildEverHadMassageBefore minorDOBifForMinor
## 24 NA <NA>
## 28 NA <NA>
## massagePraisesWhatYouLikeAboutMassageBenefitsYou
## 24 <NA>
## 28 <NA>
## talkingDuringMassageOK_isYes_or_Not_isNo
## 24 <NA>
## 28 <NA>
## pressureHealthPrecautionsDescribedNowWhatPressurePreferred
## 24 <NA>
## 28 <NA>
## genderPreferredWarningPrecautionOnMalesFemalesRespect
## 24 <NA>
## 28 <NA>
## whySelectThisMassageCompany yourGender
## 24 <NA> <NA>
## 28 <NA> <NA>
## bundledMassagePackageSavingsInterestedIn
## 24 <NA>
## 28 <NA>Just checking, because I thought it was the one group but it was the printed handwritten couple, the female didn’t sign but printed it out, very few did this. The husband had a different name than his consent form too. This is fine programmatically, not for reality of mobile massage provider.
We will do each of these individually, because after running this earlier, the Birth.Date field produced DOB into the future.
[3] “DateLastServiceReturned”
Data$DateLastServiceReturned <- as.Date(format(as.Date(Data$DateLastServiceReturned, "%m/%d/%Y"), "%m/%d/%y"), "%m/%d/%y")
summary(Data$DateLastServiceReturned)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## "2019-05-20" "2021-03-15" "2021-07-20" "2022-01-26" "2022-07-11" "2025-12-29"
## NA's
## "145"This is ok to have 150 NAs in the above field bc those belong to new clients whose history cannot be exact for last massage and is not applicable to last massage with this mobile massage provider.
“todaysDate”
Data$todaysDate <- as.Date(format(as.Date(Data$todaysDate, "%m/%d/%Y"), "%m/%d/%y"), "%m/%d/%y")
summary(Data$todaysDate)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## "2026-01-08" "2026-01-08" "2026-01-08" "2026-01-08" "2026-01-08" "2026-01-08"The date of running this program in Excel is this field’s value. Take note that the ‘todaysDate’ field is the date the program was last opened in Excel before manipulating format in R. But it should actually say the 9th of January because it was opened in Excel on that day and then opened in R for edits made with currency to numeric done on the 9th. .
“Submission.Date” “Birth.Date”
Data$Submission.Date <- as.Date(format(as.Date(Data$Submission.Date, "%m/%d/%Y"), "%m/%d/%y"), "%m/%d/%y")
summary(Data$Submission.Date)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## "2019-05-19" "2020-11-12" "2020-12-08" "2021-12-07" "2022-01-25" "2025-12-29"Seems good.
“Birth.Date”
Data$Birth.Date## [1] "10/13/1986" "6/1/1979" "12/14/1983" "9/20/1990" "12/14/1983"
## [6] "10/13/1986" "2/19/1993" "7/24/1996" "3/6/1962" "10/13/1986"
## [11] "1/17/1972" "1/17/1972" "1/17/1972" "1/17/1972" "6/9/1973"
## [16] "9/30/1976" "10/13/1986" "10/13/1986" "4/26/1990" "10/13/1986"
## [21] "5/25/1986" "12/3/1991" "5/25/1986" "7/30/1991" "5/25/1986"
## [26] "3/27/1986" "10/17/1984" "7/30/1991" "5/25/1986" "6/1/1979"
## [31] "6/10/1998" "7/2/1992" "8/31/1994" "1/15/1995" "10/5/1946"
## [36] "6/28/1997" "6/22/1963" "9/26/1984" "9/4/1970" "6/10/1992"
## [41] "5/26/1975" "4/11/1954" "12/26/1985" "7/12/1987" "7/2/1987"
## [46] "6/6/2001" "6/16/1979" "9/9/1987" "6/1/1979" "11/15/1977"
## [51] "3/12/1999" "6/16/1979" "3/8/1992" "3/8/1992" "6/16/1979"
## [56] "3/8/1992" "3/8/1992" "3/8/1992" "4/2/1997" "9/4/1970"
## [61] "3/8/1992" "3/8/1992" "3/4/1994" "3/8/1992" "3/8/1992"
## [66] "6/16/1979" "3/8/1992" "3/8/1992" "3/4/1994" "1/5/1993"
## [71] "3/8/1992" "3/4/1994" "7/25/1964" "3/8/1992" "10/13/1986"
## [76] "3/8/1992" "3/4/1994" "3/8/1992" "6/16/1979" "3/8/1992"
## [81] "3/4/1994" "3/8/1992" "3/4/1994" "7/25/1964" "3/8/1992"
## [86] "3/8/1992" "3/4/1994" "6/11/1984" "7/18/1987" "3/8/1992"
## [91] "2/19/1984" "3/8/1992" "11/16/1970" "3/4/1994" "11/16/1970"
## [96] "2/17/1948" "2/11/1965" "6/16/1979" "11/2/1975" "11/2/1975"
## [101] "11/2/1975" "9/11/1980" "11/2/1975" "8/31/1994" "1/15/1995"
## [106] "5/25/1986" "11/2/1975" "6/16/1979" "11/2/1975" "3/27/1986"
## [111] "1/28/1988" "6/30/1988" "7/2/1992" "4/8/1959" "5/26/1975"
## [116] "1/15/1995" "6/29/1956" "8/31/1994" "1/15/1995" "2/17/1948"
## [121] "8/7/1986" "2/17/1948" "3/9/1981" "6/11/1984" "7/18/1987"
## [126] "3/9/1981" "2/17/1948" "2/2/1983" "2/2/1983" "9/19/1984"
## [131] "2/17/1948" "3/9/1981" "2/2/1983" "2/17/1948" "3/9/1981"
## [136] "5/1/1974" "1/15/1995" "6/22/1988" "6/29/1956" "4/7/1989"
## [141] "8/31/1994" "1/15/1995" "5/1/1974" "2/2/1983" "5/1/1974"
## [146] "3/9/1981" "5/1/1974" "2/17/1948" "3/9/1981" "5/1/1974"
## [151] "7/2/1992" "4/8/1959" "2/2/1983" "6/11/1984" "7/18/1987"
## [156] "2/20/1993" "5/1/1974" "2/17/1948" "3/9/1981" "5/1/1974"
## [161] "6/30/1987" "5/1/1974" "2/17/1948" "5/1/1974" "2/2/1983"
## [166] "8/12/1982" "2/17/1948" "5/1/1974" "2/2/1983" "8/12/1982"
## [171] "8/12/1982" "2/17/1948" "2/2/1983" "8/12/1982" "6/11/1984"
## [176] "7/18/1987" "6/13/1986" "2/9/1989" "8/12/1982" "3/27/1988"
## [181] "2/17/1948" "2/2/1983" "8/12/1982" "2/17/1948" "3/9/1981"
## [186] "8/12/1982" "2/17/1948" "2/2/1983" "6/23/1961" "2/17/1948"
## [191] "1/15/1995" "6/29/1956" "6/28/1988" "11/11/1990" "6/6/2001"
## [196] "2/17/1948" "12/29/1985" "6/28/1988" "11/11/1990" "6/11/1984"
## [201] "7/18/1987" "2/2/1983" "3/9/1981" "11/11/1990" "2/17/1948"
## [206] "2/2/1983" "2/17/1948" "2/2/1983" "2/17/1948" "7/7/1990"
## [211] "6/28/1988" "2/2/1983" "8/1/1996" "7/7/1990" "5/26/1984"
## [216] "8/1/1996" "2/17/1948" "5/26/1984" "6/13/1986" "2/9/1989"
## [221] "11/11/1990" "2/2/1983" "8/1/1996" "7/7/1990" "7/7/1990"
## [226] "6/11/1984" "7/18/1987" "2/3/1982" "2/3/1982" "8/1/1996"
## [231] "2/17/1948" "9/4/1970" "6/10/1992" "2/2/1983" "8/1/1996"
## [236] "6/28/1988" "11/11/1990" "11/11/1990" "7/7/1990" "2/17/1948"
## [241] "6/13/1986" "2/9/1989" "8/1/1996" "2/2/1983" "5/26/1984"
## [246] "8/31/1994" "1/15/1995" "1/3/2000" "10/17/1999" "7/28/1989"
## [251] "6/13/1986" "2/9/1989" "2/2/1983" "5/26/1984" "12/6/1986"
## [256] "2/2/1983" "6/13/1986" "2/9/1989" "2/2/1983" "6/25/1997"
## [261] "8/1/1996" "11/6/2000" "9/6/1956" "11/6/2000" "7/7/1990"
## [266] "7/7/1990" "11/6/2000" "11/6/2000" "6/11/1984" "7/18/1987"
## [271] "5/26/1984" "2/2/1983" "2/2/1983" "2/2/1983" "2/2/1983"
## [276] "2/2/1983" "2/17/1948" "2/2/1983" "2/17/1948" "6/13/1986"
## [281] "2/9/1989" "2/17/1948" "2/17/1948" "2/2/1983" "6/13/1986"
## [286] "2/9/1989" "2/17/1948" "2/17/1948" "5/25/1988" "10/16/1966"
## [291] "2/17/1948" "6/11/1984" "7/18/1987" "2/17/1948" "2/28/1985"
## [296] "7/31/1986" "8/31/1994" "1/15/1995" "1/3/2000" "10/17/1999"
## [301] "2/17/1948" "2/17/1948" "6/28/1997" "6/24/1990" "6/22/1963"
## [306] "2/17/1948" "2/17/1948" "2/17/1948" "2/17/1948" "2/17/1948"
## [311] "2/17/1948" "2/17/1948" "12/26/1974" "2/17/1948" "2/17/1948"
## [316] "2/17/1948" "2/17/1948" "2/17/1948" "6/13/1986" "2/9/1989"
## [321] "2/17/1948" "2/17/1948" "6/11/1984" "7/18/1987" "2/17/1948"
## [326] "2/17/1948" "2/17/1948" "2/17/1948" "2/17/1948" "2/17/1948"
## [331] "7/18/1987" "7/18/1987" "10/2/1982" "10/13/1986" "5/4/1983"
## [336] "4/22/1974" "5/9/1986" "2/22/1968" "2/22/1968" "2/22/1968"
## [341] "2/22/1968" "8/12/1942" "1/26/1978" "8/31/1994" "1/15/1995"
## [346] "6/13/1986" "2/9/1989" "2/17/1948" "2/17/1948" "2/17/1948"
## [351] "2/17/1948" "2/17/1948" "2/17/1948" "6/11/1984" "7/18/1987"
## [356] "2/17/1948" "2/17/1948" "10/10/1976" "8/31/1994" "1/15/1995"
## [361] "1/3/2000" "10/17/1999" "2/17/1948" "2/19/1960" "10/15/1992"
## [366] "10/29/1965" "6/12/1989" "2/17/1948" "6/11/1984" "7/18/1987"
## [371] "2/17/1948" "2/17/1948" "2/17/1948" "2/17/1948" "2/17/1948"
## [376] "2/17/1948" "2/17/1948" "2/17/1948" "2/17/1948" "6/11/1984"
## [381] "7/18/1987" "6/11/1984" "7/18/1987" "1/10/1952" "6/11/1984"
## [386] "7/18/1987" "8/31/1994" "1/15/1995" "6/11/1984" "7/18/1987"
## [391] "3/25/1998" "3/1/1954" "3/25/1998" "8/31/1994" "1/15/1995"
## [396] "11/29/1966" "10/13/1993" "7/29/1970" "7/29/1970" "4/30/1991"
## [401] "1/26/1987" "8/5/1995" "6/11/1984" "7/18/1987" "4/12/1983"
## [406] "1/16/1988" "6/7/1987" "2/14/1994" "9/4/1970" "8/29/1968"
## [411] "12/27/1987" "11/9/1989" "6/24/1986" "6/7/1987" "9/13/1971"
## [416] "6/11/1984" "7/18/1987" "5/19/1965" "8/31/1994" "1/15/1995"
## [421] "7/12/2000" "1/3/2000" "1/23/1988" "5/8/1994" "9/13/1971"
## [426] "6/7/1987" "12/9/1973" "11/28/1966" "7/11/1980" "7/11/1980"
## [431] "1/15/1995" "1/3/2000" "2/2/1983" "2/2/1983" "11/21/1963"
## [436] "7/18/1987" "6/2/1990" "8/25/1986" "2/2/1983" "1/3/2000"
## [441] "8/31/1994" "1/15/1995" "10/18/1971" "10/18/1971" "10/18/1971"
## [446] "4/12/1983" "10/18/1971" "10/18/1971" "11/9/1989" "6/24/1986"
## [451] "6/11/1984" "7/18/1987" "6/7/1987" "10/18/1971" "1/23/1969"
## [456] "4/12/1983" "9/27/1983" "10/28/1957" "9/27/1983" "1/16/1988"
## [461] "7/18/1987" "4/12/1983" "1/4/1947" "7/18/1969" "6/11/1984"
## [466] "7/18/1987" "6/24/1998" "12/4/1963" "6/7/1987" "4/12/1983"
## [471] "3/16/1963" "3/16/1963" "7/18/1987" "9/27/1983" "10/28/1957"
## [476] "11/4/1961" "6/11/1984" NA "2/28/1985" "7/31/1986"
## [481] "5/14/1988" "12/28/1997" "3/16/1963" "6/16/1963" "12/6/1963"
## [486] "4/5/1957" "3/16/1963" "4/5/1957"After trying the convert to 2 digit year, there was a problem, so we are not changing the birthdate field as we don’t need to use it in our analytics or timeseries forecasting.
Seems like a Y2K dilemma as the formatting is getting closer to older years and some clients are older than 60 years old which seems to be when the problem starts with putting their birthday as 2064 or 2055 and so on. See what I mean when we just take the field or feature and do change the formatting to 2 digit year, there are years in the future for a date of birth. This is not how it should be, so we will leave it alone.
birthday <- Data$Birth.Date
birthday1 <- format(as.Date(birthday, "%m/%d/%Y"), "%m/%d/%y")
birthday2 <- as.Date(birthday1, "%m/%d/%y")
futureDOBerror <- data.frame(DOB = birthday2[1:50], age=Data$ageAtSubmission[1:50])
y2k <- subset(futureDOBerror, age>55)
y2k## DOB age
## 9 2062-03-06 57
## 35 2046-10-05 74
## 37 2063-06-22 57
## 42 2054-04-11 66You can see what will happen to the DOB of those older than 55 years of age from output above.
Lets NOT try manipulating the year so that if it is in the future beyond 2026, then we convert the year to replace the ‘20’ with ‘19’. We haven’t changed it in the data base yet, and there is already an Excel calculated field for age of client at time of service. But lets see all date field summary statistics.
summary(Data[,c(DateColumnsToChange)])## dateOfService dateAgreedSigned DateLastServiceReturned
## Min. :2019-05-20 Min. :2019-05-19 Min. :2019-05-20
## 1st Qu.:2021-02-26 1st Qu.:2020-11-22 1st Qu.:2021-03-15
## Median :2021-08-07 Median :2020-12-08 Median :2021-07-20
## Mean :2022-04-24 Mean :2021-12-08 Mean :2022-01-26
## 3rd Qu.:2023-01-07 3rd Qu.:2022-02-14 3rd Qu.:2022-07-11
## Max. :2026-01-07 Max. :2025-12-29 Max. :2025-12-29
## NA's :2 NA's :145
## todaysDate Submission.Date Birth.Date
## Min. :2026-01-08 Min. :2019-05-19 Length:488
## 1st Qu.:2026-01-08 1st Qu.:2020-11-12 Class :character
## Median :2026-01-08 Median :2020-12-08 Mode :character
## Mean :2026-01-08 Mean :2021-12-07
## 3rd Qu.:2026-01-08 3rd Qu.:2022-01-25
## Max. :2026-01-08 Max. :2025-12-29
## The Birth.Date field is character format because of the as.Date function error in giving future birth dates if the age is greater than 55 or if the double digit is greater than 1969 of January.
We will leave the date fields as they are as still more data manipulation to do before running some time series and other analytics in the exploratory data analysis or EDA of this project. To see who we can target for most income on returns, favorability, idea client, good price, gratuity, and local or willing to pay the extra drive cost beyond 30 minutes.
Lets see if our data keeps the date fields when we write it to csv and read it in for summary statistics.
write.csv(Data, 'datesdone.csv', row.names=F)Data1 <- read.csv('datesdone.csv', header=T, sep=',', na.strings=c('',' ','na','NA'))
summary(Data1)## SalesReceiptNumber dateOfService StartTime EndTime
## Min. :100.0 Length:488 Length:488 Length:488
## 1st Qu.:204.8 Class :character Class :character Class :character
## Median :306.5 Mode :character Mode :character Mode :character
## Mean :300.9
## 3rd Qu.:395.0
## Max. :493.0
##
## newReturn returned referred
## Length:488 Length:488 Length:488
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## DateLastServiceReturned daysPassedBetweenServices weeksPassedBetweenServices
## Length:488 Min. : 0.00 Min. : 0.000
## Class :character 1st Qu.: 0.00 1st Qu.: 0.000
## Mode :character Median : 7.00 Median : 1.000
## Mean : 48.71 Mean : 6.941
## 3rd Qu.: 28.00 3rd Qu.: 4.000
## Max. :1437.00 Max. :205.000
##
## todaysDate daysSinceTodayAndDateOfThisService
## Length:488 Min. : 1
## Class :character 1st Qu.:1097
## Mode :character Median :1615
## Mean :1355
## 3rd Qu.:1777
## Max. :2425
##
## weeksSinceTodayAndDateOfThisService likeToSeeAgain City
## Min. : 0.0 Length:488 Length:488
## 1st Qu.:157.0 Class :character Class :character
## Median :231.0 Mode :character Mode :character
## Mean :193.5
## 3rd Qu.:254.0
## Max. :346.0
##
## ZipCode MassagePackage ServiceCost
## Min. :91701 Length:488 Length:488
## 1st Qu.:92503 Class :character Class :character
## Median :92869 Mode :character Mode :character
## Mean :92606
## 3rd Qu.:92883
## Max. :92887
##
## driveTimeBeyond30minBothWays Discount TypeOfDiscount
## Min. :10.00 Min. : 5.00 Length:488
## 1st Qu.:15.00 1st Qu.:10.00 Class :character
## Median :20.00 Median :15.00 Mode :character
## Mean :23.33 Mean :21.07
## 3rd Qu.:30.00 3rd Qu.:30.00
## Max. :40.00 Max. :80.00
## NA's :485 NA's :192
## AmountPaid_NotCreditUsed CreditPaid_monthlyOrPkg AmountPaid_As_Income
## Min. :-390.00 Min. :-225.00 Min. :-315.00
## 1st Qu.: 59.06 1st Qu.: 50.00 1st Qu.: 60.00
## Median : 80.00 Median : 50.00 Median : 70.00
## Mean : 84.87 Mean : 82.04 Mean : 73.87
## 3rd Qu.: 95.00 3rd Qu.: 70.00 3rd Qu.: 90.50
## Max. : 450.00 Max. : 450.00 Max. : 200.00
## NA's :102 NA's :407 NA's :11
## clientRemainingCreditBalance Gratuity FSA_HSA SpaFinderGiftCard
## Min. : 1.0 Min. : 2.00 Min. : 80.0 Min. : 25.0
## 1st Qu.:100.0 1st Qu.:10.00 1st Qu.: 97.5 1st Qu.: 50.0
## Median :150.0 Median :12.50 Median :130.0 Median : 50.0
## Mean :170.2 Mean :15.67 Mean :122.2 Mean : 57.8
## 3rd Qu.:225.0 3rd Qu.:20.00 3rd Qu.:145.0 3rd Qu.: 69.0
## Max. :405.0 Max. :65.00 Max. :145.0 Max. :100.0
## NA's :380 NA's :116 NA's :477 NA's :468
## otherGiftCard creditCard cash zelle
## Min. :10 Min. :-390.00 Min. : 10.00 Min. : 20.00
## 1st Qu.:45 1st Qu.: 56.25 1st Qu.: 10.00 1st Qu.: 58.75
## Median :80 Median : 75.00 Median : 20.00 Median : 70.00
## Mean :60 Mean : 78.46 Mean : 36.17 Mean : 71.96
## 3rd Qu.:85 3rd Qu.: 92.00 3rd Qu.: 50.00 3rd Qu.: 90.00
## Max. :90 Max. : 450.00 Max. :160.00 Max. :120.00
## NA's :485 NA's :259 NA's :321 NA's :411
## check TypePayment Submission.Date consentForm_formType
## Min. : 10.0 Length:488 Length:488 Length:488
## 1st Qu.:200.0 Class :character Class :character Class :character
## Median :200.0 Mode :character Mode :character Mode :character
## Mean :179.1
## 3rd Qu.:200.0
## Max. :405.0
## NA's :466
## manualInputMissingInDataBaseSourceOrPrinted receivedMassageFromMe
## Length:488 Length:488
## Class :character Class :character
## Mode :character Mode :character
##
##
##
##
## Birth.Date ageAtSubmission termsAgreedTo termsSignature
## Length:488 Min. :19.00 Length:488 Length:488
## Class :character 1st Qu.:31.00 Class :character Class :character
## Mode :character Median :37.00 Mode :character Mode :character
## Mean :42.53
## 3rd Qu.:53.00
## Max. :80.00
## NA's :1
## dateAgreedSigned femaleOrMaleTherapistPreference lotionOrOilPreference
## Length:488 Length:488 Length:488
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## describeWhyMobileMassagePreferred painScale1least_10worst
## Length:488 Min. : 1.000
## Class :character 1st Qu.: 3.000
## Mode :character Median : 5.000
## Mean : 4.738
## 3rd Qu.: 6.000
## Max. :10.000
## NA's :41
## healthConditionsPrecautions sleep1poor_10BestEver stress1none_10extremely
## Length:488 Min. : 1.000 Min. : 1.000
## Class :character 1st Qu.: 6.000 1st Qu.: 4.000
## Mode :character Median : 6.000 Median : 5.000
## Mean : 6.676 Mean : 5.397
## 3rd Qu.: 8.000 3rd Qu.: 7.000
## Max. :10.000 Max. :10.000
## NA's :16 NA's :14
## Pressure massageModalitiesPreferred areasToAvoid
## Length:488 Length:488 Length:488
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## massageStyleToolsPreferred massageGoals additonalServices
## Length:488 Length:488 Length:488
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## howHeardAboutCompany willingToRecommendCompany OKtoContactEmailTextPhone
## Length:488 Length:488 Length:488
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## BioPsychoSocialModelOfPain_massageExpectations lastMassageWhen
## Length:488 Length:488
## Class :character Class :character
## Mode :character Mode :character
##
##
##
##
## lastMassageComplaints lastMassageReceivedWhere
## Length:488 Length:488
## Class :character Class :character
## Mode :character Mode :character
##
##
##
##
## minorNameIfParentPresentWholeTimeForMinorMassage
## Mode:logical
## NA's:488
##
##
##
##
##
## whyChildMassageAndHasChildEverHadMassageBefore minorDOBifForMinor
## Mode:logical Length:488
## NA's:488 Class :character
## Mode :character
##
##
##
##
## massagePraisesWhatYouLikeAboutMassageBenefitsYou
## Length:488
## Class :character
## Mode :character
##
##
##
##
## talkingDuringMassageOK_isYes_or_Not_isNo
## Length:488
## Class :character
## Mode :character
##
##
##
##
## pressureHealthPrecautionsDescribedNowWhatPressurePreferred
## Length:488
## Class :character
## Mode :character
##
##
##
##
## genderPreferredWarningPrecautionOnMalesFemalesRespect
## Length:488
## Class :character
## Mode :character
##
##
##
##
## whySelectThisMassageCompany yourGender
## Length:488 Length:488
## Class :character Class :character
## Mode :character Mode :character
##
##
##
##
## bundledMassagePackageSavingsInterestedIn
## Length:488
## Class :character
## Mode :character
##
##
##
## Bummer! It doesn’t store the date formatted features to be read back in as date objects. At least we still have the Data in Rstudio environment of objects. Remove the Data1 and other objects not using again.
rm(Data1,df,error1,futureDOBerror,maxDOB, birthday, birthday1, y2k, birthday2,DateColumns, DateColumnsToChange,dates,Dates)## Warning in rm(Data1, df, error1, futureDOBerror, maxDOB, birthday, birthday1, :
## object 'df' not found## Warning in rm(Data1, df, error1, futureDOBerror, maxDOB, birthday, birthday1, :
## object 'maxDOB' not foundls()## [1] "Data"str(Data)## 'data.frame': 488 obs. of 73 variables:
## $ SalesReceiptNumber : int 100 101 102 103 104 105 106 107 108 109 ...
## $ dateOfService : Date, format: "2019-05-20" "2019-05-22" ...
## $ StartTime : chr "4:00 PM" "1:00 PM" "9:00 AM" "4:30 PM" ...
## $ EndTime : chr "8:00 PM" "3:00 PM" "10:30 AM" "6:00 PM" ...
## $ newReturn : chr "new" "new" "new" "new" ...
## $ returned : chr "yes" "yes" "yes" "no" ...
## $ referred : chr "no" "no" "no" "no" ...
## $ DateLastServiceReturned : Date, format: NA NA ...
## $ daysPassedBetweenServices : int 0 0 0 0 5 30 0 0 0 28 ...
## $ weeksPassedBetweenServices : int 0 0 0 0 1 4 0 0 0 4 ...
## $ todaysDate : Date, format: "2026-01-08" "2026-01-08" ...
## $ daysSinceTodayAndDateOfThisService : int 2425 2423 2421 2418 2416 2395 2388 2381 2380 2367 ...
## $ weeksSinceTodayAndDateOfThisService : int 346 346 346 345 345 342 341 340 340 338 ...
## $ likeToSeeAgain : chr "yes" "no" "yes" "yes" ...
## $ City : chr "Fontana" "Chino Hills" "Corona" "Corona" ...
## $ ZipCode : int 92335 91709 92882 92879 92882 92335 91709 92880 92882 92335 ...
## $ MassagePackage : chr "Family Massage Special" "1 1/2 Hour Customized Massage-Pretal" "1 1/2 Hour Customized Massage-Deep Tissue" "1 1/2 Hour Customized Massage-Head Aches" ...
## $ ServiceCost : chr "145.00" "80.00" "80.00" "80.00" ...
## $ driveTimeBeyond30minBothWays : int NA NA NA NA NA NA NA NA NA NA ...
## $ Discount : num NA NA 12 12 16 15 8.25 10 NA 10 ...
## $ TypeOfDiscount : chr NA NA "15% stress ruins life" "15% furbabies Mama and Papa" ...
## $ AmountPaid_NotCreditUsed : num 145 80 68 68 64 ...
## $ CreditPaid_monthlyOrPkg : int NA NA NA NA NA NA NA NA NA NA ...
## $ AmountPaid_As_Income : num 185 120 102 90 100 ...
## $ clientRemainingCreditBalance : int NA NA NA NA NA NA NA NA NA NA ...
## $ Gratuity : num 40 40 22 10 20 ...
## $ FSA_HSA : num 95 NA NA NA NA 130 NA NA NA 135 ...
## $ SpaFinderGiftCard : int 50 NA 50 NA 40 NA NA 64 NA NA ...
## $ otherGiftCard : int NA NA NA 80 NA NA NA NA NA NA ...
## $ creditCard : num NA NA NA NA NA NA 83 NA 63 NA ...
## $ cash : int 40 120 18 10 44 40 NA NA NA 40 ...
## $ zelle : num NA NA NA NA NA NA NA NA NA NA ...
## $ check : num NA NA NA NA NA NA NA NA NA NA ...
## $ TypePayment : chr "95 FSA, 50 SpaFinder, Cash tip" "Cash" "50 SpaFinder, 18 cash, cash tip" "Target Visa credit gift card, 10 cash" ...
## $ Submission.Date : Date, format: "2019-05-19" "2019-05-22" ...
## $ consentForm_formType : chr "oldForm" "oldForm" "oldForm" "oldForm" ...
## $ manualInputMissingInDataBaseSourceOrPrinted : chr "no" "no" "no" "no" ...
## $ receivedMassageFromMe : chr "Yes" "Yes" "Yes" "Yes" ...
## $ Birth.Date : chr "10/13/1986" "6/1/1979" "12/14/1983" "9/20/1990" ...
## $ ageAtSubmission : int 32 39 35 28 35 32 26 22 57 32 ...
## $ termsAgreedTo : chr "Yes" "Yes" "Yes" "Yes" ...
## $ termsSignature : chr "on consent form different terms in file" "on consent form different terms in file" "on consent form different terms in file" "on consent form different terms in file" ...
## $ dateAgreedSigned : Date, format: "2019-05-19" "2019-05-22" ...
## $ femaleOrMaleTherapistPreference : chr NA NA NA NA ...
## $ lotionOrOilPreference : chr NA NA NA NA ...
## $ describeWhyMobileMassagePreferred : chr NA NA NA NA ...
## $ painScale1least_10worst : int 2 9 8 5 8 2 4 3 NA 2 ...
## $ healthConditionsPrecautions : chr NA "Sciatica" NA "Migraines\nBruise easily" ...
## $ sleep1poor_10BestEver : int 7 10 7 3 7 7 10 4 5 7 ...
## $ stress1none_10extremely : int 3 5 4 4 4 3 3 4 3 3 ...
## $ Pressure : chr "Light\nmedium" "deep tissue" "deep tissue" "medium" ...
## $ massageModalitiesPreferred : chr "Swedish (speed and pressure of application vary and don't have to be fixed, such as deep tissue with strong app"| __truncated__ "Accupressure (deep tissue massage with thumbs or elbows along long muscles of body and the deeper muscle layers"| __truncated__ "Swedish (speed and pressure of application vary and don't have to be fixed, such as deep tissue with strong app"| __truncated__ "Swedish (speed and pressure of application vary and don't have to be fixed, such as deep tissue with strong app"| __truncated__ ...
## $ areasToAvoid : chr NA NA NA NA ...
## $ massageStyleToolsPreferred : chr "thumbs (common)\nforearms (for deeper medium pressure, but not deep pressure unless the sides of body like the "| __truncated__ "feet (for accupressure of large muscle areas like upper back, thighs, hamstrings, and hips)" "thumbs (common)\nknuckles (also common if MT has long nails)\nfists ( for gathering tissue layers and rolling o"| __truncated__ "thumbs (common)\npalms of hands (for firm, light, and medium pressure)\nelbows (for deeper pressure)\nforearms "| __truncated__ ...
## $ massageGoals : chr "relaxed state of mind" "increased range of motion" "relaxed state of mind\nless to no pain in areas of my body that ache\nless inflammation from stress" "relaxed state of mind\nless to no pain in areas of my body that ache\nless inflammation from stress" ...
## $ additonalServices : chr NA NA NA NA ...
## $ howHeardAboutCompany : chr "Internet" "Internet" "Internet" "Internet" ...
## $ willingToRecommendCompany : chr "Maybe" "Yes" NA "Yes" ...
## $ OKtoContactEmailTextPhone : chr NA NA NA NA ...
## $ BioPsychoSocialModelOfPain_massageExpectations : chr NA NA NA NA ...
## $ lastMassageWhen : chr NA NA NA NA ...
## $ lastMassageComplaints : chr NA NA NA NA ...
## $ lastMassageReceivedWhere : chr NA NA NA NA ...
## $ minorNameIfParentPresentWholeTimeForMinorMassage : logi NA NA NA NA NA NA ...
## $ whyChildMassageAndHasChildEverHadMassageBefore : logi NA NA NA NA NA NA ...
## $ minorDOBifForMinor : chr NA NA NA NA ...
## $ massagePraisesWhatYouLikeAboutMassageBenefitsYou : chr NA NA NA NA ...
## $ talkingDuringMassageOK_isYes_or_Not_isNo : chr NA NA NA NA ...
## $ pressureHealthPrecautionsDescribedNowWhatPressurePreferred: chr NA NA NA NA ...
## $ genderPreferredWarningPrecautionOnMalesFemalesRespect : chr NA NA NA NA ...
## $ whySelectThisMassageCompany : chr NA NA NA NA ...
## $ yourGender : chr NA NA NA NA ...
## $ bundledMassagePackageSavingsInterestedIn : chr NA NA NA NA ...colnames(Data)## [1] "SalesReceiptNumber"
## [2] "dateOfService"
## [3] "StartTime"
## [4] "EndTime"
## [5] "newReturn"
## [6] "returned"
## [7] "referred"
## [8] "DateLastServiceReturned"
## [9] "daysPassedBetweenServices"
## [10] "weeksPassedBetweenServices"
## [11] "todaysDate"
## [12] "daysSinceTodayAndDateOfThisService"
## [13] "weeksSinceTodayAndDateOfThisService"
## [14] "likeToSeeAgain"
## [15] "City"
## [16] "ZipCode"
## [17] "MassagePackage"
## [18] "ServiceCost"
## [19] "driveTimeBeyond30minBothWays"
## [20] "Discount"
## [21] "TypeOfDiscount"
## [22] "AmountPaid_NotCreditUsed"
## [23] "CreditPaid_monthlyOrPkg"
## [24] "AmountPaid_As_Income"
## [25] "clientRemainingCreditBalance"
## [26] "Gratuity"
## [27] "FSA_HSA"
## [28] "SpaFinderGiftCard"
## [29] "otherGiftCard"
## [30] "creditCard"
## [31] "cash"
## [32] "zelle"
## [33] "check"
## [34] "TypePayment"
## [35] "Submission.Date"
## [36] "consentForm_formType"
## [37] "manualInputMissingInDataBaseSourceOrPrinted"
## [38] "receivedMassageFromMe"
## [39] "Birth.Date"
## [40] "ageAtSubmission"
## [41] "termsAgreedTo"
## [42] "termsSignature"
## [43] "dateAgreedSigned"
## [44] "femaleOrMaleTherapistPreference"
## [45] "lotionOrOilPreference"
## [46] "describeWhyMobileMassagePreferred"
## [47] "painScale1least_10worst"
## [48] "healthConditionsPrecautions"
## [49] "sleep1poor_10BestEver"
## [50] "stress1none_10extremely"
## [51] "Pressure"
## [52] "massageModalitiesPreferred"
## [53] "areasToAvoid"
## [54] "massageStyleToolsPreferred"
## [55] "massageGoals"
## [56] "additonalServices"
## [57] "howHeardAboutCompany"
## [58] "willingToRecommendCompany"
## [59] "OKtoContactEmailTextPhone"
## [60] "BioPsychoSocialModelOfPain_massageExpectations"
## [61] "lastMassageWhen"
## [62] "lastMassageComplaints"
## [63] "lastMassageReceivedWhere"
## [64] "minorNameIfParentPresentWholeTimeForMinorMassage"
## [65] "whyChildMassageAndHasChildEverHadMassageBefore"
## [66] "minorDOBifForMinor"
## [67] "massagePraisesWhatYouLikeAboutMassageBenefitsYou"
## [68] "talkingDuringMassageOK_isYes_or_Not_isNo"
## [69] "pressureHealthPrecautionsDescribedNowWhatPressurePreferred"
## [70] "genderPreferredWarningPrecautionOnMalesFemalesRespect"
## [71] "whySelectThisMassageCompany"
## [72] "yourGender"
## [73] "bundledMassagePackageSavingsInterestedIn"Lets remove the client remaining balance feature because it will throw off timeseries as sparse data input with each service so input changed and this field left blank just calculating off type of payment or retrieving in private data the person and notes there. And also the minor fields because only a few inquired about the minor and those questions were as part of the consent form to give consent to massage their minor as long as they are there and present entire time. Nobody actually had a minor massaged except for the earlier days in the family package that was offered when traveling distance was ok up to an hour. They actually had separate forms for those in the family and only the matriarch was counted and total was for package total that the form was altered later to individual family members and splitting cost and gratuity given in equal parts per member of the couple, family, or group. That is why few decimals but when splitting the cost and gratuity this is why becuase nobody actually tips that way.
Data <- Data[,-c(25,64:66)]
colnames(Data)## [1] "SalesReceiptNumber"
## [2] "dateOfService"
## [3] "StartTime"
## [4] "EndTime"
## [5] "newReturn"
## [6] "returned"
## [7] "referred"
## [8] "DateLastServiceReturned"
## [9] "daysPassedBetweenServices"
## [10] "weeksPassedBetweenServices"
## [11] "todaysDate"
## [12] "daysSinceTodayAndDateOfThisService"
## [13] "weeksSinceTodayAndDateOfThisService"
## [14] "likeToSeeAgain"
## [15] "City"
## [16] "ZipCode"
## [17] "MassagePackage"
## [18] "ServiceCost"
## [19] "driveTimeBeyond30minBothWays"
## [20] "Discount"
## [21] "TypeOfDiscount"
## [22] "AmountPaid_NotCreditUsed"
## [23] "CreditPaid_monthlyOrPkg"
## [24] "AmountPaid_As_Income"
## [25] "Gratuity"
## [26] "FSA_HSA"
## [27] "SpaFinderGiftCard"
## [28] "otherGiftCard"
## [29] "creditCard"
## [30] "cash"
## [31] "zelle"
## [32] "check"
## [33] "TypePayment"
## [34] "Submission.Date"
## [35] "consentForm_formType"
## [36] "manualInputMissingInDataBaseSourceOrPrinted"
## [37] "receivedMassageFromMe"
## [38] "Birth.Date"
## [39] "ageAtSubmission"
## [40] "termsAgreedTo"
## [41] "termsSignature"
## [42] "dateAgreedSigned"
## [43] "femaleOrMaleTherapistPreference"
## [44] "lotionOrOilPreference"
## [45] "describeWhyMobileMassagePreferred"
## [46] "painScale1least_10worst"
## [47] "healthConditionsPrecautions"
## [48] "sleep1poor_10BestEver"
## [49] "stress1none_10extremely"
## [50] "Pressure"
## [51] "massageModalitiesPreferred"
## [52] "areasToAvoid"
## [53] "massageStyleToolsPreferred"
## [54] "massageGoals"
## [55] "additonalServices"
## [56] "howHeardAboutCompany"
## [57] "willingToRecommendCompany"
## [58] "OKtoContactEmailTextPhone"
## [59] "BioPsychoSocialModelOfPain_massageExpectations"
## [60] "lastMassageWhen"
## [61] "lastMassageComplaints"
## [62] "lastMassageReceivedWhere"
## [63] "massagePraisesWhatYouLikeAboutMassageBenefitsYou"
## [64] "talkingDuringMassageOK_isYes_or_Not_isNo"
## [65] "pressureHealthPrecautionsDescribedNowWhatPressurePreferred"
## [66] "genderPreferredWarningPrecautionOnMalesFemalesRespect"
## [67] "whySelectThisMassageCompany"
## [68] "yourGender"
## [69] "bundledMassagePackageSavingsInterestedIn"Lets get a summary of those who filled out the optional summary questions on their consent forms. After we change them all to factors.
Data$newReturn <- as.factor(Data$newReturn)
Data$returned <- as.factor(Data$returned )
Data$referred <- as.factor(Data$referred)
Data$likeToSeeAgain <- as.factor(Data$likeToSeeAgain)
Data$City <- as.factor(Data$City)
Data$ZipCode <- as.factor(Data$ZipCode)
Data$MassagePackage <- as.factor(Data$MassagePackage)
Data$TypeOfDiscount <- as.factor(Data$TypeOfDiscount)
Data$consentForm_formType <- as.factor(Data$consentForm_formType)
Data$manualInputMissingInDataBaseSourceOrPrinted <- as.factor(Data$manualInputMissingInDataBaseSourceOrPrinted)
Data$receivedMassageFromMe <- as.factor(Data$receivedMassageFromMe)
Data$femaleOrMaleTherapistPreference <- as.factor(Data$femaleOrMaleTherapistPreference)
Data$lotionOrOilPreference <- as.factor(Data$lotionOrOilPreference)
Data$describeWhyMobileMassagePreferred <- as.factor(Data$describeWhyMobileMassagePreferred)
Data$painScale1least_10worst <- as.factor(Data$painScale1least_10worst)
Data$healthConditionsPrecautions <- as.factor(Data$healthConditionsPrecautions)
Data$sleep1poor_10BestEver <- as.factor(Data$sleep1poor_10BestEver)
Data$stress1none_10extremely <- as.factor(Data$stress1none_10extremely)
Data$Pressure <- as.factor(Data$Pressure)
Data$massageModalitiesPreferred <- as.factor(Data$massageModalitiesPreferred)
Data$areasToAvoid <- as.factor(Data$areasToAvoid)
Data$massageStyleToolsPreferred <- as.factor(Data$massageStyleToolsPreferred)
Data$massageGoals <- as.factor(Data$massageGoals)
Data$additonalServices <- as.factor(Data$additonalServices)
Data$howHeardAboutCompany <- as.factor(Data$howHeardAboutCompany)
Data$willingToRecommendCompany <- as.factor(Data$willingToRecommendCompany)
Data$OKtoContactEmailTextPhone <- as.factor(Data$OKtoContactEmailTextPhone)
Data$BioPsychoSocialModelOfPain_massageExpectations <- as.factor(Data$BioPsychoSocialModelOfPain_massageExpectations)
Data$lastMassageWhen <- as.factor(Data$lastMassageWhen)
Data$lastMassageComplaints <- as.factor(Data$lastMassageComplaints)
Data$lastMassageReceivedWhere <- as.factor(Data$lastMassageReceivedWhere)
Data$massagePraisesWhatYouLikeAboutMassageBenefitsYou <- as.factor(Data$massagePraisesWhatYouLikeAboutMassageBenefitsYou)
Data$talkingDuringMassageOK_isYes_or_Not_isNo <- as.factor(Data$talkingDuringMassageOK_isYes_or_Not_isNo)
Data$pressureHealthPrecautionsDescribedNowWhatPressurePreferred <- as.factor(Data$pressureHealthPrecautionsDescribedNowWhatPressurePreferred)
Data$genderPreferredWarningPrecautionOnMalesFemalesRespect <- as.factor(Data$genderPreferredWarningPrecautionOnMalesFemalesRespect)
Data$whySelectThisMassageCompany <- as.factor(Data$whySelectThisMassageCompany)
Data$yourGender <- as.factor(Data$yourGender)
Data$bundledMassagePackageSavingsInterestedIn <- as.factor(Data$bundledMassagePackageSavingsInterestedIn) Since the receipt included multiple people if in a couple or family or group, lets make that a factor as well so that the receipts can be used by their household total for that date.
Data$SalesReceiptNumber <- as.factor(Data$SalesReceiptNumber)We should see factor summary stats now, so lets do a summary of these features.
summary(Data)## SalesReceiptNumber dateOfService StartTime EndTime
## 142 : 4 Min. :2019-05-20 Length:488 Length:488
## 218 : 4 1st Qu.:2021-02-26 Class :character Class :character
## 308 : 4 Median :2021-08-07 Mode :character Mode :character
## 345 : 4 Mean :2022-04-24
## 379 : 4 3rd Qu.:2023-01-07
## 393 : 4 Max. :2026-01-07
## (Other):464
## newReturn returned referred DateLastServiceReturned
## new :145 no :142 no : 17 Min. :2019-05-20
## return:343 yes:346 referred: 54 1st Qu.:2021-03-15
## yes : 1 Median :2021-07-20
## NA's :416 Mean :2022-01-26
## 3rd Qu.:2022-07-11
## Max. :2025-12-29
## NA's :145
## daysPassedBetweenServices weeksPassedBetweenServices todaysDate
## Min. : 0.00 Min. : 0.000 Min. :2026-01-08
## 1st Qu.: 0.00 1st Qu.: 0.000 1st Qu.:2026-01-08
## Median : 7.00 Median : 1.000 Median :2026-01-08
## Mean : 48.71 Mean : 6.941 Mean :2026-01-08
## 3rd Qu.: 28.00 3rd Qu.: 4.000 3rd Qu.:2026-01-08
## Max. :1437.00 Max. :205.000 Max. :2026-01-08
##
## daysSinceTodayAndDateOfThisService weeksSinceTodayAndDateOfThisService
## Min. : 1 Min. : 0.0
## 1st Qu.:1097 1st Qu.:157.0
## Median :1615 Median :231.0
## Mean :1355 Mean :193.5
## 3rd Qu.:1777 3rd Qu.:254.0
## Max. :2425 Max. :346.0
##
## likeToSeeAgain City ZipCode
## no : 11 Corona :190 92883 :103
## yes:477 Norco : 72 92860 : 72
## Riverside : 50 92503 : 40
## Yorba Linda: 28 91752 : 37
## Eastvale : 22 92881 : 33
## Chino Hills: 20 92882 : 31
## (Other) :106 (Other):172
## MassagePackage
## One Hour Persolized Massage :129
## One and one half hour Splitting an hour credit in half of missed weekly massage: 46
## One and one half hour Customized Massage : 30
## One Hour Couples Massage : 27
## One hour MLD 10 pkg $45 each : 24
## (Other) :229
## NA's : 3
## ServiceCost driveTimeBeyond30minBothWays Discount
## Length:488 Min. :10.00 Min. : 5.00
## Class :character 1st Qu.:15.00 1st Qu.:10.00
## Mode :character Median :20.00 Median :15.00
## Mean :23.33 Mean :21.07
## 3rd Qu.:30.00 3rd Qu.:30.00
## Max. :40.00 Max. :80.00
## NA's :485 NA's :192
## TypeOfDiscount
## manual lymphathic draige (MLD) Oct/Nov special : 43
## monthly membership paid in June/weekly $50 rate : 39
## MLD 10 prepaid : 19
## monthly membership paid for November 90 minute weekly this month only: 19
## 10 pkg MLD : 17
## (Other) :199
## NA's :152
## AmountPaid_NotCreditUsed CreditPaid_monthlyOrPkg AmountPaid_As_Income
## Min. :-390.00 Min. :-225.00 Min. :-315.00
## 1st Qu.: 59.06 1st Qu.: 50.00 1st Qu.: 60.00
## Median : 80.00 Median : 50.00 Median : 70.00
## Mean : 84.87 Mean : 82.04 Mean : 73.87
## 3rd Qu.: 95.00 3rd Qu.: 70.00 3rd Qu.: 90.50
## Max. : 450.00 Max. : 450.00 Max. : 200.00
## NA's :102 NA's :407 NA's :11
## Gratuity FSA_HSA SpaFinderGiftCard otherGiftCard
## Min. : 2.00 Min. : 80.0 Min. : 25.0 Min. :10
## 1st Qu.:10.00 1st Qu.: 97.5 1st Qu.: 50.0 1st Qu.:45
## Median :12.50 Median :130.0 Median : 50.0 Median :80
## Mean :15.67 Mean :122.2 Mean : 57.8 Mean :60
## 3rd Qu.:20.00 3rd Qu.:145.0 3rd Qu.: 69.0 3rd Qu.:85
## Max. :65.00 Max. :145.0 Max. :100.0 Max. :90
## NA's :116 NA's :477 NA's :468 NA's :485
## creditCard cash zelle check
## Min. :-390.00 Min. : 10.00 Min. : 20.00 Min. : 10.0
## 1st Qu.: 56.25 1st Qu.: 10.00 1st Qu.: 58.75 1st Qu.:200.0
## Median : 75.00 Median : 20.00 Median : 70.00 Median :200.0
## Mean : 78.46 Mean : 36.17 Mean : 71.96 Mean :179.1
## 3rd Qu.: 92.00 3rd Qu.: 50.00 3rd Qu.: 90.00 3rd Qu.:200.0
## Max. : 450.00 Max. :160.00 Max. :120.00 Max. :405.0
## NA's :259 NA's :321 NA's :411 NA's :466
## TypePayment Submission.Date consentForm_formType
## Length:488 Min. :2019-05-19 group event form : 1
## Class :character 1st Qu.:2020-11-12 handwritten printed old form: 3
## Mode :character Median :2020-12-08 health history wellness form: 1
## Mean :2021-12-07 HealthIntake : 3
## 3rd Qu.:2022-01-25 newForm :171
## Max. :2025-12-29 oldForm :309
##
## manualInputMissingInDataBaseSourceOrPrinted receivedMassageFromMe
## no :471 Yes:488
## yes: 17
##
##
##
##
##
## Birth.Date ageAtSubmission termsAgreedTo termsSignature
## Length:488 Min. :19.00 Length:488 Length:488
## Class :character 1st Qu.:31.00 Class :character Class :character
## Mode :character Median :37.00 Mode :character Mode :character
## Mean :42.53
## 3rd Qu.:53.00
## Max. :80.00
## NA's :1
## dateAgreedSigned femaleOrMaleTherapistPreference
## Min. :2019-05-19 female massage therapist:358
## 1st Qu.:2020-11-22 male massage therapist : 12
## Median :2020-12-08 No preference : 84
## Mean :2021-12-08 NA's : 34
## 3rd Qu.:2022-02-14
## Max. :2025-12-29
## NA's :2
## lotionOrOilPreference
## lotion : 6
## lotion or oil, no preference:302
## oil :146
## NA's : 34
##
##
##
## describeWhyMobileMassagePreferred
## deep tissue all over arthritis pain chronic : 71
## Back is ticklish but I think with deep slow pressure it's ok. \n\nPark in carport Unit E. Sometimes iphones take you to Unit C. I'm in Unit E. Park next to the garage in the carport. The gate will be open to the backyard to go inside the unit. : 30
## Lower back pain.\nLower back and shoulders W/ medium pressure. Swedish. please avoid shins : 24
## Lymphatic drainage massage : 22
## We would just a like a massage. It\x92s been quite some time, since Feb 2020 that myself and husband has had one. This will be our first time having a masseuse to our house. We do have a 30 pound dog (tends to bark with strangers in the house) but he will be kenneled in a separate room.: 20
## (Other) :259
## NA's : 62
## painScale1least_10worst
## 6 :133
## 1 : 77
## 7 : 48
## 4 : 47
## 5 : 42
## (Other):100
## NA's : 41
## healthConditionsPrecautions
## High or Low Blood Pressure\nknee replacement : 71
## Skin Abrasions : 20
## High or Low Blood Pressure : 15
## Recent Surgeries (limbs, neck, low back, shoulders, etc.): 13
## Ticklish feet or other areas of body\nCold hands and feet: 13
## (Other) :124
## NA's :232
## sleep1poor_10BestEver stress1none_10extremely
## 6 :133 5 :125
## 8 :117 8 : 64
## 5 : 64 6 : 62
## 10 : 49 1 : 52
## 7 : 41 3 : 40
## (Other): 68 (Other):131
## NA's : 16 NA's : 14
## Pressure
## medium (just reaching middle level muscles, not too painful) : 51
## firm (broader pressure) : 35
## deep tissue (deep layer muscles)\nsuper deep tissue (very dense muscle layers need more pressure): 13
## Light (only superficial muscles reached) : 9
## deep tissue : 8
## (Other) : 37
## NA's :335
## massageModalitiesPreferred
## Variable Speed Sports Massage Tool (good for precise tendon and muscle adhesion pressure and percussion, or as the larger, flat, broad application with longer movements towards the heart for lymphatic drainage)\nSports (stretching involved, can vary in speed of massage from slow and elongated strokes of fibers in muscle or fast to stimulate circulation and prepare body for events)\nStretches (not the entire session, but for region specific areas such as to increase range of motion around the hips, neck, knees, elbows, and ankles)\nLymphatic drainage (skin rolling and light rhythmic strokes to eliminate edema. CONTRAINDICATED CONDITIONS: liver disease, ascites, hypothyroidism untreated, diabetes untreated, CHF or other heart disease, kidney disease, other endocrine disease like pancreatitis, atherosclerosis, stroke, arterial dissection, deep vein thrombosis, peripheral embolism, contagious skin disorder/infection, Chronic Obstructive Pulmonary Disease COPD, emphysema, other pulmonary diseases, lymph node(s) removal a local contraindication to removal site, on open wounds)\nReflexology of hands and feet (this is relaxing and great for people who cannot withstand a moderate amount of pressure during massage, this is also good for calming the nervous system, but not recommended if you have feet that get uncomfortably ticklish): 30
## Swedish (speed and pressure of application vary and don't have to be fixed, such as deep tissue with strong application and slowly to the back AND limbs)\nAccupressure (deep tissue massage with thumbs or elbows along long muscles of body and the deeper muscle layers of body) : 25
## Lymphatic drainage (skin rolling and light rhythmic strokes to eliminate edema) : 17
## Swedish (speed and pressure of application vary and don't have to be fixed, such as deep tissue with strong application and slowly to the back AND limbs)\nLymphatic drainage (skin rolling and light rhythmic strokes to eliminate edema) : 10
## Swedish (speed and pressure of application vary and don't have to be fixed, such as deep tissue with strong application and slowly to the back AND limbs)\nAccupressure (deep tissue massage with thumbs or elbows along long muscles of body and the deeper muscle layers of body)\nReflexology of hands and feet (this is relaxing and great for people who cannot withstand a moderate amount of pressure during massage, this is also good for calming the nervous system, but not recommended if you have feet that get uncomfortably ticklish) : 9
## (Other) : 62
## NA's :335
## areasToAvoid
## hair\nface\nfeet\nglutial muscles\nquadriceps (front thighs)\nknees : 10
## abdomen (digestion/lymph drainage) : 9
## feet : 2
## glutial muscles\npectoralis major (chest) : 2
## hair\nfeet\nglutial muscles\nlower back\nupper arms\nforearms\nhamstrings (back of legs)\nquadriceps (front thighs)\nhands: 2
## (Other) : 8
## NA's :455
## massageStyleToolsPreferred
## Open to trying anything that works : 16
## thumbs (common)\nknuckles (also common if MT has long nails)\nfists ( for gathering tissue layers and rolling out the adhesions in the layers)\npalms of hands (for firm, light, and medium pressure)\nelbows (for deeper pressure)\nforearms (for deeper medium pressure, but not deep pressure unless the sides of body like the Tendons of the legs)\nHot Stones\nChinese Cups: 13
## thumbs (common)\nknuckles (also common if MT has long nails)\nfists ( for gathering tissue layers and rolling out the adhesions in the layers)\npalms of hands (for firm, light, and medium pressure)\nelbows (for deeper pressure)\nforearms (for deeper medium pressure, but not deep pressure unless the sides of body like the Tendons of the legs)\nHot Stones : 12
## thumbs (common)\nknuckles (also common if MT has long nails)\nfists ( for gathering tissue layers and rolling out the adhesions in the layers)\npalms of hands (for firm, light, and medium pressure)\n : 10
## thumbs (common)\npalms of hands (for firm, light, and medium pressure)\nfeet (for accupressure of large muscle areas like upper back, thighs, hamstrings, and hips)\nHot Stones\nsound therapy : 9
## (Other) : 41
## NA's :387
## massageGoals
## relaxed state of mind\nless to no pain in areas of my body that ache\nless inflammation from stress : 28
## relaxed state of mind\nless fluid build up in areas of my body that have edema\nless inflammation from stress\nSleep better : 10
## relaxed state of mind\nless to no pain in areas of my body that ache\nless inflammation from stress\nless tension\nless anxiety: 9
## relaxed state of mind : 8
## less fluid build up in areas of my body that have edema\nSleep better : 7
## (Other) : 48
## NA's :378
## additonalServices
## aromatherapy\nhot stone massage : 9
## variable speed massage for lymph drainage\nDynamic cupping for lymph drainage, myofascial massage, and/or promoting immunity and recovery: 7
## variable speed massage for lymph drainage : 4
## aromatherapy : 2
## aromatherapy\nhot stone massage\nkinesiology taping with sports balm/gel for pain relief : 2
## (Other) : 7
## NA's :457
## howHeardAboutCompany willingToRecommendCompany
## Yelp : 51 Maybe: 22
## Internet: 29 yes : 2
## Family : 20 Yes : 78
## Friend : 6 NA's :386
## Google : 5
## (Other) : 8
## NA's :369
## OKtoContactEmailTextPhone
## text me promotional offers : 28
## email promotional deals : 24
## email promotional deals\ntext me promotional offers : 8
## send me my assessment and suggestions for next massage service and detailed receipt: 3
## email promotional deals\ncall me about promotional offers : 2
## (Other) : 6
## NA's :417
## BioPsychoSocialModelOfPain_massageExpectations
## My body is in the best shape of its life and I am only getting a massage to help my health. : 48
## I have had a recent ache that feels BETTER with stretching, massage, and exercising. : 27
## I recently had some MAJOR LIFE CHANGES that have stressed me out into changing my diet, sleep schedule, number of hours of sleep, lost a loved one even a pet counts, had no time to grieve a loved one, changed jobs, added a new overwhelming task to my daily activities such as watching over kids or elderly parents. : 7
## I recently had some MAJOR LIFE CHANGES that have stressed me out into changing my diet, sleep schedule, number of hours of sleep, lost a loved one even a pet counts, had no time to grieve a loved one, changed jobs, added a new overwhelming task to my daily activities such as watching over kids or elderly parents.\nI have had a recent ache that feels BETTER with stretching, massage, and exercising.: 5
## I have pain that is fine most times of the day, but when I am CONSTANTLY on my feet or sitting too long the old aches from a previous injury or surgery RETURN and make me want to sit down and rest. : 2
## (Other) : 13
## NA's :386
## lastMassageWhen
## 12/21/2021 : 30
## 2 months : 7
## 6 months ago : 7
## Haven’t had one since my surgery: 6
## 1 month ago : 4
## (Other) : 47
## NA's :387
## lastMassageComplaints
## Nothing. : 30
## No results : 6
## Didn’t work the muscles as much as I would like, didn’t stretch out the muscles/move my body while pressing on the muscles: 5
## worked out neck and shoulder pain : 4
## None : 3
## (Other) : 43
## NA's :397
## lastMassageReceivedWhere
## 23968 Old Pomegranate Road, Yorba Linda, CA: 30
## I don’t recall : 6
## Spa in SF : 5
## you : 5
## Unknow : 4
## (Other) : 46
## NA's :392
## massagePraisesWhatYouLikeAboutMassageBenefitsYou
## Relief of muscle tightness : 30
## Lipo recovery : 6
## all of the above : 5
## Stretch out tight muscles in neck, upper back, and glutes Relief of pain in those areas: 5
## Muscle aches : 4
## (Other) : 51
## NA's :387
## talkingDuringMassageOK_isYes_or_Not_isNo
## no : 9
## yes : 40
## yes, but only about answering questions I ask about the technique, training, benefits, or other questions I may have during my massage that wasn't addressed before the massage was scheduled.: 50
## NA's :389
##
##
##
## pressureHealthPrecautionsDescribedNowWhatPressurePreferred
## deep pressure (enough pressure to dig into the deep muscles of the back that uses less than firm broad application, applied slower than light, medium, or firm to dig through those top and middle layers of muscle or tight fascia.) : 22
## firm pressure (a little bit deeper than medium pressure but a broader surface and wants to spread the pressure among the middle layers of muscles and muscle fascia to pull apart muscle and myofascial adhesions) : 17
## good strength, deep pressure : 1
## light pressure (top surface for reaching the systemic circulation and lymphatic vessels, or the top layers of muscles in back, abdomen, feet, hands. : 8
## medium pressure (deeper pressure than light pressure, but able to get into the muscle belly of the top layers of muscles in the back, legs, arms, and glutes) : 48
## super deep pressure (this is if you have very tight muscle fascia and need someone to dig into your back, glutes, forearms, calves, or pectoralis muscles by the shoulder girdle. If you need deep pressure in the hands or feet, we recommend visiting the biopsychosocial section of this form as those areas that are in need of more pressure than deep have little muscle depth and could be due to allodynia or pain fiber crossing with nociceptive and proprioceptive fibers that aren't passing on the pressure or depth of pressure to thalamus. If you request more than deep pressure, more often you will not get super deep pressure. Massage therapists get labral tears from attempting to satisfy disrupted corticothalamic sensory to a client that has allodynia. We do not provide super deep pressure.): 3
## NA's :389
## genderPreferredWarningPrecautionOnMalesFemalesRespect
## female: 48
## male : 54
## NA's :386
##
##
##
##
## whySelectThisMassageCompany
## I am recovering from surgery and need a massage to improve healing outcomes and decrease healing time : 7
## This is a gift from a loved one : 5
## I am recovering from surgery and need a massage to improve healing outcomes and decrease healing time\nI am changing my lifestyle for the better and want to help my health by doing regular massage in combination with my diet, exercising, stretching, sleep, lowering stress, and other wellness additions to my health: 4
## I don't want to drive to and from a massage provider but am used to regular massages : 3
## I have had massages before and am too busy to visit or schedule in a massage at any of the local massage providers near me\nI don't want to drive to and from a massage provider but am used to regular massages : 2
## (Other) : 3
## NA's :464
## yourGender
## female: 87
## male : 28
## NA's :373
##
##
##
##
## bundledMassagePackageSavingsInterestedIn
## family massage special (4 hours of massage for as many family members to split time between for $145) : 1
## family massage special (4 hours of massage for as many family members to split time between for $145)\nmanual lymphatic drainage (ten 1-hour sessions $45 each, $450 prepaid)\nmonthly membership (four 1-hour massage sessions per month, $200): 1
## family massage special (4 hours of massage for as many family members to split time between for $200)\nmonthly membership (four 1-hour massage sessions per month, $200) : 2
## manual lymphatic drainage (ten 1-hour sessions $45 each, $450 prepaid) : 7
## monthly membership (four 1-hour massage sessions per month, $200) : 5
## NA's :472
## Well there is a lot more to infer from the summary stats on these factors to predict the best audience by most money per household earned and return client. Keep in mind there were actually only 488 actual transactions per person but not per household, the data when merging with consent data by full name added more observations. But you can eliminate duplicates by looking at the start and end time per transaction and see that one person cannot massage multiple people at the same time so those are duplicates, and rarely were there more than 4 family members per household so there may rarely be more than 4 observations per receipt number but some may be duplicates.
We cannot store these modifications to the data as it is because when written out as csv it loses those properties, and is read in exactly how it was to begin with, so to get the data to manipulate you need to run this script and then do the analysis and predictive analytics.
Lets look at the receipts since they are factors now to see how many per receipt or service address show up.
table(Data$SalesReceiptNumber)##
## 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 117 118 119 120
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1
## 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
## 1 1 1 1 1 2 1 1 1 1 2 1 2 1 2 1 1 1 2 1
## 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
## 1 4 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 2 1
## 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## 2 1 1 1 1 1 1 1 1 1 2 1 1 1 2 1 1 1 1 1
## 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
## 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 2 2 1 1 1
## 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
## 2 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 4 2 1
## 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240
## 1 1 1 1 1 1 1 2 1 2 1 1 1 1 1 1 1 1 1 1
## 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260
## 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1 1 1 1 1 1
## 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280
## 1 1 1 2 2 1 1 1 2 2 1 1 1 1 1 1 1 1 1 1
## 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300
## 1 1 1 1 1 1 1 2 1 1 1 1 1 2 2 1 1 2 1 1
## 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320
## 3 1 1 2 1 1 1 4 1 2 1 1 1 1 2 1 2 1 1 1
## 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340
## 2 2 2 1 1 1 1 1 1 1 1 1 2 1 1 1 2 1 1 2
## 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360
## 1 2 1 2 4 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1
## 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380
## 1 2 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 4 2
## 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400
## 2 2 1 1 1 1 1 1 2 1 1 1 4 1 4 1 2 1 1 1
## 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420
## 1 1 1 1 1 1 2 2 1 2 2 2 1 1 1 2 1 1 1 1
## 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440
## 1 1 1 2 1 1 1 1 2 1 2 1 1 2 1 2 1 1 2 1
## 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460
## 1 1 1 2 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1
## 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480
## 1 2 2 1 1 1 1 1 2 1 1 1 2 2 2 1 1 1 1 1
## 481 482 483 484 485 486 487 488 489 490 491 492 493
## 1 2 1 1 2 1 1 1 1 1 1 1 1None have more than 2 because some of the family members paid separately as most were couples so they had their own receipt. Lets look at total earned by massage package. df %>% group_by(category, another_column) %>% summarise(total_value = sum(value, na.rm = TRUE)) %>% ungroup()
summary_tbl <- Data %>% group_by(MassagePackage) %>% summarise(totalByPackage=sum(AmountPaid_As_Income, na.rm=TRUE))
summT <- summary_tbl[order(summary_tbl$totalByPackage, decreasing =T)[1:10],]
summT## # A tibble: 10 × 2
## MassagePackage totalByPackage
## <fct> <dbl>
## 1 One Hour Persolized Massage 7917.
## 2 One and one half hour Splitting an hour credit in half of mis… 2860
## 3 One and one half hour Customized Massage 2697.
## 4 One and one half hour Couples Massage 1742.
## 5 One Hour Couples Massage 1655
## 6 90 minutes regular price $120 1461
## 7 Family Massage Special 1274.
## 8 1 hour swedish regular price 1070
## 9 90 minutes $75 regularly $120 1015
## 10 One hour MLD 10 pkg $45 each 890The one hour personalized massage seems to be the most with 150 or more entries and around $10,000 over the years as a side gig from 2019-2025. The next ones for earnings per package are the 90 minutes for $120 no discountsLets look at those factors again, so that we can see if some can be combined, because we have 84 types of massage packages.
summT## # A tibble: 10 × 2
## MassagePackage totalByPackage
## <fct> <dbl>
## 1 One Hour Persolized Massage 7917.
## 2 One and one half hour Splitting an hour credit in half of mis… 2860
## 3 One and one half hour Customized Massage 2697.
## 4 One and one half hour Couples Massage 1742.
## 5 One Hour Couples Massage 1655
## 6 90 minutes regular price $120 1461
## 7 Family Massage Special 1274.
## 8 1 hour swedish regular price 1070
## 9 90 minutes $75 regularly $120 1015
## 10 One hour MLD 10 pkg $45 each 890ggplot(summT, aes(x = MassagePackage, y = totalByPackage)) +
geom_bar(stat = "identity", fill = "blue") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "Total Income per Massage Package",
x = "Massage Package Type",
y = "Total Per Massage Package") +
theme_minimal()
sum(Data$AmountPaid_As_Income, na.rm=TRUE)## [1] 35235.17The total sum for this side gig with bloated entries of 533 entries instead of 488 says the total earnings before expenses was 38,825.5 USD. That is about 7k a year from 2019-2025.
summary(Data$AmountPaid_As_Income)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## -315.00 60.00 70.00 73.87 90.50 200.00 11Lets look at earnings per year if we can.
Data %>% group_by(format(dateOfService,"%y")) %>% summarise(totalByYear=sum(AmountPaid_As_Income, na.rm=TRUE))## # A tibble: 8 × 2
## `format(dateOfService, "%y")` totalByYear
## <chr> <dbl>
## 1 19 2062.
## 2 20 6182.
## 3 21 11715
## 4 22 4329.
## 5 23 1190
## 6 24 2560
## 7 25 6998
## 8 26 200Make a barplot of this information of Earnings per Year.
summary_tbl <- Data %>% group_by(Year=format(dateOfService,"%y")) %>% summarise(totalByYear = sum(AmountPaid_As_Income, na.rm=TRUE))
ggplot(summary_tbl, aes(x = Year, y = totalByYear)) +
geom_bar(stat = "identity", fill = "plum") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "Total Income per Year",
x = "Year",
y = "Total Per Year") +
theme_minimal()
Looks like the early post pandemic years were the better years and those were a time when the lymphatic drainage massages were sold in bundles. But then again some of this data is duplicated as 533-488 is a bloated 45 more entries than it should have. Lets see if we can see any of these duplicate entries because duplicated() won’t work on this type of data and I tried earlier after the merger of income with consent form information.
I want to return entries where the receipts as factors are more than 2 entries per receipt. df %>% count(group) %>% slice_max(n, n = 1, with_ties = TRUE)
Data %>% count(SalesReceiptNumber) %>% slice_max(n,n=1,with_ties=TRUE)## SalesReceiptNumber n
## 1 142 4
## 2 218 4
## 3 308 4
## 4 345 4
## 5 379 4
## 6 393 4
## 7 395 4Originally with duplicate date, It said the receipts for 142,218,308,344,345,348,379,393,395, and 485 are at the max per house receipt of 4. But after removing the duplicates, 344,348, and 485 are not in the results . I know I massaged some families with four people but not that many that paid on same receipt. Lets see the data on those sales receipts.
topReceipts <- Data[Data$SalesReceiptNumber %in% c(142,218,308,344,345,348,379,393,395,485),]
topReceipts[,c(1:4)]## SalesReceiptNumber dateOfService StartTime EndTime
## 48 142 2020-10-24 3:20 PM 4:05 PM
## 49 142 2020-10-24 5:15 PM 6:45 PM
## 50 142 2020-10-24 4:15 PM 5:05 PM
## 51 142 2020-10-24 7:00 PM 7:45 PM
## 137 218 2021-04-03 4:10 PM 5:25 PM
## 138 218 2021-04-03 6:55 PM 8:05 PM
## 139 218 2021-04-03 5:35 PM 6:45 PM
## 140 218 2021-04-03 8:10 PM 9:20 PM
## 246 308 2021-08-08 8:00 PM 9:00 PM
## 247 308 2021-08-08 7:00 PM 8:00 PM
## 248 308 2021-08-08 6:00 PM 7:00 PM
## 249 308 2021-08-08 5:00 PM 6:00 PM
## 295 344 2021-12-31 12:00 PM 1:00 PM
## 296 344 2021-12-31 1:00 PM 2:00 PM
## 297 345 2022-01-02 7:30 PM 8:30 PM
## 298 345 2022-01-02 6:30 PM 7:30 PM
## 299 345 2022-01-02 9:30 PM 10:30 PM
## 300 345 2022-01-02 8:30 PM 9:30 PM
## 303 348 2022-01-15 6:00 PM 7:30 PM
## 304 348 2022-01-15 7:30 PM 8:30 PPM
## 305 348 2022-01-15 8:30 PM 9:30 PM
## 338 379 2022-09-20 10:00 AM 11:00 AM
## 339 379 2022-09-16 1:00 PM 2:00 PM
## 340 379 2022-09-26 6:00 PM 7:00 PM
## 341 379 2022-09-27 10:30 AM 11:30 AM
## 359 393 2022-12-28 6:00 PM 7:30 PM
## 360 393 2022-12-28 7:30 PM 9:00 PM
## 361 393 2022-12-28 10:00 PM 11:00 PM
## 362 393 2022-12-28 9:00 PM 10:00 PM
## 364 395 2023-01-07 7:00 PM 8:00 PM
## 365 395 2023-01-07 9:00 PM 10:00 PM
## 366 395 2023-01-07 8:00 PM 9:00 PM
## 367 395 2023-01-07 6:00 PM 7:00 PM
## 479 485 2025-12-07 12:00 PM 1:00 PM
## 480 485 2025-12-07 1:00 PM 2:00 PMWe can see now the receipt 379 has different dates so that one must have been copied and pasted for each entry and then the receipt number not changed. There are no duplicates now, but lets go ahead and look at receipt 379 now that it is used on multiple days or 3 different days in 2022.
r379 <- Data[Data$SalesReceiptNumber==379,]
r379## SalesReceiptNumber dateOfService StartTime EndTime newReturn returned
## 338 379 2022-09-20 10:00 AM 11:00 AM return yes
## 339 379 2022-09-16 1:00 PM 2:00 PM new yes
## 340 379 2022-09-26 6:00 PM 7:00 PM return yes
## 341 379 2022-09-27 10:30 AM 11:30 AM return no
## referred DateLastServiceReturned daysPassedBetweenServices
## 338 <NA> 2022-09-16 4
## 339 <NA> <NA> 0
## 340 <NA> 2022-09-20 6
## 341 <NA> 2022-09-26 1
## weeksPassedBetweenServices todaysDate daysSinceTodayAndDateOfThisService
## 338 1 2026-01-08 1206
## 339 0 2026-01-08 1210
## 340 1 2026-01-08 1200
## 341 0 2026-01-08 1199
## weeksSinceTodayAndDateOfThisService likeToSeeAgain City ZipCode
## 338 172 yes CA 92883
## 339 173 yes CA 92883
## 340 171 yes CA 92883
## 341 171 yes CA 92883
## MassagePackage ServiceCost
## 338 <NA> 80.00
## 339 monthly subscription weekly massage, 1st massage 80.00
## 340 <NA> 80.00
## 341 <NA> 80.00
## driveTimeBeyond30minBothWays Discount TypeOfDiscount
## 338 NA 30 monthly subscriber
## 339 NA 30 monthly subscriber
## 340 NA 30 monthly subscriber
## 341 NA 30 monthly subscriber
## AmountPaid_NotCreditUsed CreditPaid_monthlyOrPkg AmountPaid_As_Income
## 338 60 NA 10
## 339 70 NA 70
## 340 70 NA 20
## 341 70 NA 20
## Gratuity FSA_HSA SpaFinderGiftCard otherGiftCard creditCard cash zelle
## 338 10 NA NA NA NA 10 NA
## 339 20 NA NA NA NA 20 NA
## 340 20 NA NA NA NA 20 NA
## 341 20 NA NA NA NA 20 NA
## check TypePayment
## 338 NA 2nd massage tipped 10 prepaid monthly
## 339 200 1st massage tipped 20 prepaid the monthly member 200 rate for 4
## 340 NA 3rd massage tipped 20 prepaid monthly
## 341 NA 4th massage last of this monthly subscription
## Submission.Date consentForm_formType
## 338 2022-09-16 newForm
## 339 2022-09-16 newForm
## 340 2022-09-16 newForm
## 341 2022-09-16 newForm
## manualInputMissingInDataBaseSourceOrPrinted receivedMassageFromMe
## 338 no Yes
## 339 no Yes
## 340 no Yes
## 341 no Yes
## Birth.Date ageAtSubmission termsAgreedTo
## 338 2/22/1968 54 Yes
## 339 2/22/1968 54 Yes
## 340 2/22/1968 54 Yes
## 341 2/22/1968 54 Yes
## termsSignature
## 338 https://www.jotform.com/uploads/janiscorona/211143470705143/5391510558909671214/5391510558909671214_signature_86.png
## 339 https://www.jotform.com/uploads/janiscorona/211143470705143/5391510558909671214/5391510558909671214_signature_86.png
## 340 https://www.jotform.com/uploads/janiscorona/211143470705143/5391510558909671214/5391510558909671214_signature_86.png
## 341 https://www.jotform.com/uploads/janiscorona/211143470705143/5391510558909671214/5391510558909671214_signature_86.png
## dateAgreedSigned femaleOrMaleTherapistPreference
## 338 2022-09-16 female massage therapist
## 339 2022-09-16 female massage therapist
## 340 2022-09-16 female massage therapist
## 341 2022-09-16 female massage therapist
## lotionOrOilPreference
## 338 lotion or oil, no preference
## 339 lotion or oil, no preference
## 340 lotion or oil, no preference
## 341 lotion or oil, no preference
## describeWhyMobileMassagePreferred
## 338 Just had some reconstruction surgery to a torn muscle in my left breast and lipo 360 to my mid section. My Dr suggested I start lympatic drainage massage
## 339 Just had some reconstruction surgery to a torn muscle in my left breast and lipo 360 to my mid section. My Dr suggested I start lympatic drainage massage
## 340 Just had some reconstruction surgery to a torn muscle in my left breast and lipo 360 to my mid section. My Dr suggested I start lympatic drainage massage
## 341 Just had some reconstruction surgery to a torn muscle in my left breast and lipo 360 to my mid section. My Dr suggested I start lympatic drainage massage
## painScale1least_10worst
## 338 6
## 339 6
## 340 6
## 341 6
## healthConditionsPrecautions
## 338 Recent Surgeries (limbs, neck, low back, shoulders, etc.)
## 339 Recent Surgeries (limbs, neck, low back, shoulders, etc.)
## 340 Recent Surgeries (limbs, neck, low back, shoulders, etc.)
## 341 Recent Surgeries (limbs, neck, low back, shoulders, etc.)
## sleep1poor_10BestEver stress1none_10extremely
## 338 7 7
## 339 7 7
## 340 7 7
## 341 7 7
## Pressure
## 338 Light (only superficial muscles reached)\nmedium (just reaching middle level muscles, not too painful)
## 339 Light (only superficial muscles reached)\nmedium (just reaching middle level muscles, not too painful)
## 340 Light (only superficial muscles reached)\nmedium (just reaching middle level muscles, not too painful)
## 341 Light (only superficial muscles reached)\nmedium (just reaching middle level muscles, not too painful)
## massageModalitiesPreferred
## 338 Variable Speed Sports Massage Tool (good for precise tendon and muscle adhesion pressure and percussion, or as the larger, flat, broad application with longer movements towards the heart for lymphatic drainage)\nLymphatic drainage (skin rolling and light rhythmic strokes to eliminate edema)
## 339 Variable Speed Sports Massage Tool (good for precise tendon and muscle adhesion pressure and percussion, or as the larger, flat, broad application with longer movements towards the heart for lymphatic drainage)\nLymphatic drainage (skin rolling and light rhythmic strokes to eliminate edema)
## 340 Variable Speed Sports Massage Tool (good for precise tendon and muscle adhesion pressure and percussion, or as the larger, flat, broad application with longer movements towards the heart for lymphatic drainage)\nLymphatic drainage (skin rolling and light rhythmic strokes to eliminate edema)
## 341 Variable Speed Sports Massage Tool (good for precise tendon and muscle adhesion pressure and percussion, or as the larger, flat, broad application with longer movements towards the heart for lymphatic drainage)\nLymphatic drainage (skin rolling and light rhythmic strokes to eliminate edema)
## areasToAvoid massageStyleToolsPreferred
## 338 <NA> Open to trying anything that works
## 339 <NA> Open to trying anything that works
## 340 <NA> Open to trying anything that works
## 341 <NA> Open to trying anything that works
## massageGoals
## 338 less to no pain in areas of my body that ache\nless fluid build up in areas of my body that have edema\nless tension
## 339 less to no pain in areas of my body that ache\nless fluid build up in areas of my body that have edema\nless tension
## 340 less to no pain in areas of my body that ache\nless fluid build up in areas of my body that have edema\nless tension
## 341 less to no pain in areas of my body that ache\nless fluid build up in areas of my body that have edema\nless tension
## additonalServices howHeardAboutCompany
## 338 variable speed massage for lymph drainage Google
## 339 variable speed massage for lymph drainage Google
## 340 variable speed massage for lymph drainage Google
## 341 variable speed massage for lymph drainage Google
## willingToRecommendCompany OKtoContactEmailTextPhone
## 338 Yes text me promotional offers
## 339 Yes text me promotional offers
## 340 Yes text me promotional offers
## 341 Yes text me promotional offers
## BioPsychoSocialModelOfPain_massageExpectations lastMassageWhen
## 338 <NA> <NA>
## 339 <NA> <NA>
## 340 <NA> <NA>
## 341 <NA> <NA>
## lastMassageComplaints lastMassageReceivedWhere
## 338 <NA> <NA>
## 339 <NA> <NA>
## 340 <NA> <NA>
## 341 <NA> <NA>
## massagePraisesWhatYouLikeAboutMassageBenefitsYou
## 338 <NA>
## 339 <NA>
## 340 <NA>
## 341 <NA>
## talkingDuringMassageOK_isYes_or_Not_isNo
## 338 <NA>
## 339 <NA>
## 340 <NA>
## 341 <NA>
## pressureHealthPrecautionsDescribedNowWhatPressurePreferred
## 338 <NA>
## 339 <NA>
## 340 <NA>
## 341 <NA>
## genderPreferredWarningPrecautionOnMalesFemalesRespect
## 338 <NA>
## 339 <NA>
## 340 <NA>
## 341 <NA>
## whySelectThisMassageCompany
## 338 I am recovering from surgery and need a massage to improve healing outcomes and decrease healing time\nI am changing my lifestyle for the better and want to help my health by doing regular massage in combination with my diet, exercising, stretching, sleep, lowering stress, and other wellness additions to my health
## 339 I am recovering from surgery and need a massage to improve healing outcomes and decrease healing time\nI am changing my lifestyle for the better and want to help my health by doing regular massage in combination with my diet, exercising, stretching, sleep, lowering stress, and other wellness additions to my health
## 340 I am recovering from surgery and need a massage to improve healing outcomes and decrease healing time\nI am changing my lifestyle for the better and want to help my health by doing regular massage in combination with my diet, exercising, stretching, sleep, lowering stress, and other wellness additions to my health
## 341 I am recovering from surgery and need a massage to improve healing outcomes and decrease healing time\nI am changing my lifestyle for the better and want to help my health by doing regular massage in combination with my diet, exercising, stretching, sleep, lowering stress, and other wellness additions to my health
## yourGender
## 338 female
## 339 female
## 340 female
## 341 female
## bundledMassagePackageSavingsInterestedIn
## 338 monthly membership (four 1-hour massage sessions per month, $200)
## 339 monthly membership (four 1-hour massage sessions per month, $200)
## 340 monthly membership (four 1-hour massage sessions per month, $200)
## 341 monthly membership (four 1-hour massage sessions per month, $200)It was a monthly subscriber in the south Corona zip code area that tried out the 4 massages. I remember now, who. She was nice and got busy was using it for lymphatic drainage after surgery. Most everybody is or was nice. But good to acknowledge it.
Lets look at the sales by zipcode and do a barplot of it.
summary_tbl <- Data %>% group_by(ZipCode) %>% summarise(totalByZipCode = sum(AmountPaid_As_Income, na.rm=TRUE))
summ <- summary_tbl[order(summary_tbl$totalByZipCode, decreasing=T),]
summ## # A tibble: 34 × 2
## ZipCode totalByZipCode
## <fct> <dbl>
## 1 92883 7779.
## 2 92860 4565
## 3 92881 2852.
## 4 92882 2842.
## 5 92887 2250
## 6 91752 2120
## 7 92503 1888
## 8 91709 1611.
## 9 92879 1548
## 10 92335 1544.
## # ℹ 24 more rowsAccording to this data made more money in South Corona with ZipCode 92883, next best was 92860 which is Norco that is because I had a regular a few years that did the weekly massage at $50/massage for almost 2 years, very nice lady, after some surgeries she stopped getting them and found out she was doing OK but that was it. Scroll to the end of list and 92730 shows I got paid 51.25 USD. I think I remember her. Lets pull her up real quick. She was high on something or a schizoid and never saw her after that. She literally had driven from Mexico after having liposuction, breast augmentation, and a tummy tuck and was probably high on pain killers. She was going to get the 10 packages of lymphatic drainage and I didn’t make her pay up front for all, but then when she didn’t get any other ones but received that discount I decided to make everybody pay up front to save 25 USD on each massage at that time was 60 USD for an hour and then dropped to 45 USD only if they promised to get 10 of them. Now she was one that was not very nice and lived in a large complex apartment at night without parking and many buildings that she didn’t give the number and wasted 20-25 minutes just looking for her place. So I also made sure to write in the consent form to put the exact building or pin gate access and have a parking spot available right by the service address.
Data[Data$ZipCode==91730,]## SalesReceiptNumber dateOfService StartTime EndTime newReturn returned
## 91 177 2020-11-25 7:30 PM 8:30 PM new no
## referred DateLastServiceReturned daysPassedBetweenServices
## 91 <NA> <NA> 0
## weeksPassedBetweenServices todaysDate daysSinceTodayAndDateOfThisService
## 91 0 2026-01-08 1870
## weeksSinceTodayAndDateOfThisService likeToSeeAgain City ZipCode
## 91 267 yes Ranco Cucamonga 91730
## MassagePackage ServiceCost driveTimeBeyond30minBothWays
## 91 One Hour Persolized Massage 60.00 NA
## Discount TypeOfDiscount
## 91 15 manual lymphathic draige (MLD) Oct/Nov special
## AmountPaid_NotCreditUsed CreditPaid_monthlyOrPkg AmountPaid_As_Income
## 91 51.25 NA 51.25
## Gratuity FSA_HSA SpaFinderGiftCard otherGiftCard creditCard cash zelle check
## 91 6.25 NA NA NA 51.25 NA NA NA
## TypePayment Submission.Date consentForm_formType
## 91 credit card 2020-11-24 oldForm
## manualInputMissingInDataBaseSourceOrPrinted receivedMassageFromMe Birth.Date
## 91 no Yes 2/19/1984
## ageAtSubmission termsAgreedTo
## 91 36 Yes
## termsSignature
## 91 https://www.jotform.com/uploads/janiscorona/91274881154158/4820760431016761312/4820760431016761312_signature_86.png
## dateAgreedSigned femaleOrMaleTherapistPreference lotionOrOilPreference
## 91 2020-11-24 female massage therapist <NA>
## describeWhyMobileMassagePreferred painScale1least_10worst
## 91 Lymphatic drainage massage 3
## healthConditionsPrecautions sleep1poor_10BestEver stress1none_10extremely
## 91 <NA> 7 3
## Pressure massageModalitiesPreferred areasToAvoid massageStyleToolsPreferred
## 91 <NA> <NA> <NA> <NA>
## massageGoals additonalServices howHeardAboutCompany
## 91 <NA> <NA> <NA>
## willingToRecommendCompany OKtoContactEmailTextPhone
## 91 <NA> <NA>
## BioPsychoSocialModelOfPain_massageExpectations lastMassageWhen
## 91 <NA> <NA>
## lastMassageComplaints lastMassageReceivedWhere
## 91 <NA> <NA>
## massagePraisesWhatYouLikeAboutMassageBenefitsYou
## 91 <NA>
## talkingDuringMassageOK_isYes_or_Not_isNo
## 91 <NA>
## pressureHealthPrecautionsDescribedNowWhatPressurePreferred
## 91 <NA>
## genderPreferredWarningPrecautionOnMalesFemalesRespect
## 91 <NA>
## whySelectThisMassageCompany yourGender
## 91 <NA> <NA>
## bundledMassagePackageSavingsInterestedIn
## 91 <NA>I need to change the value from yes to no in the ‘likeToSeeAgain’ field so I don’t send her emailers or texts for promotions.
Data$likeToSeeAgain[91] <- 'no'
Data[91,]## SalesReceiptNumber dateOfService StartTime EndTime newReturn returned
## 91 177 2020-11-25 7:30 PM 8:30 PM new no
## referred DateLastServiceReturned daysPassedBetweenServices
## 91 <NA> <NA> 0
## weeksPassedBetweenServices todaysDate daysSinceTodayAndDateOfThisService
## 91 0 2026-01-08 1870
## weeksSinceTodayAndDateOfThisService likeToSeeAgain City ZipCode
## 91 267 no Ranco Cucamonga 91730
## MassagePackage ServiceCost driveTimeBeyond30minBothWays
## 91 One Hour Persolized Massage 60.00 NA
## Discount TypeOfDiscount
## 91 15 manual lymphathic draige (MLD) Oct/Nov special
## AmountPaid_NotCreditUsed CreditPaid_monthlyOrPkg AmountPaid_As_Income
## 91 51.25 NA 51.25
## Gratuity FSA_HSA SpaFinderGiftCard otherGiftCard creditCard cash zelle check
## 91 6.25 NA NA NA 51.25 NA NA NA
## TypePayment Submission.Date consentForm_formType
## 91 credit card 2020-11-24 oldForm
## manualInputMissingInDataBaseSourceOrPrinted receivedMassageFromMe Birth.Date
## 91 no Yes 2/19/1984
## ageAtSubmission termsAgreedTo
## 91 36 Yes
## termsSignature
## 91 https://www.jotform.com/uploads/janiscorona/91274881154158/4820760431016761312/4820760431016761312_signature_86.png
## dateAgreedSigned femaleOrMaleTherapistPreference lotionOrOilPreference
## 91 2020-11-24 female massage therapist <NA>
## describeWhyMobileMassagePreferred painScale1least_10worst
## 91 Lymphatic drainage massage 3
## healthConditionsPrecautions sleep1poor_10BestEver stress1none_10extremely
## 91 <NA> 7 3
## Pressure massageModalitiesPreferred areasToAvoid massageStyleToolsPreferred
## 91 <NA> <NA> <NA> <NA>
## massageGoals additonalServices howHeardAboutCompany
## 91 <NA> <NA> <NA>
## willingToRecommendCompany OKtoContactEmailTextPhone
## 91 <NA> <NA>
## BioPsychoSocialModelOfPain_massageExpectations lastMassageWhen
## 91 <NA> <NA>
## lastMassageComplaints lastMassageReceivedWhere
## 91 <NA> <NA>
## massagePraisesWhatYouLikeAboutMassageBenefitsYou
## 91 <NA>
## talkingDuringMassageOK_isYes_or_Not_isNo
## 91 <NA>
## pressureHealthPrecautionsDescribedNowWhatPressurePreferred
## 91 <NA>
## genderPreferredWarningPrecautionOnMalesFemalesRespect
## 91 <NA>
## whySelectThisMassageCompany yourGender
## 91 <NA> <NA>
## bundledMassagePackageSavingsInterestedIn
## 91 <NA>Good, that is wonderful that it is solved. We will have to write this out and save it as edited to preserve that save and not miss it next time.
write.csv(Data,'editsAll488IncomeConsentAnonymized.csv', row.names=F)Lets see if we can plot this tibble data as a barplot by zipcode of amount per zipcode earned. Internet feedback on plotting tibble results:
#library(ggplot2)
summT10 <- summary_tbl[order(summary_tbl$totalByZipCode, decreasing=T)[1:10],]
ggplot(summT10, aes(x = ZipCode, y = totalByZipCode)) +
geom_bar(stat = "identity", fill = "tomato") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "Total Income per ZipCode",
x = "Zip Code",
y = "Total Per Zip Code") +
theme_minimal()
Now lets plot a table of count returns by age after making a tibble for it.
summary_tbl <- Data %>% group_by(ageAtSubmission) %>% summarise(totalReturns=sum(returned=="yes", na.rm=TRUE))
summ <- summary_tbl[order(summary_tbl$totalReturns, decreasing=T),]
summ## # A tibble: 50 × 2
## ageAtSubmission totalReturns
## <int> <int>
## 1 72 70
## 2 42 29
## 3 28 25
## 4 33 23
## 5 26 21
## 6 36 20
## 7 32 18
## 8 25 13
## 9 34 13
## 10 39 12
## # ℹ 40 more rowsThe most returns are from my regular over almost 2 years and the next best client that returns by age is age 38 and then age 42. So it seems my idea demographic could be between 38 and 42 years of age or young middle aged adults and finding regulars that are retired and focused on weekly massages they benefit from and can afford. Overall the table says between 26 to 42 years of age are the best return clients for this mobile massage provider who is currently 43 but started company at age 37.
Now lets plot this as a bar plot.
summary_tbl <- Data %>% group_by(ageAtSubmission) %>% summarise(totalReturns=sum(returned=="yes", na.rm=TRUE))
summT <- summary_tbl[order(summary_tbl$totalReturns, decreasing=T)[1:10],]
ggplot(summT, aes(x = ageAtSubmission, y = totalReturns)) +
geom_bar(stat = "identity", fill = "aquamarine") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "Total Returns per Age Group",
x = "Age Group",
y = "Total Returns Per Age Group") +
theme_minimal()
Lets look at those clients who pay the most based on pressure they
receive. We are looking at Amount earned per group of pressure requested
on consent form after we look at the return rate by those requesting
different types of pressure.
summary_tbl <- Data %>% group_by(Pressure) %>% summarise(totalReturns=sum(returned=="yes", na.rm=TRUE))
summT <- summary_tbl[order(summary_tbl$totalReturns, decreasing=T)[1:10],]
summT## # A tibble: 10 × 2
## Pressure totalReturns
## <fct> <int>
## 1 <NA> 239
## 2 "medium (just reaching middle level muscles, not too painful)" 44
## 3 "firm (broader pressure)" 26
## 4 "deep tissue (deep layer muscles)\nsuper deep tissue (very dens… 11
## 5 "Light\nmedium" 7
## 6 "Light (only superficial muscles reached)" 6
## 7 "deep tissue" 3
## 8 "Light (only superficial muscles reached)\nmedium (just reachin… 3
## 9 "medium\ndeep tissue" 3
## 10 "deep tissue (deep layer muscles)" 2The top 10 pressure groups that return again by count want medium, firm, or deep pressure. With most wanting medium pressure.
ggplot(summT, aes(x = Pressure, y = totalReturns)) +
geom_bar(stat = "identity", fill = "aquamarine") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "Total Returns per Pressure Preference",
x = "Return Clients per Pressure preferred",
y = "Total Returns Per Pressure Preference") +
theme_minimal()
Plot not so great on pressure due to labels being worded long and the
axis not turning labels vertical like code was described as doing off
internet. But its ok, because we can see the tall bar is the NAs that
showed in the plot even though they were to be removed in the summarise
function with na.rm=T.
Now we will look at the amount earned by groups of pressure requested or filled in on consent form.
summary_tbl <- Data %>% group_by(Pressure) %>% summarise(PressureEarnings=sum(AmountPaid_As_Income, na.rm=TRUE))
summTen <- summary_tbl[order(summary_tbl$PressureEarnings, decreasing=T)[1:10],]
summTen## # A tibble: 10 × 2
## Pressure PressureEarnings
## <fct> <dbl>
## 1 <NA> 22608.
## 2 "medium (just reaching middle level muscles, not too painfu… 3580
## 3 "firm (broader pressure)" 2987.
## 4 "Light\nmedium" 1464.
## 5 "deep tissue (deep layer muscles)\nsuper deep tissue (very … 968.
## 6 "deep tissue" 791
## 7 "Light (only superficial muscles reached)" 591
## 8 "deep tissue (deep layer muscles)" 557.
## 9 "medium" 370
## 10 "medium\ndeep tissue" 344More earnings from the medium, firm, and light categories of pressure even though more return clientele from the deep pressure prefered group than the light pressure preferred group.
Lets plot this information of earnings per group of pressure.
ggplot(summTen, aes(x = Pressure, y = PressureEarnings)) +
geom_bar(stat = "identity", fill = "purple") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "Total Earnings per Pressure Preference",
x = "Earnings per Type of Pressure preferred",
y = "Total Earnings Per Pressure Preference") +
theme_minimal()
Lets now plot by sum of all payment methods a bar chart for amount earned from type of payment.
matrix <- as.matrix(Data[,26:32])
matrixColSums <- colSums(matrix,na.rm=TRUE)
matrixColSums## FSA_HSA SpaFinderGiftCard otherGiftCard creditCard
## 1344.29 1156.00 180.00 17968.14
## cash zelle check
## 6040.00 5540.99 3940.00barplot(matrixColSums, beside=TRUE,
col = c("skyblue","orange","lightgreen","plum","aquamarine","tomato","maroon"),
legend.text=colnames(matrix),
args.legend = list(x="topright"),
main = "Earnings by Payment Type",
ylab = "Earnings Value")
Lets use the library prophet to run some forecasting with the
information we have. We want to predict our earnings based on a group of
people that are 26 to 42 years old, like medium to firm pressure, are
local but preferrably in the south Corona Zip code of 92883 region. We
want respectable people, that keep returning for massage, have families
or are with a significant other as the returns are by multiple in a
household by receipt number count of people and earnings per receipt of
those receipts with more than one person getting a massage and most
people like one hour massages. That isn’t to say nobody else outside
that demographic is an idea client it just means more in this
demographic will continue purchasing massage services and pay adequate
pricing in earnings.
Lets load the prophet library if you haven’t done it earlier because we will use it now to forecast date of service to earnings over next year.
Now that we are doing forecasting with our times series we should use the date field and get returns per date and group of people that are 26-42, within Corona areas or top 3 zip codes from earlier information, use credit card and/or zelle or cash but nobody books an appointment for new client without a small deposit.
qplot(dateOfService, AmountPaid_As_Income, data=Data )## Warning: `qplot()` was deprecated in ggplot2 3.4.0.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: Removed 11 rows containing missing values or values outside the scale range
## (`geom_point()`).
df <- data.frame(ds = Data$dateOfService, y= Data$AmountPaid_As_Income)
m <- prophet(df)## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.future <- make_future_dataframe(m, periods=365)
tail(future)## ds
## 693 2027-01-02
## 694 2027-01-03
## 695 2027-01-04
## 696 2027-01-05
## 697 2027-01-06
## 698 2027-01-07forecast <- predict(m, future)
tail(forecast)## ds trend additive_terms additive_terms_lower
## 693 2027-01-02 107.1889 -4.273301 -4.273301
## 694 2027-01-03 107.2109 6.920161 6.920161
## 695 2027-01-04 107.2329 1.243967 1.243967
## 696 2027-01-05 107.2549 -11.910766 -11.910766
## 697 2027-01-06 107.2770 11.338241 11.338241
## 698 2027-01-07 107.2990 1.334833 1.334833
## additive_terms_upper weekly weekly_lower weekly_upper yearly
## 693 -4.273301 -5.563157 -5.563157 -5.563157 1.28985586
## 694 6.920161 6.332623 6.332623 6.332623 0.58753812
## 695 1.243967 1.332785 1.332785 1.332785 -0.08881836
## 696 -11.910766 -11.188285 -11.188285 -11.188285 -0.72248090
## 697 11.338241 12.637034 12.637034 12.637034 -1.29879305
## 698 1.334833 3.140367 3.140367 3.140367 -1.80553303
## yearly_lower yearly_upper multiplicative_terms multiplicative_terms_lower
## 693 1.28985586 1.28985586 0 0
## 694 0.58753812 0.58753812 0 0
## 695 -0.08881836 -0.08881836 0 0
## 696 -0.72248090 -0.72248090 0 0
## 697 -1.29879305 -1.29879305 0 0
## 698 -1.80553303 -1.80553303 0 0
## multiplicative_terms_upper yhat_lower yhat_upper trend_lower trend_upper
## 693 0 62.45905 144.0312 105.4407 108.8451
## 694 0 70.20115 156.4611 105.4558 108.8723
## 695 0 62.70864 149.4806 105.4699 108.8994
## 696 0 52.79063 136.8902 105.4839 108.9273
## 697 0 73.77831 161.2072 105.4976 108.9564
## 698 0 64.91796 149.4006 105.5113 108.9895
## yhat
## 693 102.91556
## 694 114.13104
## 695 108.47688
## 696 95.34417
## 697 118.61521
## 698 108.63382Well if I get my target idea client to do more returns, in zip codes of local areas with higher earnings and age group and pressure group of those who want around medium to firm pressure are aged 26-42 years, and live in Corona, then I can expect to make next year 80% more than this year from a lower end of 61 USD to 144 USD next year after New Year’s day, and 67.9 to 150.65 USD on the 7th of January next year if target group and goals met.
tail(forecast[c("ds","yhat","yhat_lower", "yhat_upper")])## ds yhat yhat_lower yhat_upper
## 693 2027-01-02 102.91556 62.45905 144.0312
## 694 2027-01-03 114.13104 70.20115 156.4611
## 695 2027-01-04 108.47688 62.70864 149.4806
## 696 2027-01-05 95.34417 52.79063 136.8902
## 697 2027-01-06 118.61521 73.77831 161.2072
## 698 2027-01-07 108.63382 64.91796 149.4006plot(m,forecast)
prophet_plot_components(m,forecast)## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## ℹ The deprecated feature was likely used in the prophet package.
## Please report the issue at <https://github.com/facebook/prophet/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Following notes on code from the youtube video by Dr. Bharatendra Rai
Time Series Forecasting in R, his videos are very informative and
detailed, highly recommend watching them to learn more information:
ds <- data\(date y <- log(data\)count) df <- data.frame(ds,y) qplot(ds,y,data=df) #large plot not so obvious for seasonality and 4 rows removed with NA library(prophet) #forecasting with prophet m <- prophet(df) m #details on model # go to help and type in prophet to understand those arguments #prediciton with prophet future <- make_future_dataframe(m, periods = 365) tail(future) forecast <- predict(m, future) #compared to original of 1094 the future has 1454 data points tail(forecast) #values per feature is forecast in year 2016 tail(forecast[c(‘ds’,‘yhat’,‘yhat_lower’,‘y_hat_upper’)]) #since log take exp exp(8.239266) #on 2016-12-29 in prediction #3786.76 is actual prediction plot(m, forecast) # plot actual vs predicted #forecast with confidence interval over actual data points, the lines are the predictions prophet_plot_components(m, forecast)
Well, that is great news. The trend is forecasted by date of service and earnings without targeting my demographics to be upward. There was a dip when starting medical school or from discounts that got the business owner more business but not more earnings as availability declined. Tuesdays don’t seem to be getting much activity, but Sundays, Mondays, and Wednesdays seem to be better active days for mobile massage. And this is entirely dependent on the provider’s availability throughout this time period as she has worked at least one job and been in school for the earlier years.
Thanks for reading and check back for more.
============================================================================
Part 2 of more analysis on the Data as an extension to part 1 the first half of this data using bloated data of duplicates that are corrected in part 3 as you read through the document.
Want to create a day of the week variable and plot the amount of transactions per day of the week on those days.
Data$DayOfWeekService <- weekdays(Data$dateOfService)
Data$DayOfWeekConsentSigned <- weekdays(Data$Submission.Date)
Data$DayOfWeekConsentSigned <- as.factor(Data$DayOfWeekConsentSigned)
Data$DayOfWeekService <- as.factor(Data$DayOfWeekService)
str(Data)## 'data.frame': 488 obs. of 71 variables:
## $ SalesReceiptNumber : Factor w/ 393 levels "100","101","102",..: 1 2 3 4 5 6 7 8 9 10 ...
## $ dateOfService : Date, format: "2019-05-20" "2019-05-22" ...
## $ StartTime : chr "4:00 PM" "1:00 PM" "9:00 AM" "4:30 PM" ...
## $ EndTime : chr "8:00 PM" "3:00 PM" "10:30 AM" "6:00 PM" ...
## $ newReturn : Factor w/ 2 levels "new","return": 1 1 1 1 2 2 1 1 1 2 ...
## $ returned : Factor w/ 2 levels "no","yes": 2 2 2 1 1 2 1 1 1 2 ...
## $ referred : Factor w/ 3 levels "no","referred",..: 1 1 1 1 1 1 3 1 1 1 ...
## $ DateLastServiceReturned : Date, format: NA NA ...
## $ daysPassedBetweenServices : int 0 0 0 0 5 30 0 0 0 28 ...
## $ weeksPassedBetweenServices : int 0 0 0 0 1 4 0 0 0 4 ...
## $ todaysDate : Date, format: "2026-01-08" "2026-01-08" ...
## $ daysSinceTodayAndDateOfThisService : int 2425 2423 2421 2418 2416 2395 2388 2381 2380 2367 ...
## $ weeksSinceTodayAndDateOfThisService : int 346 346 346 345 345 342 341 340 340 338 ...
## $ likeToSeeAgain : Factor w/ 2 levels "no","yes": 2 1 2 2 2 2 1 2 2 2 ...
## $ City : Factor w/ 23 levels "Anaheim","CA",..: 8 5 6 6 6 8 5 7 6 8 ...
## $ ZipCode : Factor w/ 34 levels "91701","91708",..: 10 3 32 29 32 10 3 30 32 10 ...
## $ MassagePackage : Factor w/ 84 levels "1 1/2 Hour Customized Massage-Deep Tissue",..: 56 3 1 2 1 56 81 80 79 56 ...
## $ ServiceCost : chr "145.00" "80.00" "80.00" "80.00" ...
## $ driveTimeBeyond30minBothWays : int NA NA NA NA NA NA NA NA NA NA ...
## $ Discount : num NA NA 12 12 16 15 8.25 10 NA 10 ...
## $ TypeOfDiscount : Factor w/ 82 levels "$16 next visit discount, 20% Yelp Review on $80 purchase",..: NA NA 13 12 16 51 11 14 NA 65 ...
## $ AmountPaid_NotCreditUsed : num 145 80 68 68 64 ...
## $ CreditPaid_monthlyOrPkg : int NA NA NA NA NA NA NA NA NA NA ...
## $ AmountPaid_As_Income : num 185 120 102 90 100 ...
## $ Gratuity : num 40 40 22 10 20 ...
## $ FSA_HSA : num 95 NA NA NA NA 130 NA NA NA 135 ...
## $ SpaFinderGiftCard : int 50 NA 50 NA 40 NA NA 64 NA NA ...
## $ otherGiftCard : int NA NA NA 80 NA NA NA NA NA NA ...
## $ creditCard : num NA NA NA NA NA NA 83 NA 63 NA ...
## $ cash : int 40 120 18 10 44 40 NA NA NA 40 ...
## $ zelle : num NA NA NA NA NA NA NA NA NA NA ...
## $ check : num NA NA NA NA NA NA NA NA NA NA ...
## $ TypePayment : chr "95 FSA, 50 SpaFinder, Cash tip" "Cash" "50 SpaFinder, 18 cash, cash tip" "Target Visa credit gift card, 10 cash" ...
## $ Submission.Date : Date, format: "2019-05-19" "2019-05-22" ...
## $ consentForm_formType : Factor w/ 6 levels "group event form",..: 6 6 6 6 6 6 6 6 6 6 ...
## $ manualInputMissingInDataBaseSourceOrPrinted : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 2 1 1 1 ...
## $ receivedMassageFromMe : Factor w/ 1 level "Yes": 1 1 1 1 1 1 1 1 1 1 ...
## $ Birth.Date : chr "10/13/1986" "6/1/1979" "12/14/1983" "9/20/1990" ...
## $ ageAtSubmission : int 32 39 35 28 35 32 26 22 57 32 ...
## $ termsAgreedTo : chr "Yes" "Yes" "Yes" "Yes" ...
## $ termsSignature : chr "on consent form different terms in file" "on consent form different terms in file" "on consent form different terms in file" "on consent form different terms in file" ...
## $ dateAgreedSigned : Date, format: "2019-05-19" "2019-05-22" ...
## $ femaleOrMaleTherapistPreference : Factor w/ 3 levels "female massage therapist",..: NA NA NA NA NA NA NA NA NA NA ...
## $ lotionOrOilPreference : Factor w/ 3 levels "lotion","lotion or oil, no preference",..: NA NA NA NA NA NA NA NA NA NA ...
## $ describeWhyMobileMassagePreferred : Factor w/ 108 levels "We would just a like a massage. It\x92s been quite some time, since Feb 2020 that myself and husband has had on"| __truncated__,..: NA NA NA NA NA NA NA NA NA NA ...
## $ painScale1least_10worst : Factor w/ 10 levels "1","2","3","4",..: 2 9 8 5 8 2 4 3 NA 2 ...
## $ healthConditionsPrecautions : Factor w/ 44 levels "autoimmune disorder (rheumatoid arthritis, psoriatic arthritis, systemic lupus erythematosus, fibromyalgia, ank"| __truncated__,..: NA 40 NA 22 NA NA NA NA NA NA ...
## $ sleep1poor_10BestEver : Factor w/ 10 levels "1","2","3","4",..: 7 10 7 3 7 7 10 4 5 7 ...
## $ stress1none_10extremely : Factor w/ 10 levels "1","2","3","4",..: 3 5 4 4 4 3 3 4 3 3 ...
## $ Pressure : Factor w/ 17 levels "deep tissue",..: 9 1 1 11 1 9 10 1 NA 9 ...
## $ massageModalitiesPreferred : Factor w/ 33 levels "Accupressure (deep tissue massage with thumbs or elbows along long muscles of body and the deeper muscle layers of body)",..: 19 2 17 16 17 19 NA 18 6 19 ...
## $ areasToAvoid : Factor w/ 13 levels "abdomen","abdomen (digestion/lymph drainage)",..: NA NA NA NA NA NA NA NA NA NA ...
## $ massageStyleToolsPreferred : Factor w/ 30 levels "feet (for accupressure of large muscle areas like upper back, thighs, hamstrings, and hips)",..: 12 1 14 25 14 12 NA 28 NA 12 ...
## $ massageGoals : Factor w/ 34 levels "back,arms,shoulders, abdomen focus, medium flow aligned with tension and regular breathing patterns of mine, le"| __truncated__,..: 19 3 26 26 26 19 1 12 NA 19 ...
## $ additonalServices : Factor w/ 11 levels "aromatherapy",..: NA NA NA NA NA NA NA NA NA NA ...
## $ howHeardAboutCompany : Factor w/ 10 levels "family","Family",..: 7 7 7 7 7 7 3 7 7 7 ...
## $ willingToRecommendCompany : Factor w/ 3 levels "Maybe","yes",..: 1 3 NA 3 NA 1 2 3 3 1 ...
## $ OKtoContactEmailTextPhone : Factor w/ 9 levels "email","email promotional deals",..: NA NA NA NA NA NA NA NA NA NA ...
## $ BioPsychoSocialModelOfPain_massageExpectations : Factor w/ 14 levels "best shape of its life and only getting massage to help my health, want weekly massages",..: NA NA NA NA NA NA NA NA NA NA ...
## $ lastMassageWhen : Factor w/ 37 levels "1 month ago",..: NA NA NA NA NA NA NA NA NA NA ...
## $ lastMassageComplaints : Factor w/ 38 levels "All was good",..: NA NA NA NA NA NA NA NA NA NA ...
## $ lastMassageReceivedWhere : Factor w/ 40 levels "23968 Old Pomegranate Road, Yorba Linda, CA",..: NA NA NA NA NA NA NA NA NA NA ...
## $ massagePraisesWhatYouLikeAboutMassageBenefitsYou : Factor w/ 40 levels "After getting a massage i can sleep better, I feel more relaxed",..: NA NA NA NA NA NA NA NA NA NA ...
## $ talkingDuringMassageOK_isYes_or_Not_isNo : Factor w/ 3 levels "no","yes","yes, but only about answering questions I ask about the technique, training, benefits, or other questions I may"| __truncated__: NA NA NA NA NA NA NA NA NA NA ...
## $ pressureHealthPrecautionsDescribedNowWhatPressurePreferred: Factor w/ 6 levels "deep pressure (enough pressure to dig into the deep muscles of the back that uses less than firm broad applicat"| __truncated__,..: NA NA NA NA NA NA NA NA NA NA ...
## $ genderPreferredWarningPrecautionOnMalesFemalesRespect : Factor w/ 2 levels "female","male": NA NA NA NA NA NA NA NA NA NA ...
## $ whySelectThisMassageCompany : Factor w/ 8 levels "I am legally blind and this is more convenient for me to have mobile massage services",..: NA NA NA NA NA NA NA NA NA NA ...
## $ yourGender : Factor w/ 2 levels "female","male": NA NA NA NA NA NA NA NA NA NA ...
## $ bundledMassagePackageSavingsInterestedIn : Factor w/ 5 levels "family massage special (4 hours of massage for as many family members to split time between for $145)",..: NA NA NA NA NA NA NA NA NA NA ...
## $ DayOfWeekService : Factor w/ 7 levels "Friday","Monday",..: 2 7 1 2 7 7 7 7 5 7 ...
## $ DayOfWeekConsentSigned : Factor w/ 7 levels "Friday","Monday",..: 4 7 5 2 5 4 7 7 5 4 ...We can see at the end of the structures list of features the days of week variables made are factors. The number of returns per day of week other than the weekly regular below.
summary_tbl <- Data %>% group_by(DayOfWeekService) %>% summarise(totalReturns=sum(returned=="yes", na.rm=TRUE))
summT <- summary_tbl[order(summary_tbl$totalReturns, decreasing=T)[1:7],]
summT## # A tibble: 7 × 2
## DayOfWeekService totalReturns
## <fct> <int>
## 1 Tuesday 96
## 2 Monday 51
## 3 Wednesday 50
## 4 Friday 43
## 5 Thursday 39
## 6 Sunday 37
## 7 Saturday 30There are more returns on Tuesday and that was the greatest day of the week for my regular who liven in the 92860 Zip code and got her weekly massage on that day, so lets exclude that Zip code and see what the highest return rate is by day of the week.
The number of returns per day of week other than the weekly regular below.
summary_tbl <- Data %>% group_by(DayOfWeekService) %>% summarise(totalReturns=sum(returned=="yes" & ZipCode != '92860', na.rm=TRUE))
summT <- summary_tbl[order(summary_tbl$totalReturns, decreasing=T)[1:7],]
summT## # A tibble: 7 × 2
## DayOfWeekService totalReturns
## <fct> <int>
## 1 Wednesday 50
## 2 Friday 43
## 3 Monday 43
## 4 Sunday 37
## 5 Thursday 37
## 6 Tuesday 37
## 7 Saturday 29The most return clients had massages on Wednesday, currently my schedule doesn’t allow Wednesday afternoons or evenings, and next best day for returns is Friday. But same problem. And same for Mondays too. Those are the top biggest return days of the week. So, right now Thursday is best afteroon day and then Sunday, Tuesday, and Saturday to make promotional media for those days only or combination of those days.
Lets plot the best day of the week for client returns.
ggplot(summT, aes(x = DayOfWeekService, y = totalReturns)) +
geom_bar(stat = "identity", fill = "aquamarine") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "Total Returns per Day of Week",
x = "Return Clients per Day of Week",
y = "Total Returns Per Day of Week") +
theme_minimal()
Now lets see the new client or first service appointment by day of the week and compare when new clients prefer a massage.
summary_tbl <- Data %>% group_by(DayOfWeekService) %>% summarise(totalNewClients=sum(newReturn=="new", na.rm=TRUE))
summT <- summary_tbl[order(summary_tbl$totalNewClients, decreasing=T)[1:7],]
summT## # A tibble: 7 × 2
## DayOfWeekService totalNewClients
## <fct> <int>
## 1 Monday 28
## 2 Sunday 28
## 3 Saturday 26
## 4 Friday 19
## 5 Wednesday 18
## 6 Tuesday 14
## 7 Thursday 12Sunday seems to be the highest rate of new clients receiving their first massage with this company, then next highest rate of new clients are on Monday, then Saturday, Friday, Wednesday, Tuesday, and least on Thursday.
Lets plot the new clients per day of the week.
ggplot(summT, aes(x = DayOfWeekService, y = totalNewClients)) +
geom_bar(stat = "identity", fill = "aquamarine") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "Total New Clients per Day of Week",
x = "New Clients per Day of Week",
y = "Total New Clients Per Day of Week") +
theme_minimal()
Thursday seems like a good day to promote to the audiences interested in
mobile massage by offering a discount on that day for new and returning
clients.
Also, a category for AM and PM to see the number of transactions per time of day.
Data$StartTime <- as.factor(Data$StartTime)
start <- Data %>% group_by(StartTime) %>% count(StartTime)
Start <- start[order(start$n, decreasing=T),]
summT <- Start[1:10,]
summT## # A tibble: 10 × 2
## # Groups: StartTime [10]
## StartTime n
## <fct> <int>
## 1 7:00 PM 60
## 2 6:00 PM 37
## 3 5:00 PM 32
## 4 12:00 PM 31
## 5 5:30 PM 29
## 6 10:00 AM 23
## 7 8:00 PM 21
## 8 9:00 AM 20
## 9 11:00 AM 18
## 10 3:00 PM 18The most transactions have a start time at 7 pm and then 6 pm, 5pm, noon or 12 pm, 5:30 pm, 8 pm, 10 am, 6:30 pm, 9 am, and then 11 am. Lets plot this
ggplot(summT, aes(x = StartTime, y = n)) +
geom_bar(stat = "identity", fill = "aquamarine") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "The Most Appointments per Time of Day",
x = "Most Appointments by Time of Day",
y = "Total Appointment per Time of Day") +
theme_minimal()
Data$AM_PM <- "ampm"
am <- grep('AM',Data$StartTime)
pm <- grep("PM", Data$StartTime)
Data$AM_PM[am] <- "AM"
Data$AM_PM[pm] <- "PM"
Data$AM_PM <- gsub('ampm','AM', Data$AM_PM)# one entry missing an AM so found it and it was 11, no
#appointments after 10 pm.
Data$AM_PM <- as.factor(Data$AM_PM)
summary(Data$AM_PM)## AM PM
## 81 407summaryt <- Data %>% group_by(AM_PM) %>% summarise(returned=sum(returned=='yes'),na.rm=T)
Start <- summaryt[order(summaryt$AM_PM, decreasing=T),]ggplot(Start, aes(x = AM_PM, y = returned)) +
geom_bar(stat = "identity", fill = "forestgreen") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "The Most Appointments AM or PM",
x = "Most Appointments by AM or PM of Day",
y = "Total Appointment per AM or PM of Day") +
theme_minimal()
Clearly, there are more appointments in the PM with more prefering 7 pm
and between 5-9 pm. This is influenced entirely by availability of
service provider. Almost 20% of the massages occurred in the am or
morning.
And see the amount of returns on preference for lotion or oil and most earnings.
start <- Data %>% group_by(lotionOrOilPreference) %>% count(returned)
Start <- start[order(start$n, decreasing=T),]
summT <- Start[1:10,]
summT## # A tibble: 10 × 3
## # Groups: lotionOrOilPreference [4]
## lotionOrOilPreference returned n
## <fct> <fct> <int>
## 1 lotion or oil, no preference yes 217
## 2 oil yes 114
## 3 lotion or oil, no preference no 85
## 4 oil no 32
## 5 <NA> no 19
## 6 <NA> yes 15
## 7 lotion no 6
## 8 <NA> <NA> NA
## 9 <NA> <NA> NA
## 10 <NA> <NA> NAThe preference shows those that returned and didn’t for additional massage, and most that preferred either lotion or oil, or only oil returned, while only 6 filled out the optional question that they only want lotion used and they didn’t return. Lotion and oil were both available and used by preference. There are NAs for preferred lotion or oil type that have yes and no values, which is odd.
ggplot(summT, aes(x = lotionOrOilPreference, y = returned)) +
geom_bar(stat = "identity", fill = "tan") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "The Returns for Service by Oil or Lotion Preference",
x = "Return for Massage by Oil or Lotion Preference",
y = "Number Of Clients that Returned for Massage or Not") +
theme_minimal()
Many people didn’t fill out this optional question on survey data and is
why there is an NA value that is very high. The above chart breaks down
the groups by oil or lotion preference that returned or had another
massage or didn’t. It also included the NA values, so we will run it
with removal of the No on returned and remove the NA values.
start <- Data %>% group_by(lotionOrOilPreference) %>% summarise(returned =sum(returned=="yes", na.rm=T))
Start <- start[order(start$returned, decreasing=T),]
summT <- Start[1:10,]
summT## # A tibble: 10 × 2
## lotionOrOilPreference returned
## <fct> <int>
## 1 lotion or oil, no preference 217
## 2 oil 114
## 3 <NA> 15
## 4 lotion 0
## 5 <NA> NA
## 6 <NA> NA
## 7 <NA> NA
## 8 <NA> NA
## 9 <NA> NA
## 10 <NA> NAThe top preference for lotion or oil is more clear on which clients return for another mobile massage. Those that have no preference for either or strictly oil.
Lets see the plot for this.
ggplot(summT, aes(x = lotionOrOilPreference, y = returned)) +
geom_bar(stat = "identity", fill = "tan") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "The Returns for Service by Oil or Lotion Preference",
x = "Return for Massage by Oil or Lotion Preference",
y = "Number Of Clients that Returned for Massage") +
theme_minimal()## Warning: Removed 6 rows containing missing values or values outside the scale range
## (`geom_bar()`).
When we look at the preference for lotion or oil in their massage, most people had no preference for lotion or oil at 217 returns for service, while the next best was oil preferred with 114 that returned for service. There were 8 who had no preference for oil or lotion that did not return, and 32 oil that didn’t return and all of the clients that preferred lotion only did not return making 6 clients that preferred lotion but did not return for an additional massage after the first massage. Lotion was used that is massage lotion purchased on Amazon and similar to Biotone product. The oil was at time Grape seed oil as no smell and hypoallergenic or bought also as non scented massage oil by gallon on Amazon.com.
And also, preference by talking allowed or not, lets see those that returned for service by preference of talking or not during massage preferred.
start <- Data %>% group_by(talkingDuringMassageOK_isYes_or_Not_isNo, na.rm=T) %>% count(talkingDuringMassageOK_isYes_or_Not_isNo, na.rm=T)
Start <- start[order(start$talkingDuringMassageOK_isYes_or_Not_isNo, decreasing=T),]
summT <- Start[1:10,]
summT## # A tibble: 10 × 3
## # Groups: talkingDuringMassageOK_isYes_or_Not_isNo, na.rm [5]
## talkingDuringMassageOK_isYes_or_Not_isNo na.rm n
## <fct> <lgl> <int>
## 1 yes, but only about answering questions I ask about the techniqu… TRUE 50
## 2 yes TRUE 40
## 3 no TRUE 9
## 4 <NA> TRUE 389
## 5 <NA> NA NA
## 6 <NA> NA NA
## 7 <NA> NA NA
## 8 <NA> NA NA
## 9 <NA> NA NA
## 10 <NA> NA NAAlter the tibble just to plot less verbage on axis. It won’t affect the main source.
summT$talkingDuringMassageOK_isYes_or_Not_isNo <- as.factor(c('yes if needed','yes','no',NA,NA,NA,NA,NA,NA,NA))
summT## # A tibble: 10 × 3
## # Groups: talkingDuringMassageOK_isYes_or_Not_isNo, na.rm [5]
## talkingDuringMassageOK_isYes_or_Not_isNo na.rm n
## <fct> <lgl> <int>
## 1 yes if needed TRUE 50
## 2 yes TRUE 40
## 3 no TRUE 9
## 4 <NA> TRUE 389
## 5 <NA> NA NA
## 6 <NA> NA NA
## 7 <NA> NA NA
## 8 <NA> NA NA
## 9 <NA> NA NA
## 10 <NA> NA NAMore folk preferred talking only if about what is objectively found during massage involving musculoskeletal tissue complaints and advice or recommendations or adjusting pressure, sound, etc.
Lets see the plot for this.
ggplot(summT, aes(x = talkingDuringMassageOK_isYes_or_Not_isNo, y = n)) +
geom_bar(stat = "identity", fill = "red") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "The Returns for Service Talking Preference",
x = "Return for Massage by Talking Preference",
y = "Number Of Clients that Returned for Massage") +
theme_minimal()## Warning: Removed 6 rows containing missing values or values outside the scale range
## (`geom_bar()`).
The NA values get removed in the table but not the plot as shown above
but most people are ok with minimal talking during a massage or talking
at all than none. While many in the NA column show how many didn’t
answer that optional question on the survey.
Lets also look at how many people want a massage by stress scaled rating, pain scale rating, and sleep scaled rating.
start <- Data %>% group_by(stress1none_10extremely) %>% summarise(returned=sum(returned=='yes', na.rm=T))
Start <- start[order(start$returned, decreasing=T),]
summT <- Start[1:10,]
summT## # A tibble: 10 × 2
## stress1none_10extremely returned
## <fct> <int>
## 1 5 104
## 2 8 49
## 3 6 45
## 4 1 44
## 5 3 21
## 6 9 21
## 7 4 20
## 8 10 17
## 9 7 15
## 10 2 8In scaled ratings of stress, those number of returns for additional massage were highest for those who scaled stress as a 5 out 10 on a scale of 1 to 10 for most stress at level 10. The next best category was level 1 for no or very little stress as the most returned clientele.
Lets plot this.
ggplot(summT, aes(x = stress1none_10extremely, y = returned)) +
geom_bar(stat = "identity", fill = "gray") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "The Returns for Service by Stress Scaled Rating 1 minimal and 10 worst",
x = "Return for Massage by self-rated stress rating",
y = "Number Of Clients that Returned for Massage") +
theme_minimal()
Looks like the NA values were dropped, but these scaled ratings were all
optional with 1 the least to 10 the worst except for sleep that was 1
the worst and 10 the best.
pain scale rating by returns,
start <- Data %>% group_by(painScale1least_10worst, na.rm=T) %>% summarize(returned = sum(returned=='yes', na.rm=T))## `summarise()` has grouped output by 'painScale1least_10worst'. You can override
## using the `.groups` argument.Start <- start[order(start$returned, decreasing=T),]
summT <- Start[1:10,]
summT## # A tibble: 10 × 3
## # Groups: painScale1least_10worst [10]
## painScale1least_10worst na.rm returned
## <fct> <lgl> <int>
## 1 6 TRUE 117
## 2 1 TRUE 62
## 3 4 TRUE 35
## 4 7 TRUE 35
## 5 9 TRUE 26
## 6 5 TRUE 24
## 7 3 TRUE 18
## 8 <NA> TRUE 15
## 9 2 TRUE 11
## 10 8 TRUE 3The self rated pain scale on scale of 1-10 with 1 minimal to no pain and 10 the worst pain ever is shown by those who returned for massage. When the pain scale was a 6 mid range pain there were more clients that returned for another massage, and next best was minimal to no pain that returned for a massage. When the highest rating of 9/10 was selected, there were quite a bit that returned for massage.
Lets plot this pain scale rating on client return.
ggplot(summT, aes(x = painScale1least_10worst, y = returned)) +
geom_bar(stat = "identity", fill = "yellow") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "The Returns for Service by Pain Scale Self Rated 1-10 with 10 Worst",
x = "Return for Massage by self rated pain scale",
y = "Number Of Clients that Returned for Massage") +
theme_minimal()
Many new clients in the middle pain range returned for massage and those
with no to little pain as well. This was an optional survey question so
there were some NA values from not being filled in.
and sleep scaled rating.
start <- Data %>% group_by(sleep1poor_10BestEver, na.rm=T) %>% summarise(returned = sum(returned=='yes'), na.rm=T)## `summarise()` has grouped output by 'sleep1poor_10BestEver'. You can override
## using the `.groups` argument.Start <- start[order(start$returned, decreasing=T),]
summT <- Start[1:10,]
summT## # A tibble: 10 × 3
## # Groups: sleep1poor_10BestEver [10]
## sleep1poor_10BestEver na.rm returned
## <fct> <lgl> <int>
## 1 6 TRUE 112
## 2 8 TRUE 91
## 3 5 TRUE 44
## 4 10 TRUE 39
## 5 4 TRUE 26
## 6 7 TRUE 19
## 7 9 TRUE 8
## 8 1 TRUE 5
## 9 <NA> TRUE 2
## 10 2 TRUE 0More people that filled out this optional survey data rated their sleep on a scale of 1 the best and 10 the worst for adequate sleep they have a 6 with 113 of those clients returning, and higher values of not as good quality of sleep had higher returns for massage.
Lets plot that data on the sleep scaled self rating and how many clients returned for more massage based on their view on sleep they are getting at the time they filled out their consent forms.
ggplot(summT, aes(x = sleep1poor_10BestEver, y = returned)) +
geom_bar(stat = "identity", fill = "magenta") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "The Returns for Service by sleep scale of 1 the best and 10 the worst quality of sleep",
x = "Return for Massage by self rated Sleep rating at initial appointment",
y = "Number Of Clients that Returned for Massage") +
theme_minimal()
Those folks that initially started with a self rated and scaled rating
of sleep quality as 1 the best and 10 the worst are plotted abvoe Those
without the best but almost the worst amount of sleep overall returned
the most for massage.
Lets recap these client returns from this market for this provider. When sleep was less than adequate to not very good, the pain was mid range to no pain, and stress was middle to no stress, the clients returned the most for massage after their initial massage from consent form survey data that was optional. There were also more client returns when they did not prefer oil or lotion over the other or strictly preferred oil. The few that strictly preferred lotion did not return for another mobile massage service.
When those who answered the question about talking during session or not or only if necessary to gauge client response to pressure, noise, comfort, advice, etc., more clients returned that preferred only talking if necessary, and then those that selected yes or ok to talking, while many people did not answer that question and some returned that answered no to talking during session.
More new clients were seen on Sunday and more returns of clients for massage on Wednesday. This is influenced by provider’s other job that prevented evenings or mornings on some days.
Most massages were done in the evening at 7 pm while 5-9 pm were hours most massages done. This data is useful as it can be used with the other information sythesized from this analysis of massage in the mobile network fit for this provider and syncing her preferences and standards with the clients she provides service for.
So far with this information, marketing can be generated for boosting the slow days by offering bundled packages or getting those who are more likely to return by their initial pain, stress, and sleep self rated score from survey data. offering incentives to those clients that see improvements in their self-rated scores of general wellness factors like sleep, pain, and stress to get on a bundled package to save money and invest in health with massage weekly, monthly, biweekly, and so on.
We saw that many people that returned rated their pain as mid level around a 6 and same for stress, where their stress is manageable and they have time for themselves in the day or week or month to get a massage, or if they had no pain and/or no stress then more likely to invest in their wellness with regular massage.
What about returns on health conditions? Lets find out the categories. This was optional survey data that could have been preselected options to read through like most in the survey data or a text input box to describe health condition.
start <- Data %>% group_by(healthConditionsPrecautions) %>% summarise(returned = sum(returned=='yes'), na.rm=T)
Start <- start[order(start$returned, decreasing=T),]
summT <- Start[1:10,1:2]
summT## # A tibble: 10 × 2
## healthConditionsPrecautions returned
## <fct> <int>
## 1 <NA> 147
## 2 "High or Low Blood Pressure\nknee replacement" 70
## 3 "Skin Abrasions" 19
## 4 "Ticklish feet or other areas of body\nCold hands and feet" 13
## 5 "Eczema and Psoriasis" 11
## 6 "High or Low Blood Pressure" 9
## 7 "recent abdominal surgery (post natal, tummy tuck, hysterectomy, et… 9
## 8 "Recent Surgeries (limbs, neck, low back, shoulders, etc.)" 9
## 9 "Bruise easily\nFibromyalgia\nIrritable Bowel Syndrom (IBS)" 8
## 10 "recent abdominal surgery (post natal, tummy tuck, hysterectomy, et… 6Lets alter these tibble names too just to plot them without crowding the x-axis.
summT$healthConditionsPrecautions <- as.factor(c(NA,'BP/kneSrg','cuts','cold H/F','psor/ecz',"BP","abdBodySrg",'bodySrg','Auto','abSrg'))
summT$healthConditionsPrecautions## [1] <NA> BP/kneSrg cuts cold H/F psor/ecz BP
## [7] abdBodySrg bodySrg Auto abSrg
## 9 Levels: abdBodySrg abSrg Auto bodySrg BP BP/kneSrg cold H/F ... psor/eczThe top health conditions for client return from those who answered survey data and could select multiple conditions if they had the condition, showed high or low blood pressure as the highest return, recent surgery, autoimmune disorder, RA, bruise easily or circulatory problems with cold hands and feet as well as ticklish feet. With more than 10 returns in the top 5 listed health precautions. That they returned to have massage regularly shows that massage helped with their management of the condition or didn’t interfere with the condition or helped them lessen their symptoms or side effects, or other possible inferences that can be made. But people don’t return for massage regularly unless they benefit from it due to the cost and communication to customize massage. I will plot this but the x-axis will be dark and you will have to use the table above to see the differences in health conditions and return for more massages. These conditions are comorbidities as a class.
ggplot(summT, aes(x = healthConditionsPrecautions, y = returned)) +
geom_bar(stat = "identity", fill = "purple") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "The Top 10 Returns for Massage by health condition",
x = "Return for Massage by optional health condition selected from list",
y = "Number Of Clients that Returned for Massage") +
theme_minimal()
The very tall bar is the top selected health precaution as it at the
level of 150 returns for those folks returnign with those health
precautions. The next highest return rate for massage are from those
with cold hands and feet or bruise easily with 70 returns, and next
highest return for health precaution is skin abrasion (avoided as
precaution) at 29 returns.
The prices changed from the start of the company in 2019 to the time schedule started being minimal and availability was scarce to take a massage request or appointment and cost of living as well. Some clients due to these life changes I had to make, never booked another massage appointment. It may be other factors as well like moving out of the boundaries this mobile massage business serves, or health as scenarios, but anything could cause this. It could also be avoided by staying in contact or engaged in the client’s health and wellness with massage and keeping them on their massage routine to help manage their stress, healing ability, sleep, hydration, stretching, exercise motivation, healthy diet, and regular massages. These are components to a healthy lifestyle and good quality of life.
So, lets look at the data for time past by weeks that passed since last service for return rate.
start <- Data %>% group_by(weeksPassedBetweenServices) %>% summarise(returned = sum(returned=='yes'), na.rm=T)
Start <- start[order(start$returned, decreasing=T),]
summT <- Start[1:50,1:2]
summT## # A tibble: 50 × 2
## weeksPassedBetweenServices returned
## <int> <int>
## 1 1 110
## 2 0 106
## 3 2 19
## 4 4 15
## 5 7 10
## 6 3 9
## 7 5 6
## 8 8 6
## 9 6 5
## 10 10 5
## # ℹ 40 more rows#write.csv(Data, 'incomeConsentMergeMay2019-Jan7-2026.csv', row.names=F)ggplot(Start, aes(x = weeksPassedBetweenServices, y = returned)) +
geom_bar(stat = "identity", fill = "pink") +
theme(
axis.text.x = element_text(
angle = 90, # Rotate text 90 degrees
)) +
labs(title = "The Returns of Clients by Weeks Since Last Massage",
x = "Client Returns for Massage by Weeks Passed Since Last Massage",
y = "Number Of Clients that Returned for Massage") +
theme_minimal()
Between each service from last date of massage to the date of next massage appointment, more people returned every 2 weeks, 114 appointments returned every week, 24 appointments were returns every 3 weeks, and so on from the table above, but there is not a specific time frame that weeks can pass between massages as some wait 8 weeks, others still received a massage again after 41 weeks since their last massage. But some people in middle weeks of 23, 25, or 28 didn’t return for a massage again. The variable returned by the end of the print out of that total data and returned was put as a no if that was their last massage. After 41 weeks there are no return clients for massage, but maybe marketing to them directly can bring them back.
Great. That concludes the analysis of the information gathering for developing a marketing strategy from insights gained such as reaching those folks who have not received a massage for weeks but not more than 41 weeks or about 9 months unless through personalized outreach like direct messaging or email or mailed gift cards and coupons. Also, within the Corona area, likes medium to firm pressure, pays with credit card or Zelle, prefers oil or has no preference, has blood pressure or skin or autoimmune or circulation health precautions, gets massages on Wednesdays for highest return clientele or Sundays for new clients, in a young middle aged to middle middle aged range, has a moderate pain and stress and sleep self rating on survey data or no pain and no stress to above moderate pain levels, an doesn’t mind talking in session but no talking is a close runner up for return rates, likes the one hour or 90 minute massages or monthly massages, as well as other very helpful information to make inferences on to turn this massage gig into a massage biz.
Thanks for reading. If you would like to consult with me to evaluate and analyze your data for your company or business, contact me at contact information for www.themassagenegotiator.com