R/RNentropy-internal.R

In RNentropy: Entropy Based Method for the Detection of Significant Variation in Gene Expression Data

# .Random.seed <-
# c(403L, 303L, -1279997594L, 1335792995L, 2038829051L, 1336074530L, 
# -1922600111L, -2006788679L, -1656419531L, -1464503401L, -128771125L, 
# 969065322L, 1830482222L, 1546276327L, -689469879L, -1261585080L, 
# -1149244736L, -1343407046L, 1646723412L, -185901351L, 1967937182L, 
# 969403351L, -1902963060L, -515396845L, -1982867645L, 665122845L, 
# -1193733277L, -1841992328L, 1572904072L, 1739102462L, -1646625431L, 
# 1528255535L, -185085681L, 1942542966L, -1161549903L, 79518671L, 
# -441049305L, 839410451L, -1005235702L, -1496212146L, 102837824L, 
# -914634197L, -1147895344L, 937625169L, -1902957987L, -613255973L, 
# 718750998L, 1597005812L, -804086634L, 1871046643L, -1589786560L, 
# 154150211L, -554668369L, 287196068L, 1967867040L, 1230166630L, 
# -1882591455L, -351001472L, -1681262583L, 664832004L, 1664808339L, 
# -1173383114L, -1717318587L, 912204052L, -571085954L, -835284732L, 
# -915464375L, -731680103L, -223437408L, 678603436L, -666772146L, 
# -321131668L, -375176578L, -29625304L, 659642618L, -534049991L, 
# 1728388926L, 1131650526L, 1123803843L, -206997828L, -1627669423L, 
# 722327311L, 1024895473L, -1153119084L, 334726362L, 340925155L, 
# -107854031L, -1665088783L, -503122908L, -1034863941L, -132603785L, 
# 1614370522L, 614526245L, -825000488L, 391899079L, -1753389537L, 
# 2023809111L, 2111858704L, 697769769L, 51734907L, 613166511L, 
# -1168204944L, -1669683654L, 1866322153L, -1900687557L, -1250313717L, 
# -943340235L, -1396598512L, -350870979L, -203054197L, -685565073L, 
# -382577078L, -428590817L, 181716369L, -1981559013L, 1198438370L, 
# -1831956978L, 1489043897L, 1773604631L, -1237194920L, 1560272599L, 
# -367406924L, 1991746972L, -134974221L, 156364064L, 59368697L, 
# 705661281L, 108943831L, 1579177558L, -1374933441L, -462497159L, 
# -977524141L, -1481298158L, -1843348033L, 1502454282L, 1650050670L, 
# 1756960884L, 1106516960L, 324219624L, -502530488L, -1311383598L, 
# 421217604L, -1263566431L, -494802656L, 271315061L, 2045703693L, 
# -2131088654L, 761201581L, 1369927954L, -1992240866L, -1132842220L, 
# -1444457916L, 2074822609L, 619715589L, 1206580014L, 691202218L, 
# -399019956L, 636567910L, 648583569L, -1326432077L, -563740217L, 
# 1928882868L, -910185144L, -1657904819L, -1771747734L, -905886239L, 
# -287146169L, -1751465190L, 1494863438L, -394804182L, 998416339L, 
# 1759700739L, -2921226L, -423548821L, -1959275324L, 1898987532L, 
# -1071297751L, -1085535501L, -494195342L, 524656542L, -44664669L, 
# 1454052947L, 73919220L, -85974735L, -1910681421L, 1450203805L, 
# 413432811L, -151079353L, -2093231526L, -880377272L, 191714535L, 
# -188448903L, 554883784L, 1050479601L, 1797111669L, 1877305577L, 
# 994339706L, 1742924776L, 869608797L, -1401683175L, -2141890933L, 
# 1103821146L, -614768678L, 460383915L, 905485132L, -1791014909L, 
# 810571458L, 1515700633L, -547598754L, 1343212270L, 1819765638L, 
# 745062346L, 189465154L, 1218445894L, 235725632L, 1639052956L, 
# 653650903L, 1264144743L, 733879087L, -506840881L, 1829625941L, 
# -403247698L, -801372228L, 825066825L, -13528643L, 1422230942L, 
# 2056006537L, 32957252L, 1395971573L, -1495934585L, 303612654L, 
# -1155873667L, 1766998049L, 1139387822L, 670915699L, 91316738L, 
# -159447851L, 322423833L, -1930531796L, 100790156L, -337958977L, 
# -1376000797L, -1173407389L, -1758133029L, -579171569L, 1952567929L, 
# -1683020473L, -373677020L, 1985476495L, 1615497018L, -1060169842L, 
# -1867295384L, 1101780730L, 1516723697L, -805058018L, -858333252L, 
# -1347255732L, 585896047L, 868268995L, -1025518374L, 473451533L, 
# 1295647813L, 1691027889L, 2019396913L, -1269299623L, 1817510467L, 
# -1826434954L, 1488999776L, -166033752L, -1750946602L, 67153758L, 
# 242012451L, -715397547L, -583262108L, 1361271050L, 1975317285L, 
# 1577007589L, 2112049008L, -294238482L, -336842235L, -921852724L, 
# -232515525L, -1995412078L, 530247179L, 1117440349L, -901833175L, 
# -1049728783L, 464994472L, 1234529510L, 1817123477L, -806644734L, 
# 865800749L, -1892571566L, -1617355595L, -1970106095L, -1784216894L, 
# -957129604L, 1372683716L, 1585549491L, 1641724963L, -1233180183L, 
# -2115154468L, -647086577L, 1490689471L, -659510135L, 1672352070L, 
# -1737628168L, -1077231544L, -231028753L, -1669225542L, -1130043292L, 
# 245153280L, -177644822L, 507686578L, 2004163666L, -2024871582L, 
# -870549579L, -2024712172L, -1645716812L, -702137496L, -1837823717L, 
# 1720839112L, -1826405011L, 1513369227L, 1134941526L, 1008942962L, 
# 128815711L, 973701102L, 101623061L, -63175558L, -726779129L, 
# -840959261L, -995388767L, 1115700156L, -2131136376L, 1921495739L, 
# 468742219L, 34502404L, 895339949L, -1258983285L, 1402845486L, 
# -817967921L, -1726841759L, -719319877L, 1333145753L, -1154753165L, 
# 1089521L, 450820106L, -623169932L, 370350280L, 478356951L, -36112560L, 
# 1007266685L, -1669086699L, 1928837063L, 537418327L, -824817215L, 
# 1719391014L, -2113179552L, -1606800130L, -1469544035L, 57174835L, 
# 1068172240L, -1678566893L, 253375578L, 513543633L, 1960904123L, 
# 1785457482L, 1612521516L, -821617372L, 197065817L, -602259956L, 
# 958613008L, 2119160044L, -657215372L, 4326173L, 1143211902L, 
# 1624756369L, 360324125L, -631735404L, 454901339L, 1185556167L, 
# 638919403L, -1833481247L, -30398135L, -1962302597L, -2056557289L, 
# 1410523027L, 56666512L, 2081587122L, -1922879090L, -2018473835L, 
# 1539387424L, 465374581L, 544890420L, -219140518L, 367965239L, 
# 175106189L, 324911089L, 694135888L, 420958892L, -97224807L, -1899304534L, 
# -170508221L, -1242043533L, 1940002415L, -364052079L, -719888796L, 
# 896719057L, -1262763597L, 1700892699L, -874075044L, -472444902L, 
# 1250377619L, -622877866L, 187367820L, 1933378587L, 423616696L, 
# 61081073L, 1245960290L, 585217769L, 1803648827L, -1844143304L, 
# 1278343701L, 1380774644L, -613743063L, -453575972L, -1687801895L, 
# 449314400L, 1803031143L, -277798389L, -1911163024L, 53910091L, 
# -389722583L, -870677889L, -1605408952L, -35453604L, -1412305356L, 
# 209494766L, -81099090L, -1115905929L, -698154854L, 858046584L, 
# 1291933592L, -723428300L, -1080614672L, 1405222644L, -539652507L, 
# 454807181L, -1010462768L, 1743794418L, -1454205568L, -2066558032L, 
# 78970871L, 409095319L, 13458077L, 1105791235L, 224622188L, -769276721L, 
# -2010361472L, -1578347666L, 383974105L, 1703254192L, -542741194L, 
# 543159467L, -151288399L, 677760505L, 997150426L, -481899484L, 
# -1599674371L, -1483156711L, -2043660897L, -2027127320L, -1450970982L, 
# -1325604044L, 542205294L, 1544215731L, 2090361365L, -1681100485L, 
# 217901542L, -1894003794L, 1341740107L, 1688464863L, 1117950045L, 
# 1805231730L, -1330392536L, -527953810L, 1788201528L, -1198490177L, 
# 1211424930L, 1414493858L, 1594876478L, -19833365L, 1779171423L, 
# -936596110L, -2024979988L, 1905407987L, 321858166L, -1659965797L, 
# -958374449L, 575873948L, -177690005L, -942631813L, 114276433L, 
# 1634051529L, 1919761105L, 1395227574L, 2128723079L, 1982212221L, 
# -1648151092L, 786827431L, 1529417354L, -609689241L, -859835056L, 
# 1250150391L, 1990966051L, 1538338638L, 26470039L, -714017400L, 
# 333527113L, -582948772L, 186491641L, -1485313477L, 1642785707L, 
# 1144575358L, -1468292160L, 1124121764L, 1184309720L, 628567653L, 
# 2098276280L, -1355891456L, 1596820363L, 1402707911L, 1364974117L, 
# -616430079L, 111216376L, -153975396L, 1316137408L, -1207849455L, 
# -2063219845L, 123087400L, -947507530L, 582287685L, 1182233792L, 
# -454916815L, -1217609492L, -2143335596L, 195328752L, -1854233608L, 
# -696721783L, 713235445L, -141919730L, -1799034722L, 1070449586L, 
# 1183401006L, 1605408514L, -754123009L, -62946516L, -610010884L, 
# 1947811306L, -1107021882L, -234722905L, -87687223L, -147128102L, 
# 1514639860L, -907167869L, 1837181130L, 729375349L, 1637099284L, 
# -505037803L, -2096949404L, -60400660L, 181999040L, 1433608131L, 
# -171820223L, -1154249306L, -139804510L, -768715593L, 2074258104L, 
# 41227351L, 670943572L, 1545109559L, -2111961261L, 1249170769L, 
# -1516160684L, -1018528880L, 1870239087L, -1369177535L, 1249095679L, 
# 392999509L, -1950416629L, -691124652L, 187387087L, 59275084L, 
# 128973086L, 367526057L, 252231860L, -1334482765L, 1992155476L, 
# 1404047489L, 873951314L, -1100704869L, 96733782L, 1754483669L, 
# -804212038L, -990495339L, -1195486136L, 1865028705L, 2039553631L, 
# -1813453248L, 364633574L, 1517937340L, -1152500652L, -545863697L, 
# -1098001070L, -1386362928L, 607099919L, 268345251L, 196590773L, 
# 489087383L, 576117862L, -1014586592L, -1460177984L, 1033323445L, 
# -1772740840L, 1250417474L)
.RN_calc_GPV_row <-
function (row_nums) 
{
    ttot <- sum(row_nums)
    mu <- ttot/length(row_nums)
    gsum <- .RN_calc_gsum(row_nums, mu)
    gchi <- pchisq(2 * gsum, length(row_nums) - 1, lower.tail=FALSE)
    lchi <- -log10(gchi)
    if(lchi == Inf)
    {
	lchi = 300
    }
    return(lchi)
}
.RN_calc_gsum <-
function (row, mu) 
{
#    gsum <- 0
#    for (x in row) {
 #       if (x != 0) {
#            gsum <- gsum + (x * log(x/mu))
#        }
#    }

    row <- row * log(row/mu)

#    return(gsum)
    return(sum(row, na.rm=TRUE))
}
.RN_get_replicate_list <- function(design)
{
  repL <- list()
  
  for(i in 1:dim(design)[1])
  {
    experiment <- match(1,design[i,])
    
    repL[[i]] <- i
    
    for(k in 1:dim(design)[1])
    {
      if(match(1, design[k,]) == experiment & i != k)
      {
          repL[[i]] <- append(repL[[i]], k)
      }
    }
  }
  
  return(repL)
}

.RN_calc_LPV_row <-
function (row_nums, RL)
{
  row_nums <- as.numeric(row_nums)
  
	if(all(row_nums == 0))
	{
		return(rep(0, length(row_nums)))
	}

	rn_l <- length(row_nums)
	LPV <- vector(mode="numeric", rn_l)
	
	for(j in seq_along(row_nums))
	{
	  pv <- 0
	  rl <- RL[[j]]
	  rcount <- length(rl)
	  ecount <- (length(row_nums) - rcount) + 1
	   
	  ltot <- row_nums[j] + sum(row_nums[-rl])
	  
	  lmu <- ltot / ecount
	  
	  if(row_nums[j] != 0)	
	  {
	    pv <- row_nums[j] * log(row_nums[j] / lmu)
	  }	
	  
	  if(ltot != row_nums[j])
	  {
	    pv <- pv + (ltot - row_nums[j]) * (log((ltot - row_nums[j]) / ((rn_l - rcount) * lmu)))
	  }
	 
	  chi <-  pchisq(2 * pv, 1, lower.tail=FALSE)
	  
	  if(row_nums[j]  >= lmu)
	  {
	    if(chi > 0)
	    {
	      LPV[j] <- -log10(chi)
	    }
	    else
	    {
	      LPV[j] <- 300
	    }
	  }	
	  else
	  {
	    if(chi > 0)
	    {
	      LPV[j] <- log10(chi)
	    }
	    else
	    {
	      LPV[j] <- -300
	    }
	  }
	  
	}
	
	return(LPV)
}
.RN_delete_col <-
function(TABLE, tr.col, skip.col)
{
	if(!is.null(skip.col))
        {
                s_col <- vector(mode="integer", length(skip.col))

                for(i in seq_along(skip.col))
                {
                        if(skip.col[i] > tr.col)
                        {
                                s_col[i] <- skip.col[i] - 1
                        }
                        else
                        {
                                s_col[i] <- skip.col[i]
                        }
                }

                TABLE[s_col] <- NULL
        }

	return(TABLE)	
}
.RN_design_check <-
function(X, design, rnums)
{
	if(!is.matrix(design))
        {
                stop("design argument does not seem to be a matrix...", call. = FALSE)
        }

        if(any(design != 0 & design != 1))
        {
                stop("invalid design matrix. Only 0 and 1 values accepted", call.=FALSE)
        }

        if(any(rowSums(design) != 1))
        {
                stop("invalid design matrix. Each sample can belong to just one treatment (rowSums of the design matrix must be 1 for each row)", call.=FALSE)
        }

        if(nrow(design) != length(X[rnums]))
        {
                stop(c("invalid design matrix. Number of rows in design matrix must match number of columns in expression values table (", length(X), ")"), call.=FALSE)
        }

	return(rnums)
}
.RN_iso_S <-
function (x, cfri, fri) {
	
	return (x * log(cfri / fri))
}

#.RN_select_lpv_row <-
#function(x, design_b, lpv_t)
#{
#	if(all(abs(x[design_b]) >= lpv_t))
#	{
#		if(all(x[design_b] > 0))
#		{
#			return (1)
#		}
#		else if(all(x[design_b] < 0))
#		{
#			return (-1)
#		}
#		else
#		{
#			return (NA)
#		}
#	}	
#	else
#	{
#		return (0);
#	}
# }

.RN_select_lpv_row <-
function(x, lpv_t)
  {
    if(all(abs(x) >= lpv_t))
    {
      if(all(x > 0))
      {
        return (1)
      }
      else if(all(x < 0))
      {
        return (-1)
      }
      else
      {
        return (NA)
      }
    }	
    else
    {
      return (0);
    }
}

.RN_default_design <- function(N)
{
    d <- matrix(data = 0, nrow = N, ncol = N)
    
    for(i in 1:N) {d[i,i] <- 1}
    
    return(d)
}

.RN_clean_NA <- function(r)
{
  return(!all(is.na(r)))
}