Report on diamond prices

Test the hypothesis that the average price of diamonds in the available data is larger than $4500 after filtering out the cheapest diamonds (< $1000)

result <- single_mean(
  diamonds, 
  var = "price", 
  comp_value = 4500, 
  alternative = "greater", 
  data_filter = "price >= 1000"
)
summary(result)
Single mean test
Data      : diamonds 
Filter    : price >= 1000 
Variable  : price 
Confidence: 0.95 
Null hyp. : the mean of price = 4500 
Alt. hyp. : the mean of price is > 4500 

      mean        sd     n n_missing
 5,100.963 4,028.164 2,186         0

    diff     se t.value p.value   df      5% 100%    
 600.963 86.155   6.975  < .001 2185 4959.19  Inf ***

Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
plot(result, plots = c("hist", "simulate"))

Compare diamond prices by the quality of the ‘cut’. It seems that diamonds with a premium cut cost more than diamonds with a ideal cut. Seems strange. Perhaps we should use regression to control for the carats of the diamond. Try it!

result <- compare_means(
  dataset = diamonds, 
  var1 = "cut", 
  var2 = "price", 
  adjust = "bonf", 
  data_filter = "price >= 1000"
)
summary(result, show = FALSE)
Pairwise mean comparisons (t-test)
Data      : diamonds 
Filter    : price >= 1000 
Variables : cut, price 
Samples   : independent 
Confidence: 0.95 
Adjustment: Bonferroni 

       cut      mean   n        sd      se      ci
      Fair 4,701.771  96 3,742.952 382.013 758.393
      Good 5,141.244 213 3,663.915 251.047 494.869
 Very Good 5,206.187 492 3,897.686 175.721 345.258
   Premium 5,462.115 593 4,261.665 175.006 343.707
     Ideal 4,802.742 792 4,037.949 143.482 281.651

 Null hyp.             Alt. hyp.                        diff     p.value
 Fair = Good           Fair not equal to Good           -439.473 1      
 Fair = Very Good      Fair not equal to Very Good      -504.416 1      
 Fair = Premium        Fair not equal to Premium        -760.344 0.725  
 Fair = Ideal          Fair not equal to Ideal          -100.972 1      
 Good = Very Good      Good not equal to Very Good       -64.943 1      
 Good = Premium        Good not equal to Premium        -320.871 1      
 Good = Ideal          Good not equal to Ideal           338.502 1      
 Very Good = Premium   Very Good not equal to Premium   -255.928 1      
 Very Good = Ideal     Very Good not equal to Ideal      403.445 0.756  
 Premium = Ideal       Premium not equal to Ideal        659.372 0.036  

Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
plot(result, plots = c("scatter", "density", "bar"))

Visualize the relationship between diamond prices, carats, and the cut of the diamond.

visualize(diamonds, 
  xvar = "carat", 
  yvar = "price", 
  type = "scatter", 
  facet_row = "cut", 
  color = "cut", 
  data_filter = "price >= 1000", 
  custom = FALSE
)

LS0tCnRpdGxlOiAiIgpvdXRwdXQ6CiAgaHRtbF9ub3RlYm9vazoKICAgIGhpZ2hsaWdodDogdGV4dG1hdGUKICAgIHRoZW1lOiBzcGFjZWxhYgogICAgdG9jOiB5ZXMKICAgIGNvZGVfZm9sZGluZzogaGlkZQotLS0KCmBgYHtyIHJfc2V0dXAsIGluY2x1ZGUgPSBGQUxTRX0KIyMgaW5pdGlhbCBzZXR0aW5ncwprbml0cjo6b3B0c19jaHVuayRzZXQoCiAgY29tbWVudCA9IE5BLAogIGVjaG8gPSBUUlVFLAogIGVycm9yID0gVFJVRSwKICBjYWNoZSA9IEZBTFNFLAogIG1lc3NhZ2UgPSBGQUxTRSwKICBkcGkgPSAyMDAsCiAgd2FybmluZyA9IEZBTFNFCikKCiMjIHdpZHRoIHRvIHVzZSB3aGVuIHByaW50aW5nIHRhYmxlcyBldGMuCm9wdGlvbnMoCiAgd2lkdGggPSAyNTAsCiAgc2NpcGVuID0gMTAwLAogIG1heC5wcmludCA9IDUwMDAsCiAgc3RyaW5nc0FzRmFjdG9ycyA9IEZBTFNFCikKCiMjIG1ha2UgYWxsIHJlcXVpcmVkIGxpYnJhcmllcyBhdmFpbGFibGUgYnkgbG9hZGluZyByYWRpYW50IHBhY2thZ2UgaWYgbmVlZGVkCmlmICghZXhpc3RzKCJyX2Vudmlyb25tZW50IikpIGxpYnJhcnkocmFkaWFudCkKCiMjIGluY2x1ZGUgY29kZSB0byBsb2FkIHRoZSBkYXRhIHlvdSByZXF1aXJlCiMjIGZvciBpbnRlcmFjdGl2ZSB1c2UgYXR0YWNoIHRoZSByX2RhdGEgZW52aXJvbm1lbnQKIyBhdHRhY2gocl9kYXRhKQpgYGAKCjxzdHlsZT4KLnRhYmxlIHsKICB3aWR0aDogYXV0bzsKfQp1bCwgb2wgewogIHBhZGRpbmctbGVmdDogMThweDsKfQpwcmUsIGNvZGUsIHByZSBjb2RlIHsKICBvdmVyZmxvdzogYXV0bzsKICB3aGl0ZS1zcGFjZTogcHJlOwogIHdvcmQtd3JhcDogbm9ybWFsOwogIGJhY2tncm91bmQtY29sb3I6ICNmZmZmZmY7Cn0KPC9zdHlsZT4KCiMjIFJlcG9ydCBvbiBkaWFtb25kIHByaWNlcwoKVGVzdCB0aGUgaHlwb3RoZXNpcyB0aGF0IHRoZSBhdmVyYWdlIHByaWNlIG9mIGRpYW1vbmRzIGluIHRoZSBhdmFpbGFibGUgZGF0YSBpcyBsYXJnZXIgdGhhbiAkNDUwMCBhZnRlciBmaWx0ZXJpbmcgb3V0IHRoZSBjaGVhcGVzdCBkaWFtb25kcyAoPCAkMTAwMCkKCmBgYHtyIGZpZy53aWR0aD03LCBmaWcuaGVpZ2h0PTcuMzgsIGRwaSA9IDcyfQpyZXN1bHQgPC0gc2luZ2xlX21lYW4oCiAgZGlhbW9uZHMsIAogIHZhciA9ICJwcmljZSIsIAogIGNvbXBfdmFsdWUgPSA0NTAwLCAKICBhbHRlcm5hdGl2ZSA9ICJncmVhdGVyIiwgCiAgZGF0YV9maWx0ZXIgPSAicHJpY2UgPj0gMTAwMCIKKQpzdW1tYXJ5KHJlc3VsdCkKcGxvdChyZXN1bHQsIHBsb3RzID0gYygiaGlzdCIsICJzaW11bGF0ZSIpKQpgYGAKCkNvbXBhcmUgZGlhbW9uZCBwcmljZXMgYnkgdGhlIHF1YWxpdHkgb2YgdGhlICdjdXQnLiBJdCBzZWVtcyB0aGF0IGRpYW1vbmRzIHdpdGggYSBwcmVtaXVtIGN1dCBjb3N0IG1vcmUgdGhhbiBkaWFtb25kcyB3aXRoIGEgaWRlYWwgY3V0LiBTZWVtcyBzdHJhbmdlLiBQZXJoYXBzIHdlIHNob3VsZCB1c2UgcmVncmVzc2lvbiB0byBjb250cm9sIGZvciB0aGUgY2FyYXRzIG9mIHRoZSBkaWFtb25kLiBUcnkgaXQhCgpgYGB7ciBmaWcud2lkdGg9NywgZmlnLmhlaWdodD0xMS4wOCwgZHBpID0gNzJ9CnJlc3VsdCA8LSBjb21wYXJlX21lYW5zKAogIGRhdGFzZXQgPSBkaWFtb25kcywgCiAgdmFyMSA9ICJjdXQiLCAKICB2YXIyID0gInByaWNlIiwgCiAgYWRqdXN0ID0gImJvbmYiLCAKICBkYXRhX2ZpbHRlciA9ICJwcmljZSA+PSAxMDAwIgopCnN1bW1hcnkocmVzdWx0LCBzaG93ID0gRkFMU0UpCnBsb3QocmVzdWx0LCBwbG90cyA9IGMoInNjYXR0ZXIiLCAiZGVuc2l0eSIsICJiYXIiKSkKYGBgCgpWaXN1YWxpemUgdGhlIHJlbGF0aW9uc2hpcCBiZXR3ZWVuIGRpYW1vbmQgcHJpY2VzLCBjYXJhdHMsIGFuZCB0aGUgY3V0IG9mIHRoZSBkaWFtb25kLgoKYGBge3IgZmlnLndpZHRoPTYuNDYsIGZpZy5oZWlnaHQ9NS41NCwgZHBpID0gNzJ9CnZpc3VhbGl6ZShkaWFtb25kcywgCiAgeHZhciA9ICJjYXJhdCIsIAogIHl2YXIgPSAicHJpY2UiLCAKICB0eXBlID0gInNjYXR0ZXIiLCAKICBmYWNldF9yb3cgPSAiY3V0IiwgCiAgY29sb3IgPSAiY3V0IiwgCiAgZGF0YV9maWx0ZXIgPSAicHJpY2UgPj0gMTAwMCIsIAogIGN1c3RvbSA9IEZBTFNFCikKYGBgCgoK