The following uses the diamonds dataset from the GGPLOT2 library

library(ggplot2)
mydiamonds <- diamonds

You can paste in a new “code chunk” by pressing CTRL- ALT - I so for each question listed below, put in a new code chunk to answer that question. Knit your notebook to Word and submit the word document on blackboard.

#Knowing my data```

summary(mydiamonds)
     carat               cut        color        clarity     
 Min.   :0.2000   Fair     : 1610   D: 6775   SI1    :13065  
 1st Qu.:0.4000   Good     : 4906   E: 9797   VS2    :12258  
 Median :0.7000   Very Good:12082   F: 9542   SI2    : 9194  
 Mean   :0.7979   Premium  :13791   G:11292   VS1    : 8171  
 3rd Qu.:1.0400   Ideal    :21551   H: 8304   VVS2   : 5066  
 Max.   :5.0100                     I: 5422   VVS1   : 3655  
                                    J: 2808   (Other): 2531  
     depth           table           price             x         
 Min.   :43.00   Min.   :43.00   Min.   :  326   Min.   : 0.000  
 1st Qu.:61.00   1st Qu.:56.00   1st Qu.:  950   1st Qu.: 4.710  
 Median :61.80   Median :57.00   Median : 2401   Median : 5.700  
 Mean   :61.75   Mean   :57.46   Mean   : 3933   Mean   : 5.731  
 3rd Qu.:62.50   3rd Qu.:59.00   3rd Qu.: 5324   3rd Qu.: 6.540  
 Max.   :79.00   Max.   :95.00   Max.   :18823   Max.   :10.740  
                                                                 
       y                z         
 Min.   : 0.000   Min.   : 0.000  
 1st Qu.: 4.720   1st Qu.: 2.910  
 Median : 5.710   Median : 3.530  
 Mean   : 5.735   Mean   : 3.539  
 3rd Qu.: 6.540   3rd Qu.: 4.040  
 Max.   :58.900   Max.   :31.800  
                                  
str(mydiamonds)
tibble [53,940 x 10] (S3: tbl_df/tbl/data.frame)
 $ carat  : num [1:53940] 0.23 0.21 0.23 0.29 0.31 0.24 0.24 0.26 0.22 0.23 ...
 $ cut    : Ord.factor w/ 5 levels "Fair"<"Good"<..: 5 4 2 4 2 3 3 3 1 3 ...
 $ color  : Ord.factor w/ 7 levels "D"<"E"<"F"<"G"<..: 2 2 2 6 7 7 6 5 2 5 ...
 $ clarity: Ord.factor w/ 8 levels "I1"<"SI2"<"SI1"<..: 2 3 5 4 2 6 7 3 4 5 ...
 $ depth  : num [1:53940] 61.5 59.8 56.9 62.4 63.3 62.8 62.3 61.9 65.1 59.4 ...
 $ table  : num [1:53940] 55 61 65 58 58 57 57 55 61 61 ...
 $ price  : int [1:53940] 326 326 327 334 335 336 336 337 337 338 ...
 $ x      : num [1:53940] 3.95 3.89 4.05 4.2 4.34 3.94 3.95 4.07 3.87 4 ...
 $ y      : num [1:53940] 3.98 3.84 4.07 4.23 4.35 3.96 3.98 4.11 3.78 4.05 ...
 $ z      : num [1:53940] 2.43 2.31 2.31 2.63 2.75 2.48 2.47 2.53 2.49 2.39 ...
head(mydiamonds)
tail(mydiamonds)
table(mydiamonds$cut)

     Fair      Good Very Good   Premium     Ideal 
     1610      4906     12082     13791     21551 
par(mfrow=c(1,1))

plot(mydiamonds$color)

ggplot(data = mydiamonds, aes(x = price, y = carat, color = cut)) + geom_point()

How many records are in the dataset?

nrow(mydiamonds)
[1] 53940
NROW(mydiamonds)
[1] 53940

What is the largest diamond by weight (carat)?

max(mydiamonds$carat)
[1] 5.01

Most and least expensive?

most_expensive <- max(mydiamonds$price)
print(most_expensive)
[1] 18823
least_expensive <- min(mydiamonds$price)
print(least_expensive)
[1] 326

Plot a bar chart of count of diamonds vs cut.

ggplot(data = mydiamonds, aes(x = cut)) + geom_bar()

Let’s explore the data a bit. What attributes does the most expensive diamond have? Change max(price) to min(price) to see the least expensive.

subset(mydiamonds, price == max(price))
subset(mydiamonds, price == min(price))

Create a plot of carat vs price.

ggplot(data = mydiamonds, aes(x = carat, y = price, color = "red")) + geom_point(alpha = 0.8)

Does it look like carat and price have a linear relationship?

#Answer: From the graphs, it is clear that the relationship between the two variables (Carat and Price) is non-linear: As shown, as the carat size increases, the price also increases. As such, this could be exponential. Also, the variance of the relationship increases as carat size increases. There are also apparent discrete values that carat size takes on, vertical strips on the graph. Moreover, the linear trend line does not go through the center of the data at some key places.
ggplot(aes(x=carat, y=price), data=diamonds) +
  geom_point(fill=I("#F79420"), color=I("red"), shape=21) +
  stat_smooth(method="lm") +
 scale_x_continuous(lim = c(0, quantile(diamonds$carat, 0.99)) ) +
  scale_y_continuous(lim = c(0, quantile(diamonds$price, 0.99)) ) +
  ggtitle("Relationship Between Price vs. Carat") + xlab("CARAT") + ylab("PRICE")

ggplot(data = mydiamonds, aes(x = carat, y = price)) + geom_point(alpha = 0.6) +  stat_smooth(method = "lm", color = "blue")

ggplot(data = mydiamonds, aes(x = carat, y = price)) + geom_line() +  geom_smooth(method = "lm", color = "green")

ggplot(data = mydiamonds, aes(x = carat, y = price)) + geom_point() + coord_fixed() +  scale_x_log10() +  scale_y_log10() +  geom_smooth(method = "lm", color = "green") + xlab('CARAT INCH') + ylab('PRICE INCH')

Create three other plots of other variables vs price. The point of exploratory analysis (know your data) is to do just that, explore. You might have to plot more than three to find variables that plot correctly. Please realize too that scatter plots (or line) are for continuous variables and not for categorical variables. See the ggplot2 intro for references. Please try to pick three variables that you think have a strong influence in the price of the diamond. The main point for this is to make a model later on.

ggplot(data=diamonds) + geom_histogram(binwidth=500, aes(x=price)) + ggtitle("Diamond Price Distribution") + xlab("Diamond Price U$ - Binwidth 500") + ylab("Frequency") + theme_minimal()

ggplot(data = diamonds) + aes(x = price, color = cut) + geom_bar() + ylab("Frequency") + xlab("Diamon Price U$")

ggplot(data = mydiamonds) + aes(x=cut,y=price, color=cut) +
  geom_boxplot() + ggtitle("Relationship of Price and Cut") + xlab("Cut") + ylab("Price")

  ggplot(data = mydiamonds) + aes(x=(price)) +
  geom_histogram(stat="bin",binwidth= 500) +
  facet_wrap(~cut, scales = "free")

LS0tDQp0aXRsZTogIkJJUzU4MSINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQpUaGUgZm9sbG93aW5nIHVzZXMgdGhlIGRpYW1vbmRzIGRhdGFzZXQgZnJvbSB0aGUgR0dQTE9UMiBsaWJyYXJ5IA0KDQpgYGB7cn0NCmxpYnJhcnkoZ2dwbG90MikNCm15ZGlhbW9uZHMgPC0gZGlhbW9uZHMNCmBgYA0KDQpZb3UgY2FuIHBhc3RlIGluIGEgbmV3ICJjb2RlIGNodW5rIiBieSBwcmVzc2luZyBDVFJMLSBBTFQgLSBJDQpzbyBmb3IgZWFjaCBxdWVzdGlvbiBsaXN0ZWQgYmVsb3csIHB1dCBpbiBhIG5ldyBjb2RlIGNodW5rIHRvIGFuc3dlciB0aGF0IHF1ZXN0aW9uLg0KS25pdCB5b3VyIG5vdGVib29rIHRvIFdvcmQgYW5kIHN1Ym1pdCB0aGUgd29yZCBkb2N1bWVudCBvbiBibGFja2JvYXJkLg0KDQoNCmBgYHtyfQ0KI0tub3dpbmcgbXkgZGF0YWBgYA0KDQpzdW1tYXJ5KG15ZGlhbW9uZHMpDQpgYGANCmBgYHtyfQ0Kc3RyKG15ZGlhbW9uZHMpDQpgYGANCmBgYHtyfQ0KaGVhZChteWRpYW1vbmRzKQ0KYGBgDQpgYGB7cn0NCnRhaWwobXlkaWFtb25kcykNCmBgYA0KYGBge3J9DQp0YWJsZShteWRpYW1vbmRzJGN1dCkNCmBgYA0KDQoNCmBgYHtyfQ0KcGFyKG1mcm93PWMoMSwxKSkNCg0KcGxvdChteWRpYW1vbmRzJGNvbG9yKQ0KYGBgDQpgYGB7cn0NCmdncGxvdChkYXRhID0gbXlkaWFtb25kcywgYWVzKHggPSBwcmljZSwgeSA9IGNhcmF0LCBjb2xvciA9IGN1dCkpICsgZ2VvbV9wb2ludCgpDQpgYGANCg0KSG93IG1hbnkgcmVjb3JkcyBhcmUgaW4gdGhlIGRhdGFzZXQ/DQoNCmBgYHtyfQ0KbnJvdyhteWRpYW1vbmRzKQ0KTlJPVyhteWRpYW1vbmRzKQ0KYGBgDQoNCg0KV2hhdCBpcyB0aGUgbGFyZ2VzdCBkaWFtb25kIGJ5IHdlaWdodCAoY2FyYXQpPw0KDQpgYGB7cn0NCm1heChteWRpYW1vbmRzJGNhcmF0KQ0KYGBgDQoNCg0KTW9zdCBhbmQgbGVhc3QgZXhwZW5zaXZlPw0KDQpgYGB7cn0NCm1vc3RfZXhwZW5zaXZlIDwtIG1heChteWRpYW1vbmRzJHByaWNlKQ0KcHJpbnQobW9zdF9leHBlbnNpdmUpDQoNCmxlYXN0X2V4cGVuc2l2ZSA8LSBtaW4obXlkaWFtb25kcyRwcmljZSkNCnByaW50KGxlYXN0X2V4cGVuc2l2ZSkNCmBgYA0KDQoNClBsb3QgYSBiYXIgY2hhcnQgb2YgY291bnQgb2YgZGlhbW9uZHMgdnMgY3V0Lg0KDQpgYGB7cn0NCmdncGxvdChkYXRhID0gbXlkaWFtb25kcywgYWVzKHggPSBjdXQpKSArIGdlb21fYmFyKCkNCmBgYA0KDQoNCkxldCdzIGV4cGxvcmUgdGhlIGRhdGEgYSBiaXQuIFdoYXQgYXR0cmlidXRlcyBkb2VzIHRoZSBtb3N0IGV4cGVuc2l2ZSBkaWFtb25kIGhhdmU/IENoYW5nZSBtYXgocHJpY2UpIHRvIG1pbihwcmljZSkgdG8gc2VlIHRoZSBsZWFzdCBleHBlbnNpdmUuDQpgYGB7cn0NCnN1YnNldChteWRpYW1vbmRzLCBwcmljZSA9PSBtYXgocHJpY2UpKQ0KYGBgDQpgYGB7cn0NCnN1YnNldChteWRpYW1vbmRzLCBwcmljZSA9PSBtaW4ocHJpY2UpKQ0KYGBgDQoNCkNyZWF0ZSBhIHBsb3Qgb2YgY2FyYXQgdnMgcHJpY2UuDQoNCmBgYHtyfQ0KZ2dwbG90KGRhdGEgPSBteWRpYW1vbmRzLCBhZXMoeCA9IGNhcmF0LCB5ID0gcHJpY2UsIGNvbG9yID0gInJlZCIpKSArIGdlb21fcG9pbnQoYWxwaGEgPSAwLjgpDQpgYGANCg0KDQpEb2VzIGl0IGxvb2sgbGlrZSBjYXJhdCBhbmQgcHJpY2UgaGF2ZSBhIGxpbmVhciByZWxhdGlvbnNoaXA/DQpgYGB7cn0NCiNBbnN3ZXI6IEZyb20gdGhlIGdyYXBocywgaXQgaXMgY2xlYXIgdGhhdCB0aGUgcmVsYXRpb25zaGlwIGJldHdlZW4gdGhlIHR3byB2YXJpYWJsZXMgKENhcmF0IGFuZCBQcmljZSkgaXMgbm9uLWxpbmVhcjogQXMgc2hvd24sIGFzIHRoZSBjYXJhdCBzaXplIGluY3JlYXNlcywgdGhlIHByaWNlIGFsc28gaW5jcmVhc2VzLiBBcyBzdWNoLCB0aGlzIGNvdWxkIGJlIGV4cG9uZW50aWFsLiBBbHNvLCB0aGUgdmFyaWFuY2Ugb2YgdGhlIHJlbGF0aW9uc2hpcCBpbmNyZWFzZXMgYXMgY2FyYXQgc2l6ZSBpbmNyZWFzZXMuIFRoZXJlIGFyZSBhbHNvIGFwcGFyZW50IGRpc2NyZXRlIHZhbHVlcyB0aGF0IGNhcmF0IHNpemUgdGFrZXMgb24sIHZlcnRpY2FsIHN0cmlwcyBvbiB0aGUgZ3JhcGguIE1vcmVvdmVyLCB0aGUgbGluZWFyIHRyZW5kIGxpbmUgZG9lcyBub3QgZ28gdGhyb3VnaCB0aGUgY2VudGVyIG9mIHRoZSBkYXRhIGF0IHNvbWUga2V5IHBsYWNlcy4NCmBgYA0KDQoNCmBgYHtyfQ0KZ2dwbG90KGFlcyh4PWNhcmF0LCB5PXByaWNlKSwgZGF0YT1kaWFtb25kcykgKw0KICBnZW9tX3BvaW50KGZpbGw9SSgiI0Y3OTQyMCIpLCBjb2xvcj1JKCJyZWQiKSwgc2hhcGU9MjEpICsNCiAgc3RhdF9zbW9vdGgobWV0aG9kPSJsbSIpICsNCiBzY2FsZV94X2NvbnRpbnVvdXMobGltID0gYygwLCBxdWFudGlsZShkaWFtb25kcyRjYXJhdCwgMC45OSkpICkgKw0KICBzY2FsZV95X2NvbnRpbnVvdXMobGltID0gYygwLCBxdWFudGlsZShkaWFtb25kcyRwcmljZSwgMC45OSkpICkgKw0KICBnZ3RpdGxlKCJSZWxhdGlvbnNoaXAgQmV0d2VlbiBQcmljZSB2cy4gQ2FyYXQiKSArIHhsYWIoIkNBUkFUIikgKyB5bGFiKCJQUklDRSIpDQpgYGANCg0KDQpgYGB7cn0NCmdncGxvdChkYXRhID0gbXlkaWFtb25kcywgYWVzKHggPSBjYXJhdCwgeSA9IHByaWNlKSkgKyBnZW9tX3BvaW50KGFscGhhID0gMC42KSArICBzdGF0X3Ntb290aChtZXRob2QgPSAibG0iLCBjb2xvciA9ICJibHVlIikNCmBgYA0KDQoNCmBgYHtyfQ0KZ2dwbG90KGRhdGEgPSBteWRpYW1vbmRzLCBhZXMoeCA9IGNhcmF0LCB5ID0gcHJpY2UpKSArIGdlb21fbGluZSgpICsgIGdlb21fc21vb3RoKG1ldGhvZCA9ICJsbSIsIGNvbG9yID0gImdyZWVuIikNCmBgYA0KDQoNCmBgYHtyfQ0KZ2dwbG90KGRhdGEgPSBteWRpYW1vbmRzLCBhZXMoeCA9IGNhcmF0LCB5ID0gcHJpY2UpKSArIGdlb21fcG9pbnQoKSArIGNvb3JkX2ZpeGVkKCkgKyAgc2NhbGVfeF9sb2cxMCgpICsgIHNjYWxlX3lfbG9nMTAoKSArICBnZW9tX3Ntb290aChtZXRob2QgPSAibG0iLCBjb2xvciA9ICJncmVlbiIpICsgeGxhYignQ0FSQVQgSU5DSCcpICsgeWxhYignUFJJQ0UgSU5DSCcpDQpgYGANCg0KQ3JlYXRlIHRocmVlIG90aGVyIHBsb3RzIG9mIG90aGVyIHZhcmlhYmxlcyB2cyBwcmljZS4gVGhlIHBvaW50IG9mIGV4cGxvcmF0b3J5IGFuYWx5c2lzIChrbm93IHlvdXIgZGF0YSkgaXMgdG8gZG8ganVzdCB0aGF0LCBleHBsb3JlLiBZb3UgbWlnaHQgaGF2ZSB0byBwbG90IG1vcmUgdGhhbiB0aHJlZSB0byBmaW5kIHZhcmlhYmxlcyB0aGF0IHBsb3QgY29ycmVjdGx5LiBQbGVhc2UgcmVhbGl6ZSB0b28gdGhhdCBzY2F0dGVyIHBsb3RzIChvciBsaW5lKSBhcmUgZm9yIGNvbnRpbnVvdXMgdmFyaWFibGVzIGFuZCBub3QgZm9yIGNhdGVnb3JpY2FsIHZhcmlhYmxlcy4gU2VlIHRoZSBnZ3Bsb3QyIGludHJvIGZvciByZWZlcmVuY2VzLiBQbGVhc2UgdHJ5IHRvIHBpY2sgdGhyZWUgdmFyaWFibGVzIHRoYXQgeW91IHRoaW5rIGhhdmUgYSBzdHJvbmcgaW5mbHVlbmNlIGluIHRoZSBwcmljZSBvZiB0aGUgZGlhbW9uZC4gVGhlIG1haW4gcG9pbnQgZm9yIHRoaXMgaXMgdG8gbWFrZSBhIG1vZGVsIGxhdGVyIG9uLg0KDQpgYGB7cn0NCmdncGxvdChkYXRhPWRpYW1vbmRzKSArIGdlb21faGlzdG9ncmFtKGJpbndpZHRoPTUwMCwgYWVzKHg9cHJpY2UpKSArIGdndGl0bGUoIkRpYW1vbmQgUHJpY2UgRGlzdHJpYnV0aW9uIikgKyB4bGFiKCJEaWFtb25kIFByaWNlIFUkIC0gQmlud2lkdGggNTAwIikgKyB5bGFiKCJGcmVxdWVuY3kiKSArIHRoZW1lX21pbmltYWwoKQ0KYGBgDQoNCmBgYHtyfQ0KZ2dwbG90KGRhdGEgPSBkaWFtb25kcykgKyBhZXMoeCA9IHByaWNlLCBjb2xvciA9IGN1dCkgKyBnZW9tX2JhcigpICsgeWxhYigiRnJlcXVlbmN5IikgKyB4bGFiKCJEaWFtb24gUHJpY2UgVSQiKQ0KYGBgDQpgYGB7cn0NCmdncGxvdChkYXRhID0gbXlkaWFtb25kcykgKyBhZXMoeD1jdXQseT1wcmljZSwgY29sb3I9Y3V0KSArDQogIGdlb21fYm94cGxvdCgpICsgZ2d0aXRsZSgiUmVsYXRpb25zaGlwIG9mIFByaWNlIGFuZCBDdXQiKSArIHhsYWIoIkN1dCIpICsgeWxhYigiUHJpY2UiKQ0KYGBgDQpgYGB7cn0NCiAgZ2dwbG90KGRhdGEgPSBteWRpYW1vbmRzKSArIGFlcyh4PShwcmljZSkpICsNCiAgZ2VvbV9oaXN0b2dyYW0oc3RhdD0iYmluIixiaW53aWR0aD0gNTAwKSArDQogIGZhY2V0X3dyYXAofmN1dCwgc2NhbGVzID0gImZyZWUiKQ0KYGBgDQoNCg==