1. Vòng lặp for
options(warn=-1)
n <-1:10
for (i in n){
print(i)
print(paste("Biến thứ ",i, " rồi"))
assign(paste("bien", i, sep = ""), i)
}
## [1] 1
## [1] "Biến thứ 1 rồi"
## [1] 2
## [1] "Biến thứ 2 rồi"
## [1] 3
## [1] "Biến thứ 3 rồi"
## [1] 4
## [1] "Biến thứ 4 rồi"
## [1] 5
## [1] "Biến thứ 5 rồi"
## [1] 6
## [1] "Biến thứ 6 rồi"
## [1] 7
## [1] "Biến thứ 7 rồi"
## [1] 8
## [1] "Biến thứ 8 rồi"
## [1] 9
## [1] "Biến thứ 9 rồi"
## [1] 10
## [1] "Biến thứ 10 rồi"
ls()
## [1] "bien1" "bien10" "bien2" "bien3" "bien4" "bien5" "bien6" "bien7"
## [9] "bien8" "bien9" "i" "n"
bien1
## [1] 1
bien2
## [1] 2
bien3
## [1] 3
m <-c("Tôi", "không", "cô đơn", "mà em gian", "em dối")
for ( i in m) {
print(paste("hiện thị:",i))
}
## [1] "hiện thị: Tôi"
## [1] "hiện thị: không"
## [1] "hiện thị: cô đơn"
## [1] "hiện thị: mà em gian"
## [1] "hiện thị: em dối"
2. Ứng dụng
#tt <-rep(c(4:5),150)
a <-rep(c(1:5),c(10,50,90,100,150))
p<-0.3
#chuan <-replace(a,rbinom(400,1,0.2),tt)
sx4 <- 1:400
data4 <-data.frame(sx4)
for(i in 1:5){
tt <-rep(c(4:5),200)
chuan <-replace(a,rbinom(400,1,p)==1,tt)
assign(paste("a", i, sep = ""), chuan)->luu
#data4 <-cbind(data4,luu)
data4[paste0("bien",i)] <-luu
}
head(data4)
## sx4 bien1 bien2 bien3 bien4 bien5
## 1 1 4 1 1 4 1
## 2 2 1 1 1 1 1
## 3 3 1 1 4 5 4
## 4 4 1 4 1 4 1
## 5 5 1 1 1 1 1
## 6 6 1 1 1 1 1
sx <- runif(400)
nhoma <-cbind(a1, a2, a3, a4, a5, sx)
nhoma <-nhoma[order(sx),]
head(nhoma)
## a1 a2 a3 a4 a5 sx
## [1,] 5 5 5 5 5 3.090012e-05
## [2,] 5 5 5 5 5 2.438878e-03
## [3,] 5 5 4 5 5 2.977376e-03
## [4,] 3 5 3 4 3 6.702971e-03
## [5,] 5 5 5 5 5 7.686776e-03
## [6,] 4 4 4 4 4 1.009240e-02
library(psych)
alpha(nhoma[,1:5])
##
## Reliability analysis
## Call: alpha(x = nhoma[, 1:5])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.88 0.88 0.86 0.6 7.6 0.0092 4 0.86 0.59
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.86 0.88 0.9
## Duhachek 0.87 0.88 0.9
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## a1 0.86 0.86 0.82 0.60 6.0 0.012 0.00053 0.60
## a2 0.86 0.86 0.82 0.60 6.1 0.011 0.00107 0.59
## a3 0.86 0.86 0.82 0.60 6.1 0.012 0.00117 0.59
## a4 0.87 0.87 0.83 0.62 6.4 0.011 0.00074 0.62
## a5 0.85 0.85 0.81 0.59 5.7 0.012 0.00017 0.59
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## a1 400 0.83 0.83 0.77 0.72 4.0 1.0
## a2 400 0.82 0.82 0.76 0.71 4.1 1.0
## a3 400 0.83 0.83 0.76 0.72 4.0 1.0
## a4 400 0.80 0.80 0.73 0.69 4.0 1.0
## a5 400 0.85 0.85 0.80 0.75 4.0 1.1
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## a1 0.01 0.09 0.15 0.32 0.42 0
## a2 0.01 0.09 0.16 0.32 0.43 0
## a3 0.02 0.09 0.16 0.34 0.39 0
## a4 0.01 0.08 0.17 0.32 0.42 0
## a5 0.02 0.09 0.16 0.32 0.42 0
3. Lồng 2 vòng lặp
m <- c("b","c","d","e")
n <- 1:5
sig <-0.3
for (j in m) {
for (i in n){
tt <-rep(c(4:5),150)
chuan <-replace(a,rbinom(400,1,sig)==1,tt)
assign(paste(j, i, sep = ""), chuan)
}
}
ls()
## [1] "a" "a1" "a2" "a3" "a4" "a5" "b1" "b2"
## [9] "b3" "b4" "b5" "bien1" "bien10" "bien2" "bien3" "bien4"
## [17] "bien5" "bien6" "bien7" "bien8" "bien9" "c1" "c2" "c3"
## [25] "c4" "c5" "chuan" "d1" "d2" "d3" "d4" "d5"
## [33] "data4" "e1" "e2" "e3" "e4" "e5" "i" "j"
## [41] "luu" "m" "n" "nhoma" "p" "sig" "sx" "sx4"
## [49] "tt"
dulieu <-cbind(a1,a2,a3,a4,a5,b1,b2,b3,b4,b5,c1,c2,c3,c4,c5,d1,d2,d3,d4,d5,e1,e2,e3,e4,e5)
head(dulieu)
## a1 a2 a3 a4 a5 b1 b2 b3 b4 b5 c1 c2 c3 c4 c5 d1 d2 d3 d4 d5 e1 e2 e3 e4 e5
## [1,] 4 1 1 4 1 4 1 1 1 1 4 1 1 4 4 1 1 1 1 4 4 4 4 4 1
## [2,] 1 1 1 1 1 5 1 1 1 1 1 1 1 1 5 1 1 1 4 1 1 1 5 5 1
## [3,] 1 1 4 5 4 1 1 4 1 1 1 1 1 1 4 1 1 1 1 1 1 1 1 4 4
## [4,] 1 4 1 4 1 1 4 1 4 4 5 1 1 1 5 4 1 1 1 5 1 1 4 1 5
## [5,] 1 1 1 1 1 4 1 1 5 1 1 1 1 1 1 1 1 1 1 4 5 5 1 1 4
## [6,] 1 1 1 1 1 1 1 1 1 5 1 1 1 1 4 5 1 1 5 1 1 4 1 1 5
alpha(dulieu[,1:5])
##
## Reliability analysis
## Call: alpha(x = dulieu[, 1:5])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.88 0.88 0.86 0.6 7.6 0.0092 4 0.86 0.59
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.86 0.88 0.9
## Duhachek 0.87 0.88 0.9
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## a1 0.86 0.86 0.82 0.60 6.0 0.012 0.00053 0.60
## a2 0.86 0.86 0.82 0.60 6.1 0.011 0.00107 0.59
## a3 0.86 0.86 0.82 0.60 6.1 0.012 0.00117 0.59
## a4 0.87 0.87 0.83 0.62 6.4 0.011 0.00074 0.62
## a5 0.85 0.85 0.81 0.59 5.7 0.012 0.00017 0.59
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## a1 400 0.83 0.83 0.77 0.72 4.0 1.0
## a2 400 0.82 0.82 0.76 0.71 4.1 1.0
## a3 400 0.83 0.83 0.76 0.72 4.0 1.0
## a4 400 0.80 0.80 0.73 0.69 4.0 1.0
## a5 400 0.85 0.85 0.80 0.75 4.0 1.1
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## a1 0.01 0.09 0.15 0.32 0.42 0
## a2 0.01 0.09 0.16 0.32 0.43 0
## a3 0.02 0.09 0.16 0.34 0.39 0
## a4 0.01 0.08 0.17 0.32 0.42 0
## a5 0.02 0.09 0.16 0.32 0.42 0
alpha(dulieu[,6:10])
##
## Reliability analysis
## Call: alpha(x = dulieu[, 6:10])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.88 0.88 0.86 0.6 7.5 0.0093 4 0.86 0.6
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.86 0.88 0.9
## Duhachek 0.86 0.88 0.9
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## b1 0.87 0.87 0.83 0.62 6.4 0.011 0.00044 0.62
## b2 0.85 0.85 0.82 0.59 5.9 0.012 0.00097 0.60
## b3 0.86 0.86 0.82 0.60 6.0 0.012 0.00173 0.61
## b4 0.85 0.85 0.82 0.59 5.8 0.012 0.00140 0.59
## b5 0.86 0.86 0.82 0.60 6.0 0.012 0.00037 0.60
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## b1 400 0.80 0.80 0.73 0.68 4 1.0
## b2 400 0.83 0.83 0.78 0.73 4 1.0
## b3 400 0.82 0.82 0.76 0.72 4 1.0
## b4 400 0.84 0.84 0.79 0.74 4 1.1
## b5 400 0.83 0.83 0.77 0.72 4 1.0
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## b1 0.02 0.07 0.16 0.34 0.41 0
## b2 0.02 0.09 0.15 0.34 0.41 0
## b3 0.02 0.09 0.16 0.31 0.43 0
## b4 0.02 0.09 0.17 0.30 0.42 0
## b5 0.02 0.08 0.17 0.32 0.41 0
alpha(dulieu[,11:15])
##
## Reliability analysis
## Call: alpha(x = dulieu[, 11:15])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.88 0.88 0.86 0.6 7.5 0.0093 4 0.85 0.6
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.86 0.88 0.9
## Duhachek 0.86 0.88 0.9
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## c1 0.86 0.86 0.82 0.60 6.1 0.011 0.00307 0.59
## c2 0.85 0.85 0.82 0.59 5.9 0.012 0.00193 0.58
## c3 0.85 0.85 0.81 0.59 5.6 0.012 0.00055 0.60
## c4 0.85 0.85 0.82 0.59 5.8 0.012 0.00163 0.59
## c5 0.87 0.87 0.83 0.62 6.5 0.011 0.00179 0.60
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## c1 400 0.81 0.82 0.75 0.70 4 1.0
## c2 400 0.83 0.83 0.78 0.73 4 1.1
## c3 400 0.85 0.84 0.80 0.75 4 1.1
## c4 400 0.84 0.83 0.78 0.73 4 1.1
## c5 400 0.79 0.80 0.72 0.67 4 1.0
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## c1 0.01 0.08 0.17 0.34 0.40 0
## c2 0.02 0.09 0.18 0.32 0.39 0
## c3 0.02 0.09 0.16 0.32 0.41 0
## c4 0.02 0.10 0.15 0.33 0.40 0
## c5 0.01 0.09 0.17 0.34 0.40 0
alpha(dulieu[,16:20])
##
## Reliability analysis
## Call: alpha(x = dulieu[, 16:20])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.86 0.86 0.84 0.56 6.3 0.011 4 0.83 0.56
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.84 0.86 0.88
## Duhachek 0.84 0.86 0.89
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## d1 0.84 0.84 0.80 0.57 5.2 0.013 0.00283 0.56
## d2 0.82 0.82 0.78 0.54 4.6 0.014 0.00092 0.54
## d3 0.83 0.83 0.79 0.55 4.8 0.014 0.00158 0.55
## d4 0.84 0.84 0.80 0.57 5.3 0.013 0.00157 0.57
## d5 0.85 0.85 0.81 0.58 5.5 0.013 0.00140 0.57
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## d1 400 0.79 0.80 0.72 0.67 4.0 1.0
## d2 400 0.84 0.84 0.79 0.73 4.0 1.1
## d3 400 0.82 0.82 0.77 0.71 4.0 1.0
## d4 400 0.79 0.79 0.71 0.66 4.1 1.0
## d5 400 0.78 0.78 0.69 0.64 4.1 1.0
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## d1 0.02 0.08 0.16 0.35 0.40 0
## d2 0.02 0.09 0.17 0.32 0.40 0
## d3 0.02 0.08 0.14 0.35 0.41 0
## d4 0.02 0.07 0.16 0.32 0.43 0
## d5 0.02 0.08 0.14 0.34 0.42 0
alpha(dulieu[,21:25])
##
## Reliability analysis
## Call: alpha(x = dulieu[, 21:25])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.86 0.86 0.83 0.55 6.1 0.011 4.1 0.81 0.55
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.84 0.86 0.88
## Duhachek 0.84 0.86 0.88
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## e1 0.83 0.83 0.79 0.55 4.9 0.014 0.0016 0.55
## e2 0.82 0.82 0.78 0.54 4.7 0.014 0.0018 0.53
## e3 0.83 0.83 0.79 0.55 4.8 0.014 0.0022 0.56
## e4 0.83 0.83 0.79 0.55 4.9 0.014 0.0012 0.55
## e5 0.84 0.84 0.80 0.56 5.2 0.013 0.0007 0.57
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## e1 400 0.80 0.80 0.73 0.68 4.0 1
## e2 400 0.82 0.82 0.76 0.70 4.1 1
## e3 400 0.80 0.80 0.74 0.68 4.0 1
## e4 400 0.80 0.80 0.73 0.67 4.1 1
## e5 400 0.78 0.78 0.70 0.65 4.1 1
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## e1 0.01 0.09 0.16 0.32 0.42 0
## e2 0.02 0.09 0.14 0.33 0.43 0
## e3 0.01 0.09 0.16 0.34 0.41 0
## e4 0.01 0.09 0.14 0.34 0.43 0
## e5 0.01 0.09 0.16 0.33 0.41 0
4. Lồng thực tế
a <-rep(c(1:5),c(10,50,90,100,150))
m <- c("b","c","d","e")
n <- 1:5
sig <-0.3
t <-0.7
tt <-rep(c(4:5),150)
for (j in m) {
assign(paste(j,sep=""), replace( a,rbinom(400,1,t)==1,tt)) ->tam
for (i in n){
chuan <-replace( tam ,rbinom(400,1,sig)==1,tt)
assign(paste(j, i, sep = ""), chuan)
}
}
data <-cbind(b,c,d,e)
cor(data)
## b c d e
## b 1.00000000 0.1517921 0.2726068 0.07545083
## c 0.15179208 1.0000000 0.2214189 0.10488025
## d 0.27260682 0.2214189 1.0000000 0.14038455
## e 0.07545083 0.1048803 0.1403845 1.00000000
head(data,20)
## b c d e
## [1,] 1 4 4 1
## [2,] 1 5 1 4
## [3,] 1 1 1 5
## [4,] 4 4 5 4
## [5,] 1 5 1 5
## [6,] 1 1 1 4
## [7,] 5 4 4 5
## [8,] 4 5 5 4
## [9,] 1 4 4 5
## [10,] 5 5 5 4
## [11,] 4 4 4 5
## [12,] 5 5 5 4
## [13,] 4 2 4 5
## [14,] 5 4 2 4
## [15,] 4 5 2 2
## [16,] 2 2 5 5
## [17,] 5 4 2 2
## [18,] 4 5 2 4
## [19,] 5 4 4 5
## [20,] 4 5 5 4
nrow(data)
## [1] 400
alpha(data)
##
## Reliability analysis
## Call: alpha(x = data)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.44 0.43 0.37 0.16 0.77 0.046 4.3 0.5 0.15
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.34 0.44 0.52
## Duhachek 0.35 0.44 0.53
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## b 0.36 0.36 0.27 0.16 0.55 0.056 0.0036 0.14
## c 0.37 0.37 0.29 0.16 0.58 0.054 0.0101 0.14
## d 0.27 0.27 0.20 0.11 0.37 0.063 0.0015 0.10
## e 0.45 0.45 0.36 0.22 0.82 0.047 0.0037 0.22
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## b 400 0.62 0.62 0.39 0.26 4.3 0.81
## c 400 0.60 0.61 0.36 0.24 4.3 0.79
## d 400 0.69 0.67 0.50 0.33 4.3 0.86
## e 400 0.54 0.54 0.23 0.16 4.3 0.81
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## b 0.01 0.02 0.06 0.44 0.46 0
## c 0.00 0.04 0.06 0.42 0.48 0
## d 0.01 0.05 0.07 0.43 0.45 0
## e 0.00 0.04 0.08 0.42 0.45 0
dulieu2 <-cbind(a1,a2,a3,a4,a5,b1,b2,b3,b4,b5,c1,c2,c3,c4,c5,d1,d2,d3,d4,d5,e1,e2,e3,e4,e5)
head(dulieu2)
## a1 a2 a3 a4 a5 b1 b2 b3 b4 b5 c1 c2 c3 c4 c5 d1 d2 d3 d4 d5 e1 e2 e3 e4 e5
## [1,] 4 1 1 4 1 1 1 4 1 1 4 4 4 4 4 4 4 4 4 4 1 1 1 1 1
## [2,] 1 1 1 1 1 4 1 5 1 1 5 5 5 5 4 1 1 1 1 1 4 4 4 4 4
## [3,] 1 1 4 5 4 1 4 4 1 1 1 1 1 1 1 1 4 1 1 1 5 5 5 5 5
## [4,] 1 4 1 4 1 4 4 4 4 4 5 4 4 4 4 5 5 5 4 5 4 4 4 4 4
## [5,] 1 1 1 1 1 1 5 1 1 4 5 5 5 5 5 1 4 1 1 1 4 4 5 5 5
## [6,] 1 1 1 1 1 1 1 5 1 1 1 4 1 1 4 1 5 5 1 1 4 4 4 4 4
5. Data bán hàng
price_ao <-round(rnorm(120,120,20))
price_bs <- price_ao*0.4 + round(rnorm(120,120,20)*0.8)
price_bl <- price_ao*0.5 + round(rnorm(120,120,20)*0.9)
price_xk <- price_ao*0.6 + round(rnorm(120,120,20)*1.1)
price_tom <- cbind(price_ao,price_bs,price_bl, price_xk)
6. Làm data - Working
obs <-300
m <-5
n <-5
p <-0.5
sig <-0.3
a <-rep(c(1:5),c(0.05*obs,0.1*obs,0.15*obs,0.2*obs,0.5*obs))
tt <-rep(c(4:5),round(obs/2))
stt <- 1:obs
so <- runif(obs)
dlieu10 <- cbind(stt,so)
for (j in LETTERS[1:m]) {
doi <- replace( a,rbinom(obs,1,p)==1,tt)
assign(paste0(j), doi ) ->tam
for (i in 1:n){
chuan <-replace( tam ,rbinom(obs,1,1-sig)==1,tt)
assign(paste0(j, i), chuan) ->tam2
tam2 <-data.frame(tam2)
colnames(tam2) <- paste0(j,i)
dlieu10 <- cbind(dlieu10,tam2)
}
}
#dulieu10 <- cbind(A, B, C, D, E)
#cor(dulieu10)
head(dlieu10)
## stt so A1 A2 A3 A4 A5 B1 B2 B3 B4 B5 C1 C2 C3 C4 C5 D1 D2 D3 D4 D5 E1
## 1 1 0.2343226 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 1 4 1 1 4 4
## 2 2 0.6652296 5 1 1 4 5 5 5 5 5 5 5 5 5 5 5 4 4 4 4 5 5
## 3 3 0.8685988 4 5 5 5 5 4 4 4 1 1 4 1 4 1 1 5 5 5 5 4 5
## 4 4 0.3234389 5 4 4 4 4 4 5 5 5 5 5 4 5 4 4 1 4 1 4 1 1
## 5 5 0.4804096 4 5 5 5 1 5 4 4 5 4 4 5 4 4 5 4 5 4 5 5 4
## 6 6 0.9257067 5 4 5 5 5 4 5 5 4 5 5 4 5 4 5 5 5 5 5 4 5
## E2 E3 E4 E5
## 1 4 4 4 4
## 2 5 5 4 5
## 3 4 4 5 5
## 4 5 5 4 4
## 5 1 1 5 5
## 6 1 4 4 1
7. Làm hàm lặp for
lamthangdo <- function(obs,m,n,p,sig){
set.seed(123)
cong <- round(0.05*obs) + round(0.15*obs) + round(0.25*obs) + round(0.25*obs)
a <-rep(c(1:5),c(round(0.05*obs),round(0.15*obs),round(0.25*obs),round(0.25*obs),obs-cong))
tt <-rep(c(4:5),round(obs/2))
stt <- 1:obs
so <- runif(obs)
dlieu10 <- cbind(stt,so)
nhoj <-LETTERS[1:m]
nhoi <- c(1:n)
for (j in nhoj) {
doi <- replace( a,rbinom(obs,1,p)==1,tt)
assign(paste0(j), doi ) ->tam
for (i in nhoi){
chuan <-replace( tam ,rbinom(obs,1,sig)==1,tt)
#assign(paste0(j, i), chuan) ->tam2
chuan <-data.frame(chuan)
colnames(chuan) <- paste0(j,i)
dlieu10 <- cbind(dlieu10,chuan)
dlieu10 <-data.frame(dlieu10)
}
}
return(dlieu10)
}
thidu <-cbind(A,B,C,D,E)
cor(thidu)
## A B C D E
## A 1.0000000 0.2057382 0.3320778 0.3310642 0.4689280
## B 0.2057382 1.0000000 0.3855567 0.3789542 0.4101372
## C 0.3320778 0.3855567 1.0000000 0.3884089 0.3895274
## D 0.3310642 0.3789542 0.3884089 1.0000000 0.5268461
## E 0.4689280 0.4101372 0.3895274 0.5268461 1.0000000
ls()
## [1] "a" "A" "a1" "A1" "a2"
## [6] "A2" "a3" "A3" "a4" "A4"
## [11] "a5" "A5" "b" "B" "b1"
## [16] "B1" "b2" "B2" "b3" "B3"
## [21] "b4" "B4" "b5" "B5" "bien1"
## [26] "bien10" "bien2" "bien3" "bien4" "bien5"
## [31] "bien6" "bien7" "bien8" "bien9" "c"
## [36] "C" "c1" "C1" "c2" "C2"
## [41] "c3" "C3" "c4" "C4" "c5"
## [46] "C5" "chuan" "d" "D" "d1"
## [51] "D1" "d2" "D2" "d3" "D3"
## [56] "d4" "D4" "d5" "D5" "data"
## [61] "data4" "dlieu10" "doi" "dulieu" "dulieu2"
## [66] "e" "E" "e1" "E1" "e2"
## [71] "E2" "e3" "E3" "e4" "E4"
## [76] "e5" "E5" "i" "j" "lamthangdo"
## [81] "luu" "m" "n" "nhoma" "obs"
## [86] "p" "price_ao" "price_bl" "price_bs" "price_tom"
## [91] "price_xk" "sig" "so" "stt" "sx"
## [96] "sx4" "t" "tam" "tam2" "thidu"
## [101] "tt"
8. làm lặp while
lamthangdo <- function(obs,m,n,p,sig){
set.seed(obs)
j <-1
i <-1
stt <- 1:obs
so <- runif(obs)
solieu10 <- cbind(stt,so)
a <-rep(c(1:5),c(0.05*obs,0.1*obs,0.15*obs,0.2*obs,0.5*obs))
tt <-rep(c(4:5),round(obs/2))
while (j < m +1){
doi <- replace( a,rbinom(obs,1,p)==1,tt)
assign(paste0(j), doi ) ->tam
j = j +1
while(i < n +1){
chuan <-replace( tam ,rbinom(obs,1,sig)==1,tt)
assign(paste0(j, i), chuan) ->tam2
tam2 <-data.frame(tam2)
colnames(tam2) <- paste0(j,i)
solieu10 <- cbind(solieu10,tam2)
i = i +1
}
}
}
layso <-cbind(A,B,C,D,E)
cor(layso)
## A B C D E
## A 1.0000000 0.2057382 0.3320778 0.3310642 0.4689280
## B 0.2057382 1.0000000 0.3855567 0.3789542 0.4101372
## C 0.3320778 0.3855567 1.0000000 0.3884089 0.3895274
## D 0.3310642 0.3789542 0.3884089 1.0000000 0.5268461
## E 0.4689280 0.4101372 0.3895274 0.5268461 1.0000000
9. Tạo biến dữ liệu
lamthangdo <- function(likert,obs,m,n,p,sig){
set.seed(123)
cong <- round(0.05*obs) + round(0.15*obs) + round(0.25*obs) + round(0.25*obs)
a <-rep(c(1:5),c(round(0.05*obs),round(0.15*obs),round(0.25*obs),round(0.25*obs),obs-cong))
cong2 <- round(0.05*obs) + round(0.08*obs)+ round(0.11*obs)+ round(0.16*obs)+ round(0.16*obs)+ round(0.2*obs)
b <-rep(c(1:7), c(round(0.05*obs),round(0.08*obs), round(0.11*obs), round(0.16*obs), round(0.15*obs), round(0.2*obs), obs- cong2))
tt <-rep(c(4:5),round(obs/2))
tt2 <-rep(c(4:7), round(obs/4))
stt <- 1:obs
so <- runif(obs)
dlieu10 <- cbind(stt,so)
nhoj <-LETTERS[1:m]
nhoi <- c(1:n)
if (likert==5){
for (j in nhoj) {
doi <- replace( a,rbinom(obs,1,p)==1,tt)
assign(paste0(j), doi ) ->tam
for (i in nhoi){
chuan <-replace( tam ,rbinom(obs,1,1-sig)==1,tt)
chuan <-data.frame(chuan)
colnames(chuan) <- paste0(j,i)
dlieu10 <- cbind(dlieu10,chuan)
dlieu10 <-data.frame(dlieu10)
}
}
return(dlieu10)
}else{
for (j in nhoj) {
doi <- replace( b,rbinom(obs,1,p)==1,tt2)
assign(paste0(j), doi ) ->tam
for (i in nhoi){
chuan <-replace( tam ,rbinom(obs,1,1-sig)==1,tt2)
chuan <-data.frame(chuan)
colnames(chuan) <- paste0(j,i)
dlieu10 <- cbind(dlieu10,chuan)
dlieu10 <-data.frame(dlieu10)
}
}
return(dlieu10)
}
}
10. Nhập dữ liệu vào data data.frame
library(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, union
datavao <-cbind(x1=" ", x2=" ", x3=" ", x4=" ")
datavao <-data.frame(datavao)
nhapvao <-function( m, n, p, sig){
datavao
datatam <-cbind( x1=m, x2=n, x3=p, x4=sig)
datatam <-data.frame(datatam)
datavao <- rbind(datavao, datatam)
return(datatam)
return(datavao)
}