Final Project
Sahil Gaikwad
12/1/2021
Project Part 1
Objective:- Perform a designed experiment to determine the effect of the type of ball on the distance in which the ball is thrown.
According to problem statement, we have to take the observations of distance traveled by each ball by keeping the Pin Elevation and Bungee Position both in the highest setting.
Part 1 A)
To find out the number of samples required from each type of ball, we will have to perform the pwr.anova.test
From the given experiment we have, Number of population(k)=3, mean difference with a medium effect (d)= 0.5 of the standard deviation and probability= 75%.
Hence according to effect formula and pwr.anova.test
library(pwr)
pwr.anova.test(k=3,n=NULL,f=((0.5*sqrt((3^2)-1))/(2*3)),sig.level = 0.05,power = 0.75)##
## Balanced one-way analysis of variance power calculation
##
## k = 3
## n = 52.55574
## f = 0.2357023
## sig.level = 0.05
## power = 0.75
##
## NOTE: n is number in each groupFrom the results of pwr.anova test we conclude that, 53 samples of each type of ball should be collected to detect a mean difference with a medium effect with a probability of 75%.
Part 1 B)
Now, we need to generate Completely Randomized Design with equal or different repetition to perform a designed experiment to determine the effect of the type of ball on the distance in which the ball is thrown.
library(agricolae)
designlevel<-c("yellow ball","red ball","black ball")
experimentdesign<-design.crd(designlevel,r=53,seed=15789)
experimentdesign$book## plots r designlevel
## 1 101 1 black ball
## 2 102 1 red ball
## 3 103 2 red ball
## 4 104 3 red ball
## 5 105 4 red ball
## 6 106 2 black ball
## 7 107 5 red ball
## 8 108 6 red ball
## 9 109 1 yellow ball
## 10 110 2 yellow ball
## 11 111 3 yellow ball
## 12 112 3 black ball
## 13 113 7 red ball
## 14 114 4 yellow ball
## 15 115 4 black ball
## 16 116 8 red ball
## 17 117 9 red ball
## 18 118 5 black ball
## 19 119 5 yellow ball
## 20 120 6 yellow ball
## 21 121 6 black ball
## 22 122 7 black ball
## 23 123 10 red ball
## 24 124 8 black ball
## 25 125 9 black ball
## 26 126 11 red ball
## 27 127 7 yellow ball
## 28 128 12 red ball
## 29 129 8 yellow ball
## 30 130 13 red ball
## 31 131 10 black ball
## 32 132 11 black ball
## 33 133 9 yellow ball
## 34 134 14 red ball
## 35 135 15 red ball
## 36 136 12 black ball
## 37 137 16 red ball
## 38 138 13 black ball
## 39 139 10 yellow ball
## 40 140 14 black ball
## 41 141 11 yellow ball
## 42 142 15 black ball
## 43 143 17 red ball
## 44 144 16 black ball
## 45 145 18 red ball
## 46 146 17 black ball
## 47 147 12 yellow ball
## 48 148 13 yellow ball
## 49 149 19 red ball
## 50 150 20 red ball
## 51 151 21 red ball
## 52 152 22 red ball
## 53 153 18 black ball
## 54 154 19 black ball
## 55 155 14 yellow ball
## 56 156 23 red ball
## 57 157 24 red ball
## 58 158 15 yellow ball
## 59 159 16 yellow ball
## 60 160 25 red ball
## 61 161 20 black ball
## 62 162 21 black ball
## 63 163 26 red ball
## 64 164 17 yellow ball
## 65 165 22 black ball
## 66 166 27 red ball
## 67 167 28 red ball
## 68 168 23 black ball
## 69 169 24 black ball
## 70 170 25 black ball
## 71 171 26 black ball
## 72 172 18 yellow ball
## 73 173 29 red ball
## 74 174 27 black ball
## 75 175 19 yellow ball
## 76 176 20 yellow ball
## 77 177 30 red ball
## 78 178 31 red ball
## 79 179 21 yellow ball
## 80 180 22 yellow ball
## 81 181 32 red ball
## 82 182 23 yellow ball
## 83 183 28 black ball
## 84 184 24 yellow ball
## 85 185 29 black ball
## 86 186 30 black ball
## 87 187 31 black ball
## 88 188 33 red ball
## 89 189 32 black ball
## 90 190 25 yellow ball
## 91 191 34 red ball
## 92 192 35 red ball
## 93 193 36 red ball
## 94 194 37 red ball
## 95 195 26 yellow ball
## 96 196 38 red ball
## 97 197 39 red ball
## 98 198 40 red ball
## 99 199 33 black ball
## 100 200 34 black ball
## 101 201 27 yellow ball
## 102 202 28 yellow ball
## 103 203 35 black ball
## 104 204 36 black ball
## 105 205 37 black ball
## 106 206 41 red ball
## 107 207 29 yellow ball
## 108 208 42 red ball
## 109 209 38 black ball
## 110 210 30 yellow ball
## 111 211 43 red ball
## 112 212 44 red ball
## 113 213 31 yellow ball
## 114 214 32 yellow ball
## 115 215 33 yellow ball
## 116 216 34 yellow ball
## 117 217 35 yellow ball
## 118 218 36 yellow ball
## 119 219 37 yellow ball
## 120 220 38 yellow ball
## 121 221 39 yellow ball
## 122 222 40 yellow ball
## 123 223 45 red ball
## 124 224 41 yellow ball
## 125 225 39 black ball
## 126 226 40 black ball
## 127 227 41 black ball
## 128 228 42 black ball
## 129 229 43 black ball
## 130 230 44 black ball
## 131 231 42 yellow ball
## 132 232 43 yellow ball
## 133 233 45 black ball
## 134 234 46 black ball
## 135 235 44 yellow ball
## 136 236 46 red ball
## 137 237 45 yellow ball
## 138 238 47 red ball
## 139 239 47 black ball
## 140 240 48 black ball
## 141 241 48 red ball
## 142 242 46 yellow ball
## 143 243 49 red ball
## 144 244 50 red ball
## 145 245 47 yellow ball
## 146 246 51 red ball
## 147 247 49 black ball
## 148 248 52 red ball
## 149 249 48 yellow ball
## 150 250 49 yellow ball
## 151 251 50 black ball
## 152 252 51 black ball
## 153 253 52 black ball
## 154 254 50 yellow ball
## 155 255 51 yellow ball
## 156 256 53 red ball
## 157 257 52 yellow ball
## 158 258 53 yellow ball
## 159 259 53 black balldesign<-as.data.frame(experimentdesign$book)From the results of Completely Randomized Design test we generated the randomized experiment to note the observations to determine the effect of the type of ball on the distance in which the ball is thrown
Part 1 C)
Reading observations from excel file to perform anova test for completely Randomized Design
Here distance is in inches
library(readxl)## Warning: package 'readxl' was built under R version 4.1.2excelfile<-read_excel("E:/Texas Tech/Blckboard Material/Project Part1 Data F.xlsx")## New names:
## * `` -> ...1dataframe<-as.data.frame(excelfile)
dataframe## ...1 Plots r designlevel Observations
## 1 1 101 1 Black Ball 109
## 2 2 102 1 Red Ball 104
## 3 3 103 2 Red Ball 91
## 4 4 104 3 Red Ball 97
## 5 5 105 4 Red Ball 89
## 6 6 106 2 Black Ball 78
## 7 7 107 5 Red Ball 83
## 8 8 108 6 Red Ball 79
## 9 9 109 1 Yellow Ball 98
## 10 10 110 2 Yellow Ball 111
## 11 11 111 3 Yellow Ball 106
## 12 12 112 3 Black Ball 77
## 13 13 113 7 Red Ball 86
## 14 14 114 4 Yellow Ball 107
## 15 15 115 4 Black Ball 73
## 16 16 116 8 Red Ball 63
## 17 17 117 9 Red Ball 59
## 18 18 118 5 Black Ball 83
## 19 19 119 5 Yellow Ball 109
## 20 20 120 6 Yellow Ball 98
## 21 21 121 6 Black Ball 75
## 22 22 122 7 Black Ball 83
## 23 23 123 10 Red Ball 72
## 24 24 124 8 Black Ball 53
## 25 25 125 9 Black Ball 59
## 26 26 126 11 Red Ball 63
## 27 27 127 7 Yellow Ball 74
## 28 28 128 12 Red Ball 56
## 29 29 129 8 Yellow Ball 67
## 30 30 130 13 Red Ball 59
## 31 31 131 10 Black Ball 63
## 32 32 132 11 Black Ball 56
## 33 33 133 9 Yellow Ball 67
## 34 34 134 14 Red Ball 56
## 35 35 135 15 Red Ball 67
## 36 36 136 12 Black Ball 62
## 37 37 137 16 Red Ball 63
## 38 38 138 13 Black Ball 65
## 39 39 139 10 Yellow Ball 65
## 40 40 140 14 Black Ball 56
## 41 41 141 11 Yellow Ball 65
## 42 42 142 15 Black Ball 59
## 43 43 143 17 Red Ball 57
## 44 44 144 16 Black Ball 53
## 45 45 145 18 Red Ball 56
## 46 46 146 17 Black Ball 68
## 47 47 147 12 Yellow Ball 67
## 48 48 148 13 Yellow Ball 71
## 49 49 149 19 Red Ball 59
## 50 50 150 20 Red Ball 61
## 51 51 151 21 Red Ball 64
## 52 52 152 22 Red Ball 69
## 53 53 153 18 Black Ball 56
## 54 54 154 19 Black Ball 59
## 55 55 155 14 Yellow Ball 61
## 56 56 156 23 Red Ball 69
## 57 57 157 24 Red Ball 61
## 58 58 158 15 Yellow Ball 65
## 59 59 159 16 Yellow Ball 66
## 60 60 160 25 Red Ball 62
## 61 61 161 20 Black Ball 53
## 62 62 162 21 Black Ball 57
## 63 63 163 26 Red Ball 65
## 64 64 164 17 Yellow Ball 68
## 65 65 165 22 Black Ball 59
## 66 66 166 27 Red Ball 61
## 67 67 167 28 Red Ball 59
## 68 68 168 23 Black Ball 54
## 69 69 169 24 Black Ball 67
## 70 70 170 25 Black Ball 59
## 71 71 171 26 Black Ball 59
## 72 72 172 18 Yellow Ball 63
## 73 73 173 29 Red Ball 65
## 74 74 174 27 Black Ball 58
## 75 75 175 19 Yellow Ball 63
## 76 76 176 20 Yellow Ball 71
## 77 77 177 30 Red Ball 61
## 78 78 178 31 Red Ball 64
## 79 79 179 21 Yellow Ball 69
## 80 80 180 22 Yellow Ball 73
## 81 81 181 32 Red Ball 62
## 82 82 182 23 Yellow Ball 69
## 83 83 183 28 Black Ball 61
## 84 84 184 24 Yellow Ball 76
## 85 85 185 29 Black Ball 61
## 86 86 186 30 Black Ball 61
## 87 87 187 31 Black Ball 57
## 88 88 188 33 Red Ball 68
## 89 89 189 32 Black Ball 52
## 90 90 190 25 Yellow Ball 64
## 91 91 191 34 Red Ball 51
## 92 92 192 35 Red Ball 58
## 93 93 193 36 Red Ball 56
## 94 94 194 37 Red Ball 64
## 95 95 195 26 Yellow Ball 71
## 96 96 196 38 Red Ball 54
## 97 97 197 39 Red Ball 58
## 98 98 198 40 Red Ball 60
## 99 99 199 33 Black Ball 55
## 100 100 200 34 Black Ball 48
## 101 101 201 27 Yellow Ball 69
## 102 102 202 28 Yellow Ball 63
## 103 103 203 35 Black Ball 48
## 104 104 204 36 Black Ball 56
## 105 105 205 37 Black Ball 51
## 106 106 206 41 Red Ball 61
## 107 107 207 29 Yellow Ball 56
## 108 108 208 42 Red Ball 61
## 109 109 209 38 Black Ball 52
## 110 110 210 30 Yellow Ball 67
## 111 111 211 43 Red Ball 70
## 112 112 212 44 Red Ball 63
## 113 113 213 31 Yellow Ball 68
## 114 114 214 32 Yellow Ball 67
## 115 115 215 33 Yellow Ball 79
## 116 116 216 34 Yellow Ball 62
## 117 117 217 35 Yellow Ball 74
## 118 118 218 36 Yellow Ball 72
## 119 119 219 37 Yellow Ball 69
## 120 120 220 38 Yellow Ball 64
## 121 121 221 39 Yellow Ball 68
## 122 122 222 40 Yellow Ball 65
## 123 123 223 45 Red Ball 68
## 124 124 224 41 Yellow Ball 69
## 125 125 225 39 Black Ball 53
## 126 126 226 40 Black Ball 58
## 127 127 227 41 Black Ball 47
## 128 128 228 42 Black Ball 53
## 129 129 229 43 Black Ball 57
## 130 130 230 44 Black Ball 50
## 131 131 231 42 Yellow Ball 64
## 132 132 232 43 Yellow Ball 57
## 133 133 233 45 Black Ball 56
## 134 134 234 46 Black Ball 50
## 135 135 235 44 Yellow Ball 59
## 136 136 236 46 Red Ball 59
## 137 137 237 45 Yellow Ball 61
## 138 138 238 47 Red Ball 61
## 139 139 239 47 Black Ball 62
## 140 140 240 48 Black Ball 57
## 141 141 241 48 Red Ball 69
## 142 142 242 46 Yellow Ball 56
## 143 143 243 49 Red Ball 58
## 144 144 244 50 Red Ball 56
## 145 145 245 47 Yellow Ball 63
## 146 146 246 51 Red Ball 60
## 147 147 247 49 Black Ball 55
## 148 148 248 52 Red Ball 63
## 149 149 249 48 Yellow Ball 67
## 150 150 250 49 Yellow Ball 56
## 151 151 251 50 Black Ball 59
## 152 152 252 51 Black Ball 57
## 153 153 253 52 Black Ball 62
## 154 154 254 50 Yellow Ball 53
## 155 155 255 51 Yellow Ball 59
## 156 156 256 53 Red Ball 62
## 157 157 257 52 Yellow Ball 51
## 158 158 258 53 Yellow Ball 54
## 159 159 259 53 Black Ball 57Here Observations in excel file are numbers and designlevel is factor
excelfile$Observations<-as.numeric(excelfile$Observations)
excelfile$designlevel<-as.factor(excelfile$designlevel)Now we will plot the boxplot to simultaneously compare the data
boxplot(excelfile$Observations~excelfile$designlevel,main="Comparing Boxplot for Blackball, Redball and Yellowball", col=c("gray60","red","yellow"))
From the boxplot, it appears that Redball readings are distributed or more spread out when compared with Blackball and Redball and variances are fairly constant.
Now to estimate how a quantitative dependent variable changes according to the levels of one or more categorical independent variables we will perform anova test
Part 1 D)
To test the hypothesis, we will first define the hypothesis.
Null Hypothesis : \(H_o : \mu_1 = \mu_2 = \mu_3 = .... \mu_i = \mu\)
Alternative Hypothesis : \(H_a\) : At least one of the \(\mu_i\) differs
aov.model<-aov(excelfile$Observations~excelfile$designlevel,data = dataframe)
summary(aov.model)## Df Sum Sq Mean Sq F value Pr(>F)
## excelfile$designlevel 2 2440 1219.8 8.49 0.000316 ***
## Residuals 156 22413 143.7
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1From the results of anova test we get p-value as 0.000316. As the p-value is lesser than \(\alpha\) = 0.05, we conclude that we reject the null hypothesis and atleast one mean is different
Now, to check assumptions of the our model, we will plot residuals of aov.model
plot(aov.model,col="darkred")
From the residual normal plot we can conclude that observations are fairly distributed along the straight normal line but in the end they start deviating from the line
From residual plots we can conclude that variance are not constant and widely spread
Hence to stabilize the normality and variance we will do the data transformation using boxcox
library("MASS")
boxcox(aov.model)
From the boxcox plot we can conclude that the 95% confidence interval range intersect at -1.65. Hence value of lambda is taken as -1.65
lambda = -1.65
dataframe2<-dataframe
dataframe2$Observations<-(dataframe2$Observations)^lambda
dataframe2$Observations## [1] 0.0004347567 0.0004697805 0.0005855739 0.0005270194 0.0006074443
## [6] 0.0007551686 0.0006815868 0.0007394610 0.0005181756 0.0004219073
## [11] 0.0004552451 0.0007714190 0.0006428025 0.0004482464 0.0008423979
## [16] 0.0010742073 0.0011970001 0.0006815868 0.0004347567 0.0005181756
## [21] 0.0008056546 0.0006815868 0.0008617899 0.0014287124 0.0011970001
## [26] 0.0010742073 0.0008236973 0.0013046372 0.0009704576 0.0011970001
## [31] 0.0010742073 0.0013046372 0.0009704576 0.0013046372 0.0009704576
## [36] 0.0011029446 0.0010742073 0.0010202180 0.0010202180 0.0013046372
## [41] 0.0010202180 0.0011970001 0.0012670872 0.0014287124 0.0013046372
## [46] 0.0009470225 0.0009704576 0.0008819089 0.0011970001 0.0011329370
## [51] 0.0010466538 0.0009244832 0.0013046372 0.0011970001 0.0011329370
## [56] 0.0009244832 0.0011329370 0.0010202180 0.0009948383 0.0011029446
## [61] 0.0014287124 0.0012670872 0.0010202180 0.0009470225 0.0011970001
## [66] 0.0011329370 0.0011970001 0.0013853206 0.0009704576 0.0011970001
## [71] 0.0011970001 0.0010742073 0.0010202180 0.0012312431 0.0010742073
## [76] 0.0008819089 0.0011329370 0.0010466538 0.0009244832 0.0008423979
## [81] 0.0011029446 0.0009244832 0.0011329370 0.0007882384 0.0011329370
## [86] 0.0011329370 0.0012670872 0.0009470225 0.0014743293 0.0010466538
## [91] 0.0015223314 0.0012312431 0.0013046372 0.0010466538 0.0008819089
## [96] 0.0013853206 0.0012312431 0.0011642612 0.0013440071 0.0016824879
## [101] 0.0009244832 0.0010742073 0.0016824879 0.0013046372 0.0015223314
## [106] 0.0011329370 0.0013046372 0.0011329370 0.0014743293 0.0009704576
## [111] 0.0009027931 0.0010742073 0.0009470225 0.0009704576 0.0007394610
## [116] 0.0011029446 0.0008236973 0.0008617899 0.0009244832 0.0010466538
## [121] 0.0009470225 0.0010202180 0.0009470225 0.0009244832 0.0014287124
## [126] 0.0012312431 0.0017419614 0.0014287124 0.0012670872 0.0015728941
## [131] 0.0010466538 0.0012670872 0.0013046372 0.0015728941 0.0011970001
## [136] 0.0011970001 0.0011329370 0.0011329370 0.0011029446 0.0012670872
## [141] 0.0009244832 0.0013046372 0.0012312431 0.0013046372 0.0010742073
## [146] 0.0011642612 0.0013440071 0.0010742073 0.0009704576 0.0013046372
## [151] 0.0011970001 0.0012670872 0.0011029446 0.0014287124 0.0011970001
## [156] 0.0011029446 0.0015223314 0.0013853206 0.0012670872Now, to check assumptions of the our transformed data, we will perform aov analysis and plot residuals of new aov.model named as aov.model1
aov.model1<-aov(dataframe2$Observations~dataframe2$designlevel,data = dataframe2)
summary(aov.model1)## Df Sum Sq Mean Sq F value Pr(>F)
## dataframe2$designlevel 2 1.687e-06 8.433e-07 14.12 2.32e-06 ***
## Residuals 156 9.319e-06 5.970e-08
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1plot(aov.model1,col="darkred")
## hat values (leverages) are all = 0.01886792
## and there are no factor predictors; no plot no. 5
From the results of anova test we get p-value of transformed data is 2.32e-06. As the p-value is lesser than \(\alpha\) = 0.05, we conclude that we reject the null hypothesis and atleast one mean is different
From the residual normal plot we can conclude that observations are fairly distributed along the straight normal line but in the end they start deviating from the line
From residual plots we can conclude that variance are stabilized and are fairly constant
Part 1 E)
To compute the honest significant differences we will now perform the TukeyHSD test
library(agricolae)
tukeyHSD<-TukeyHSD(aov.model1)
tukeyHSD## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = dataframe2$Observations ~ dataframe2$designlevel, data = dataframe2)
##
## $`dataframe2$designlevel`
## diff lwr upr p adj
## Red Ball-Black Ball -1.593910e-04 -0.0002717385 -4.704343e-05 0.0028299
## Yellow Ball-Black Ball -2.490472e-04 -0.0003613947 -1.366997e-04 0.0000015
## Yellow Ball-Red Ball -8.965624e-05 -0.0002020038 2.269129e-05 0.1454391plot(tukeyHSD, col="darkred")
According to the graph of TukeyHSD test, we conclude that mean of group of “Blackball and Redball” and “Yellowball and Blackball” does not fall in zero confidence interval, hence there is significant difference in the mean of readings in that group.
Part 1 F)
As three balls have different material as well as physical characteristics, hence distance traveled by each ball is different and hence there is significant difference in means.
Also, another important factor is the way of data collection and the rubber band. From our observation as the rubber band gets used, its tension decreases and hence it impact the distance travelled by the ball.
Our recommendation is to collect the data in controlled standard environment to get accurate results
Project Part 2
Part 2 A)
Model Equation for two factor interaction:
\(Y_{ijk} = \mu_i + \alpha_i + \beta_j + \alpha\beta_{ij} + \epsilon_{ijk}\)
Where
\(\alpha_i\) is Main Effects of Factor A (pin elevation)
\(\beta_j\) is Main Effects of Factor B (Release Angle)
\(\alpha\beta_{ij}\) is Interaction effects of Factors A and Factors B
Hypothesis to be tested
Null Hypothesis(Ho): \(\alpha_i=0\) For all i
Alternative Hypothesis(Ha): \(\alpha_i\neq0\) For some i
Null Hypothesis(Ho): \(\sigma^2\beta =0\)
Alternative Hypothesis(Ha): \(\sigma^2\beta\neq0\)
Null Hypothesis(Ho): \(\sigma^2\alpha\beta=0\)
Alternative Hypothesis(Ha):\(\alpha\beta_{ij}\neq0\)
we will test first highest order interaction effects hypothesis
Null Hypothesis(Ho): \(\sigma^2\alpha\beta=0\)
Alternative Hypothesis(Ha):\(\alpha\beta_{ij}\neq0\)
Here we know, I=2, J=3 and k=3
Level of significance at which we are testing the hypothesis is 0.05
Notations
Factor A (pin elevation)
Pin position 1(bottom) is denoted by “1”
Pin position 3(top) is denoted by “2”
Also, for Factor B (Release Angle)
Release angle of 110 degree is denoted by “1”
Release angle of 140 degree is denoted by “2”
Release angle of 170 degree is denoted by “3”
Part 2 B)
Now, we need to generate Completely Randomized Design with equal or different repetition to perform a designed experiment to determine the effect of the release angle and pin position on the experiment.
library(GAD)## Loading required package: matrixStats## Loading required package: R.methodsS3## R.methodsS3 v1.8.1 (2020-08-26 16:20:06 UTC) successfully loaded. See ?R.methodsS3 for help.library(agricolae)
treat<-c(2,3)
d<-design.ab(treat,3,design = "crd",seed= 1111644)
design<-d$book
design## plots r A B
## 1 101 1 1 2
## 2 102 1 1 3
## 3 103 2 1 3
## 4 104 2 1 2
## 5 105 1 2 2
## 6 106 3 1 3
## 7 107 1 2 1
## 8 108 2 2 2
## 9 109 1 2 3
## 10 110 1 1 1
## 11 111 3 2 2
## 12 112 2 2 1
## 13 113 2 2 3
## 14 114 2 1 1
## 15 115 3 1 1
## 16 116 3 2 3
## 17 117 3 2 1
## 18 118 3 1 2Part 2 C)
Collecting the data according to the randomized generated design
factorA <-c("1","1","1","1","2","1","2","2","2","1","2","2","2","1","1","2","2","1")
factorB <-c("2","3","3","2","2","3","1","2","3","1","2","1","3","1","1","3","1","2")
observations <- c(37,54,60,45,49,49,30,53,67,30,49,33,63,33,29,72,35,51)
df<- data.frame(factorA,factorB,observations)According to the problem statement we have been told to investigate the settings “1” and “3” of Pin Elevation as the fixed effects and settings of the Release Angle corresponding to “110”, “140”, and “170” degrees as a random effects
df$factorA <- as.fixed(df$factorA)
df$factorB <- as.random(df$factorB)
df## factorA factorB observations
## 1 1 2 37
## 2 1 3 54
## 3 1 3 60
## 4 1 2 45
## 5 2 2 49
## 6 1 3 49
## 7 2 1 30
## 8 2 2 53
## 9 2 3 67
## 10 1 1 30
## 11 2 2 49
## 12 2 1 33
## 13 2 3 63
## 14 1 1 33
## 15 1 1 29
## 16 2 3 72
## 17 2 1 35
## 18 1 2 51Part 2 D)
Now to test the hypothesis we will perform the ANOVA test and gad(model)
model<- aov(observations~factorA+factorB+factorA*factorB,data = df)
GAD::gad(model)## Analysis of Variance Table
##
## Response: observations
## Df Sum Sq Mean Sq F value Pr(>F)
## factorA 1 220.5 220.50 4.7419 0.1613
## factorB 2 2556.8 1278.39 66.1236 3.315e-07 ***
## factorA:factorB 2 93.0 46.50 2.4052 0.1323
## Residual 12 232.0 19.33
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1From the results of the ANOVA and gad model test, the p-value of interaction of factorA and FactorB is 0.1323. As p-value is greater than the alpha 0.05, we conclude that we failed to reject the null hypothesis.Hence we conclude that interaction is not significant
p-value of Factor A is 0.1613
p-value of Factor B is 3.315e-07
To get better idea about the interaction effects of FactorA and FactorB we will plot interaction plots
interaction.plot(factorA, factorB,observations, type = "l", ylab = "obs", xlab = "FactorA", main = "Interaction Plot", col = c("darkred", "black"))
From interaction plots we can see that the interaction is not significant
Now we will perform the ANOVA Test and gad model without considering the interaction
model1 <- aov(observations~factorA+factorB,data = df)
GAD::gad(model1)## Analysis of Variance Table
##
## Response: observations
## Df Sum Sq Mean Sq F value Pr(>F)
## factorA 1 220.5 220.50 9.4985 0.008118 **
## factorB 2 2556.8 1278.39 55.0691 2.32e-07 ***
## Residual 14 325.0 23.21
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1From the results of the ANOVA and gad model test, the p-value of factorA and factorB is 0.008118 and 2.32e-07 respectively. As p-value is lower than the alpha 0.05, we conclude that we reject the null hypothesis and main effects are significant.
plot(model,col="darkred")From the residual plot we can conclude that the our data is normally distributed except few out liners
From residuals vs fitted plots we can see that variances are widely spread, hence we conclude that variances are not constant
Project Part 3
Part 3 A)
Model Equation for four factor interaction:
\(Y_{ijkl} = \mu + \alpha_i + \beta_j + \gamma_k+ \delta_l+ \alpha\beta_ij + \alpha\gamma_ik+ \beta\gamma_jk + \alpha\delta_il+ \beta\delta_jl+ \gamma\delta_kl+ \alpha\beta\gamma_ijk + \alpha\beta\delta_ijl + \alpha\gamma\delta_ikl + \beta\gamma\delta_jkl + \alpha\beta\gamma\delta_ijkl + \epsilon_ijkl\)
Where
\(\alpha_i\) is Main Effects of Factor A (pin elevation)
\(\beta_j\) is Main Effects of Factor B (Bungee Position)
\(\gamma_k\) is Main Effects of Factor C (Release Angle)
\(\delta_l\) is Main Effects of Factor D (Ball Type)
\(\alpha\beta_ij\) is Interaction effects of Factors A and Factors B
\(\alpha\gamma_ik\) is Interaction effects of Factors A and Factors C
\(\beta\gamma_jk\) is Interaction effects of Factors B and Factors C
\(\alpha\delta_il\) is Interaction effects of Factors A and Factors D
\(\beta\delta_jl\) is Interaction effects of Factors B and Factors D
\(\gamma\delta_kl\) is Interaction effects of Factors C and Factors D
\(\alpha\beta\gamma_ijk\) is Interaction effects of Factors A, Factors B and Factors C
\(\alpha\beta\delta_ijl\) is Interaction effects of Factors A, Factors B and Factors D
\(\alpha\gamma\delta_ikl\) is Interaction effects of Factors A, Factors C and Factors D
\(\beta\gamma\delta_jkl\) is Interaction effects of Factors B, Factors C and Factors D
\(\alpha\beta\gamma\delta_ijkl\) is Interaction effects of Factors A, Factors B, Factors C and Factors D
\(\epsilon_ijkl\) is error
Part 3 B)
library(GAD)
library(agricolae)
treat<-c(2,2,2,2)
d<-design.ab(treat,1,design = "crd",seed= 1111644)
design<-d$book
design## plots r A B C D
## 1 101 1 1 2 1 1
## 2 102 1 2 2 2 1
## 3 103 1 1 2 2 1
## 4 104 1 1 2 2 2
## 5 105 1 1 2 1 2
## 6 106 1 2 1 1 1
## 7 107 1 2 1 2 2
## 8 108 1 2 2 1 1
## 9 109 1 1 1 1 2
## 10 110 1 1 1 1 1
## 11 111 1 2 2 1 2
## 12 112 1 2 1 1 2
## 13 113 1 1 1 2 1
## 14 114 1 2 2 2 2
## 15 115 1 1 1 2 2
## 16 116 1 2 1 2 1library(DoE.base)## Loading required package: grid## Loading required package: conf.design## Registered S3 method overwritten by 'DoE.base':
## method from
## factorize.factor conf.design##
## Attaching package: 'DoE.base'## The following objects are masked from 'package:stats':
##
## aov, lm## The following object is masked from 'package:graphics':
##
## plot.design## The following object is masked from 'package:base':
##
## lengthsA<-c(-1,1,-1,-1,-1,1,1,1,-1,-1,1,1,-1,1,-1,1)
B<-c(1,1,1,1,1,-1,-1,1,-1,-1,1,-1,-1,1,-1,-1)
C<-c(-1,1,1,1,-1,-1,1,-1,-1,-1,-1,-1,1,1,1,1)
D<-c(-1,-1,-1,1,1,-1,1,-1,1,-1,1,1,-1,1,1,-1)
obs<-c(34,68,48,40,30,42,57,43,33,27,42,37,37,57,38,66)
dat<-data.frame(A,B,C,D,obs)
dat## A B C D obs
## 1 -1 1 -1 -1 34
## 2 1 1 1 -1 68
## 3 -1 1 1 -1 48
## 4 -1 1 1 1 40
## 5 -1 1 -1 1 30
## 6 1 -1 -1 -1 42
## 7 1 -1 1 1 57
## 8 1 1 -1 -1 43
## 9 -1 -1 -1 1 33
## 10 -1 -1 -1 -1 27
## 11 1 1 -1 1 42
## 12 1 -1 -1 1 37
## 13 -1 -1 1 -1 37
## 14 1 1 1 1 57
## 15 -1 -1 1 1 38
## 16 1 -1 1 -1 66model<-lm(obs~A*B*C*D,data = dat)
coef(model)## (Intercept) A B C D A:B
## 43.6875 7.8125 1.5625 7.6875 -1.9375 -0.5625
## A:C B:C A:D B:D C:D A:B:C
## 2.8125 0.3125 -1.3125 -1.0625 -1.4375 -0.8125
## A:B:D A:C:D B:C:D A:B:C:D
## 1.3125 -0.3125 -0.3125 -0.4375halfnormal(model)##
## Significant effects (alpha=0.05, Lenth method):## [1] A C
model1<-aov(obs~A+C+A*C,data = dat)
summary(model1)## Df Sum Sq Mean Sq F value Pr(>F)
## A 1 976.6 976.6 51.230 1.15e-05 ***
## C 1 945.6 945.6 49.603 1.35e-05 ***
## A:C 1 126.6 126.6 6.639 0.0242 *
## Residuals 12 228.7 19.1
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1From the results of halfnormal plot we can conclude that factors A and C seems to be significant.
Part 3 C)
Model Equation of significant factor
\(Y_{ik} = \mu + \alpha_i + \gamma_k+ \alpha\gamma_ik + \epsilon_ik\)
Where
\(\alpha_i\) is Main Effects of Factor A (pin elevation)
\(\gamma_k\) is Main Effects of Factor C (Release Angle)
\(\alpha\gamma_ik\) is Interaction effects of Factors A and Factors C
\(\epsilon_ijkl\) is error
Part 3 D)
Testing higher level interaction hypothesis first
Hypothesis to be tested first
Null Hypothesis(H0)= Interaction effect of Factor A and C is significant
Alternate Hypothesis(Ha)= Interaction effect of Factor A, and C is not significant
From the results of the ANOVA table, the p-value of interaction of factor A and Factor C is 0.0242. As p-value is lesser than the alpha 0.05, we conclude that we reject the null hypothesis. Hence we conclude that interaction is significant
As we rejected the null hypothesis for interaction we must stop exploration on the associated factors
According to the ANOVA table, the p-value for factor A is 1.15e-05 and for factor C is 1.35e-05.
ALL CODE
library(pwr)
pwr.anova.test(k=3,n=NULL,f=((0.5*sqrt((3^2)-1))/(2*3)),sig.level = 0.05,power = 0.75)
library(agricolae)
designlevel<-c("yellow ball","red ball","black ball")
experimentdesign<-design.crd(designlevel,r=53,seed=15789)
experimentdesign$book
design<-as.data.frame(experimentdesign$book)
library(readxl)
excelfile<-read_excel("E:/Texas Tech/Blckboard Material/Project Part1 Data F.xlsx")
dataframe<-as.data.frame(excelfile)
dataframe
excelfile$Observations<-as.numeric(excelfile$Observations)
excelfile$designlevel<-as.factor(excelfile$designlevel)
boxplot(excelfile$Observations~excelfile$designlevel,main="Comparing Boxplot for Blackball, Redball and Yellowball", col=c("gray60","red","yellow"))
aov.model<-aov(excelfile$Observations~excelfile$designlevel,data = dataframe)
summary(aov.model)
plot(aov.model,col="darkred")
library("MASS")
boxcox(aov.model)
lambda = -1.65
dataframe2<-dataframe
dataframe2$Observations<-(dataframe2$Observations)^lambda
dataframe2$Observations
aov.model1<-aov(dataframe2$Observations~dataframe2$designlevel,data = dataframe2)
summary(aov.model1)
plot(aov.model1,col="darkred")
library(agricolae)
tukeyHSD<-TukeyHSD(aov.model1)
tukeyHSD
plot(tukeyHSD, col="darkred")
library(GAD)
library(agricolae)
treat<-c(2,3)
d<-design.ab(treat,3,design = "crd",seed= 1111644)
design<-d$book
design
factorA <-c("1","1","1","1","2","1","2","2","2","1","2","2","2","1","1","2","2","1")
factorB <-c("2","3","3","2","2","3","1","2","3","1","2","1","3","1","1","3","1","2")
observations <- c(37,54,60,45,49,49,30,53,67,30,49,33,63,33,29,72,35,51)
df<- data.frame(factorA,factorB,observations)
df$factorA <- as.fixed(df$factorA)
df$factorB <- as.random(df$factorB)
df
model <- aov(observations~factorA+factorB+factorA*factorB,data = df)
GAD::gad(model)
interaction.plot(factorA, factorB,observations, type = "l", ylab = "obs", xlab = "FactorA", main = "Interaction Plot", col = c("darkred", "black"))
model1 <- aov(observations~factorA+factorB,data = df)
GAD::gad(model1)
plot(model,col="darkred")
library(GAD)
library(agricolae)
treat<-c(2,2,2,2)
d<-design.ab(treat,1,design = "crd",seed= 1111644)
design<-d$book
design
library(DoE.base)
A<-c(-1,1,-1,-1,-1,1,1,1,-1,-1,1,1,-1,1,-1,1)
B<-c(1,1,1,1,1,-1,-1,1,-1,-1,1,-1,-1,1,-1,-1)
C<-c(-1,1,1,1,-1,-1,1,-1,-1,-1,-1,-1,1,1,1,1)
D<-c(-1,-1,-1,1,1,-1,1,-1,1,-1,1,1,-1,1,1,-1)
obs<-c(34,68,48,40,30,42,57,43,33,27,42,37,37,57,38,66)
dat<-data.frame(A,B,C,D,obs)
dat
model<-lm(obs~A*B*C*D,data = dat)
coef(model)
halfnormal(model)
model1<-aov(obs~A+C+A*C,data = dat)
summary(model1)Acknowledgement
Our group would like to thank Dr. Timothy Matis for his help and guidance at every stage of project. We would also like to thank Mr. Pritom Mondal for helping and guiding us.
References used
Design of Experiments course material provided by Dr. Timothy Matis.
Montgomery, Douglas C.Design and Analysis of Experiments United Kingdom, Wiley, 2013.