سلام

چند وقتی پیش یک پست با عنوان در دل گذاشته بودم که صدای بچه های ۸۵ و ۸۶ در اومد . دوستان من با کلمات خیلی راحت بازی نکنید من کی گفتم بچه های ۸۵ یا ۸۶ بی کارند ؟  فقط گفتم ۸۴ ها رو که تو انجمن هستند بیکار محسوب نکنید با ۸۵ و ۸۶ ها هم هیچ حرفی نداریم دسته همشون درد نکنه .

راستی جمعه این هفتمو رو یک برنامه در splus گذاشتم که برای محاسبه ضرایب همبستگی هست که جالبه انصافا ً هم وقت صرف کردم براش ! امیدوارم به دردتون بخوره البته همون طور که مستحضرید ما 3 نوع ضریب همبستگی در درس ناپارامتری داریم و 3 نوع هم در درس چند متغیره که برا چند متغیره هنوز کامل نکردم انشالا... جمعه های بعد   تو این برنامه دو بردار از داده ها را به عنوان شناسه های تابع saeedshiba میدید تا ماتریسی رو که 3 درایه داره را بده اعضای ماتریس به ترتیب ضرایب همبستگی پیرسون - اسپرمن و کندال تائو هستند در ضمن در حین برنامه از تابع هایی مانند tarkib و var1 و saeed و shiba استفاده شده است تابع ترکیب برنامه برای محاسبه ترکیب هست . برنامه var1 برای محاسبه واریانس داده ها با مخرج n هست و برنامه shiba برای محاسبه ضریب اسپرمن هست که داخل آن از تابع saeed استفاده کردم که جهت محاسبه ضریب پیرسون می باشد همچنین تابع کندال برای محاسبه کندال تائو و در آخر این برنامه همه این ضرایب را در یک ماتریس گذاشته و آن را نامگذاری کردم .

saeedshiba<-function(a, b){
 shiba <- function(c, d) {
  saeed <- function(x, y){
     var1 <- function(a)
   {
    c <- (1/(length(a))) * sum((a - mean(a))^2) 
    c
   }
   xy <- x * y
   r <- (mean(xy) - mean(x) * mean(y))/(sqrt(var1(
    x) * var1(y)))
   r
  }
  e <- rank(c)
  t <- rank(d)
  z <- saeed(e, t)
  z
 }
 saeed <- function(x, y)
 {
  var1 <- function(a)
  {
   c <- (1/(length(a))) * sum((a - mean(a))^2)
   c
  }
  xy <- x * y
  r <- (mean(xy) - mean(x) * mean(y))/(sqrt(var1(x) * var1(
   y)))
  r
 }
 kendaltao <- function(x, y)
 {
  tarkib <- function(v, g)
  {
   ta <- (prod(1:g))/((prod(1:v)) * (prod(1:(g - v))))
   ta
  }
  c <- matrix(0, length(x), length(y))
  for(i in 1:length(x)) {
   for(j in 1:length(y)) {
    c[i, j] <- (x[i] - x[j]) * (y[i] - y[j])
   }
  }
  c
  c1 <- c[c > 0]
  p <- length(c1)/2
  t <- ((2 * p)/tarkib(2, length(x))) - 1
  t
 }
 z1 <- matrix(c(saeed(a, b)))
 z2 <- matrix(c(shiba(a, b)))
 z3 <- matrix(c(kendaltao(a, b)))
 dimnames(z1) <- list(paste("Pearson Moment",  ), paste("Correlation",
  ))
 dimnames(z2) <- list(paste("Spearman s Rank",  ), paste(
  "Correlation",  ))
 dimnames(z3) <- list(paste("kendal tao",  ), paste("Correlation",
  ))
 z <- rbind(z1, z2, z3)
 z
}

نوشته شده توسط شیبا در شنبه بیست و یکم اردیبهشت 1387

لينك ثابت