beer_analysis.Rmd

---
title: "Prediction of beer consumption in Sao Paulo Brazil"
output: html_document
  
    
runtime: shiny
---
<p>The data (sample) was collected in São Paulo-Brazil The dataset used for this activity has 7 attributes/features. The data is recorded for a  period of one year.</p>

<p>The goal is to determine what factors contribute to beer consumption and use an appropriate Machine learning model to predict the consumption of beer(litres per 1000 people).</p>


<h5><b>Loading required libraries:</b></h5>
```{r message=FALSE, warning=FALSE}
library(dplyr)
library(ggplot2)
library(readr)
library(caret)
library(stringr)
library(purrr)
library(lubridate)
library(corrplot)
library(caretEnsemble)
library(shiny)
library(knitr)
library(e1071)
library(randomForest)
library(elasticnet)
library(boot)
library(forcats)
library(shinythemes)
library(kableExtra)
```





<h4><b>Importing the data using the readr library.</b></h4>
<p>In the raw data commas are used as decimal points. readr reads the temperature data as integers and  ignores the commas(23,2 degrees becomes 232 degrees) so we import the numeric values as characters and will  convert them later on , replacing the commas with a decimal point</p>
```{r}
beerdata<-read_csv('Consumo_cerveja.csv',col_types = cols(
  
  `Temperatura Media (C)` = col_character(),
  `Temperatura Minima (C)` = col_character(),
  `Temperatura Maxima (C)` = col_character(),
  `Precipitacao (mm)` = col_character(),
  `Final de Semana` = col_character()
))
```




```{r}
str(beerdata)
```
<h5><b>Converting the column names  from Portuguese to English</b> </h5>
```{r}
colnames(beerdata)<- c('date','mean_temp','min_temp','max_temp','rainfall','endofweek','beerconsumption')
```


```{r}
head(beerdata)
```


<h5><b>Trimming the dataset to include only the first 365 rows
as the data only pertains to one year and the remainig values are NULL.</b></h5>
```{r}
beerdata<-beerdata[ 1:365,]
tail(beerdata)
```


<h5><b>Replacing commas with decimal points</b></h5>
```{r}
removecomma <- function(x){ 
x<-str_replace(x,',','.') 
return(x) 
}

```

```{r}
beerdata$min_temp<-beerdata$min_temp%>%map_chr(removecomma)
beerdata$max_temp<-beerdata$max_temp%>%map_chr(removecomma)
beerdata$mean_temp<-beerdata$mean_temp%>%map_chr(removecomma)
beerdata$rainfall<-beerdata$rainfall%>%map_chr(removecomma)

```

```{r}
for(i in 2:5){
  beerdata[[i]]<-as.double(beerdata[[i]])
}
```


<h5><b>Checking for NULL values</b></h5>

```{r}
sum(is.na(beerdata))
```
<h5><b> FINAL DATA:</b></h5>
```{r}
head(beerdata)%>%kbl()%>%kable_material_dark(c('striped','hover'))
```

<h5> <b>There is higher consumption of beer on weekends</b></h5>
```{r echo=TRUE}
ggplot(data=beerdata,aes(x=endofweek,y=beerconsumption))+geom_boxplot(aes(fill=endofweek))+

scale_fill_brewer(type='div',palette = 4)+theme_minimal()
  
```

```{r,secho=FALSE}
beerdata[[6]]<-as.double(beerdata[[6]])
```

<h5><b>Adding day of week as a new column</b></h5>
```{r}
beerdata<-beerdata%>%mutate(dayofweek=wday(beerdata$date,label = TRUE))
```

<h5><b>There is a marked increase in beer consumtion on SATUDRAY
and SUNDAY</b></h5> 

<img src="https://github.com/savio0694/SAO-PAULO-BEERCONSUMPITON-with-R/blob/main/IMAGE/1.JPG?raw=true">
```{r eval=FALSE, include=FALSE}
ggplot(data=beerdata,aes(x=dayofweek,y=beerconsumption))+geom_boxplot(aes(fill=dayofweek))+

scale_fill_brewer(palette = 'Spectral')+theme_bw()
```
<h5> <b>There seems to be a positive relationship between temperature and beer consumption fo evey day of the week. A linear model is likely to perform well if temperature is indeed an important feature.</b></h5>
```{r}
ggplot(data=beerdata,aes(x=mean_temp,y=beerconsumption))+geom_point(aes(color=mean_temp))+
  geom_smooth()+facet_wrap(~dayofweek)+scale_color_gradient(low="yellow", high="red")



```
<h5> <b>Since most days of the year in So Paulo have little o no rainfall,it is hard to infer any relationship between rainfall and beer consumption </b></h5> 
```{r eval=FALSE, include=FALSE}
ggplot(data=beerdata,aes(x=rainfall,y=beerconsumption))+geom_point(aes(color=rainfall))+
scale_color_gradient(low="#00a3cc", high="#002d39")
```

<h5><b>Adding the month to the data we notice that the consumption of beer dips towards the middle of the year but not by much</b></h5>
```{r}
beerdata%>%mutate(monthofyear=month(date,label = TRUE))%>%group_by(monthofyear)%>%summarise(avg_beer_consumption=mean(beerconsumption))%>%ggplot(aes(x=monthofyear,y=avg_beer_consumption,fill=avg_beer_consumption))+geom_bar(stat = 'identity')
```

<h5><b> None of the features are too correlated with beer consumtion.</b></h5>
```{r}
correlation<-cor(beerdata%>%select(-c(date,endofweek,dayofweek)))
corrplot(correlation, method="number")

```


<h4><b>Finding important features using a random forest model</b></h4>
```{r echo=TRUE}
control <- trainControl(method="repeatedcv", number=5, repeats=3)

model <- train(beerconsumption~., data=beerdata%>%select(-c(date,dayofweek)), method="rf", preProcess="scale", trControl=control)
importance <- varImp(model, scale=FALSE)

print(importance)

plot(importance)
```

<h5><b>Since the goal is prediction and not inference we include more than one temperature feature even though they are correlated. Choosing the temperature variables and end-of-week as the final features and split the data into test and train datasets</b></h5>
```{r}
beerdata<-beerdata%>%select(max_temp,endofweek,min_temp,mean_temp,beerconsumption)

trainIndex <- createDataPartition(beerdata$beerconsumption, p = .8, 
                                  list = FALSE, 
                                  times = 1)

Train <- beerdata[ trainIndex,]
Test  <- beerdata[-trainIndex,]

head(Test)
```

<h5><b>Running 5 fold cross validation on five different models</b></h5>
<ul>
<li>linear regression</li>
<li>LASSO</li>
<li>RIDGE</li>
<li>Random Forest</li>
<li>K neares neighbours</li>
</ul>
```{r include=FALSE}
fitControl <- trainControl(method = "cv",   number = 5,
                           savePredictions = 'final',allowParallel = TRUE)

models<-caretList(beerconsumption ~., data = Train,methodList =  c("lm","lasso","ridge","knn"),
             preProcess=c('center','scale'),
             trControl = fitControl)


```



<h5> <b>Linear regression and Ridge models provided the lowest root mean squared error overall</b></h5>
```{r}
model_results <- data.frame(
 LM = mean(models$lm$results$RMSE),
 KNN = mean(models$knn$results$RMSE),
 RF = mean(models$rf$results$RMSE),
 LASSO = mean(models$lasso$results$RMSE),
 RIDGE = mean(models$ridge$results$RMSE)
 )
print(model_results)
```


<h5> <b>The code for the below dashboard has been hidden for the sake of brevity,please refer the markdown document on my gihub for all the code.</b></h5>

<h5> <b>Please reload the webpage if the dashboard doesnt load.</b></h5>
```{r echo=FALSE}

shinyApp(
ui <- fluidPage(theme = shinytheme("superhero"),

   
    titlePanel("PREDICTION OF BEER CONSUMPTINON"),
    
    
    
    sidebarLayout(
        sidebarPanel(
            sliderInput("MEAN_TEMP",
                        "Mean temperature:",
                        min = 0,
                        max = 30,
                        value = 30),
        
        
        
          
                sliderInput("MAX_TEMP",
                            "Maximum temperature:",
                            min = 0,
                            max = 36,
                            value = 30),
            
    
    
    
        radioButtons("WEEKEND", h3("WEEKEND?"),
                     choices = list(yes = 1, no = 0
                                    )
    )),

        
        mainPanel(
          h2("PREDICTED VALUE :"),h1(textOutput("TEMP"))
        ))
   
    
    
),


server <- function(input, output) {
    beer_dashboard<-beerdata%>%select(max_temp,endofweek,mean_temp,beerconsumption)
    trainIndex <- createDataPartition(beer_dashboard$beerconsumption, p = .8, 
                                      list = FALSE, 
                                      times = 1)
    
    Train <- beer_dashboard[ trainIndex,]
    Test  <- beer_dashboard[-trainIndex,]
    fitControl <- trainControl(method = "cv",   number = 5,
                             )
    model<-train(beerconsumption~., data = Train,method = "lasso",trControl = fitControl)
    
    
    
    
    output$TEMP <- renderText({
df <- data.frame(max_temp=input$MAX_TEMP,endofweek=as.double(input$WEEKEND),mean_temp=input$MEAN_TEMP)
        predicted<-predict(model,df)
        paste(round(predicted))
        })
}

)
```