Proker BPS

#BPS September | Korelasi
#Korelasi Pearson
data=read.table(file.choose(), header=T)
data

##        X      Y
## 1  253.9  88733
## 2  357.6  26769
## 3  298.1  19986
## 4  313.2 174516
## 5  412.8  71109
## 6  234.2  66245
## 7  324.8 167832
## 8  344.8  83219
## 9  373.3  84867
## 10  99.2  10765

shapiro.test(data$X)

## 
##  Shapiro-Wilk normality test
## 
## data:  data$X
## W = 0.90973, p-value = 0.2791

shapiro.test(data$Y)

## 
##  Shapiro-Wilk normality test
## 
## data:  data$Y
## W = 0.89078, p-value = 0.173

cor.test(data$X,data$Y,method='pearson') 

## 
##  Pearson's product-moment correlation
## 
## data:  data$X and data$Y
## t = 0.95938, df = 8, p-value = 0.3655
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.3865977  0.7908885
## sample estimates:
##       cor 
## 0.3212166

#Korelasi Spearman
data = read.table(file.choose(), header=T)
data

##    KabupatenKota Wisatawan        PAD
## 1   Kab_Jembrana    828046  175992613
## 2    Kab_Tabanan    991864  436408393
## 3     Kab_Badung   4631992 3705745447
## 4    Kab_Gianyar   1271999  857553633
## 5  Kab_Klungkung    764254  309462458
## 6     Kab_Bangli    922264  144005843
## 7 Kab_Karangasem   1319339  301332231
## 8   Kab_Buleleng   1545531  410564892
## 9  Kota_Denpasar   1984425  888051856

shapiro.test(data$Wisatawan)

## 
##  Shapiro-Wilk normality test
## 
## data:  data$Wisatawan
## W = 0.67598, p-value = 0.0007436

shapiro.test(data$PAD)

## 
##  Shapiro-Wilk normality test
## 
## data:  data$PAD
## W = 0.59737, p-value = 8.911e-05

cor.test(data$Wisatawan, data$PAD, method = 'spearman')

## 
##  Spearman's rank correlation rho
## 
## data:  data$Wisatawan and data$PAD
## S = 34, p-value = 0.03687
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.7166667

#Korelasi Kendall Tau
x <- c(1.5,2,3.5,4,2.5,5,3,4.5,2,1)
y <- c(82,76,81,68,88,72,74,65,79,91)

cor.test(x,y, method="kendall")

## Warning in cor.test.default(x, y, method = "kendall"): Cannot compute exact
## p-value with ties

## 
##  Kendall's rank correlation tau
## 
## data:  x and y
## z = -2.5145, p-value = 0.01192
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
##        tau 
## -0.6292532

#Koefisien Kontingensi C
data <- matrix(c(17, 88, 11, 84), nrow = 2, byrow = T)
dimnames(data)<-list(c("Berisiko", "Tidak Berisiko"),
                     c("BBLR", "Non BBLR"))
names(dimnames(data))<-c("umur_ibu_hamil", "BBL")
data

##                 BBL
## umur_ibu_hamil   BBLR Non BBLR
##   Berisiko         17       88
##   Tidak Berisiko   11       84

addmargins(data) 

##                 BBL
## umur_ibu_hamil   BBLR Non BBLR Sum
##   Berisiko         17       88 105
##   Tidak Berisiko   11       84  95
##   Sum              28      172 200

N<-sum(data)
library(MASS)
chisq<- loglm(~umur_ibu_hamil+BBL, data = data)
chisq 

## Call:
## loglm(formula = ~umur_ibu_hamil + BBL, data = data)
## 
## Statistics:
##                        X^2 df  P(> X^2)
## Likelihood Ratio 0.8885623  1 0.3458672
## Pearson          0.8809399  1 0.3479444

x2<- 0.8809399
koef<-sqrt(x2/(N+x2))
koef 

## [1] 0.06622223