.packageName <- "rama"
arrange.row<-function(data)
  {
### convert the data.frame to a matrix
    data<-as.matrix(data)
    n<-dim(data)

### Check that the indices start at 0
    if(min(data[,1])!=0 | min(data[,2])!=0)
      stop("The indices should start at zero" , call. = TRUE)
    
    m1<-max(data[,1]+1)
    m2<-max(data[,2]+1)
    
    obj<-.C("reorder",
            data=as.double(t(data)),
            n[1],
            n[2],
            all.data=as.double(rep(-999999,m1*m2*n[2])),
            as.integer(m1),
            as.integer(m2),PACKAGE="rama")
    
    data<-obj$all.data
    data<-data[data!=-999999]
    
    matrix(data,n[1],n[2],byrow=TRUE)
  }
est.shift<-function(sample1,sample2,B=1000,min.iter=0,batch=10,mcmc.obj=NULL,dye.swap=FALSE,nb.col1=NULL,
                    all.out=TRUE ,verbose=FALSE)
  {



###  Only take the finite observations
    indf1<-is.row.na(sample1)
    indf2<-is.row.na(sample2)
    sample1<-as.matrix(sample1[indf1 & indf2,])
    sample2<-as.matrix(sample2[indf1 & indf2,])
    n<-dim(sample1)

    if(dye.swap==TRUE)
      {
        if(length(nb.col1)==0)
          stop("No value has been set for nb.col1" , call. = TRUE)
        else if(nb.col1>=n[2] | nb.col1<=0)
          stop("nb.col1 should be at least 0 and at most n" , call. = TRUE)
      }
    else ## just set a value for the code to run
      nb.col1<-n[2]/2



    vec1<-as.double(t(sample1))
    vec1[is.finite(vec1)==FALSE]<- -9999999
    vec2<-as.double(t(sample2))
    vec2[is.finite(vec2)==FALSE]<- -9999999

    df.choice<-c(1:10,seq(20,100,10))
    df.in<-rep(100,n[2])
    w.in<-rep(1,n[1]*n[2])


    ## Minimum shift to make all the data >0
    m1<-max(0,-min(vec1)+0.01)
    m2<-max(0,-min(vec2)+0.01)


    if(length(mcmc.obj)>0)
      {
        if(class(mcmc.obj)!="mcmc.shift")
          stop("'mcmc.obj' should be of type 'mcmc.shift'" , call. = TRUE)

        n.iter<-length(mcmc.obj$mu)

        lambda.eps1<-mcmc.obj$lambda.eps1[n.iter]
        lambda.eps2<-mcmc.obj$lambda.eps2[n.iter]
        lambda.gamma1<-mcmc.obj$lambda.gamma1[n.iter]
        lambda.gamma2<-mcmc.obj$lambda.gamma2[n.iter]

        rho<-mcmc.obj$rho[n.iter]

        mu<-mcmc.obj$mu[n.iter]
        beta2<-mcmc.obj$beta[n.iter]
        alpha2<-mcmc.obj$alpha[n.iter]
        gamma1<-mcmc.obj$gamma1[,n.iter]
        gamma2<-mcmc.obj$gamma2[,n.iter]
        delta22<-mcmc.obj$delta22[n.iter]
        eta<-mcmc.obj$eta[,n.iter]
        shift<-mcmc.obj$shift[n.iter]
      }
    else
      {
        shift<-max(m1,m2)+10
        obj<-ls.effect(log2(sample1+shift),log2(sample2+shift),dye.swap=TRUE,nb.col1=nb.col1)
        mu<-obj$mu
        alpha2<-obj$alpha2
        gamma1<-obj$gamma1
        gamma2<-obj$gamma2
        if(dye.swap)
          {
            beta2<-obj$beta2
            delta22<-obj$delta22
          }
        else
          {
            beta2<-obj$beta2
            delta22<-obj$delta22
          }
        eta<-obj$eta
        if(n[2]>1)
          {
            lambda.eps1<-1/mean(obj$R1^2)
            lambda.eps2<-1/mean(obj$R2^2)
          }
        else
          {
            lambda.eps1<-1.
            lambda.eps2<-1.
          }

        lambda.gamma1<-0.5
        lambda.gamma2<-0.5
        rho<-0

      }



### Main code linked to a c function


    if(all.out==TRUE)
      length<-(B-min.iter)/batch
    else
      length<-1

    obj<-.C("R_link_mcmc_shift",
            vec1,
            vec2,
            as.integer(n[1]),
            as.integer(n[2]),
            as.integer(nb.col1),
            as.integer(dye.swap),
            as.integer(B),
            as.double(gamma1),
            gamma1=double(length*n[1]),
            as.double(gamma2),
            gamma2=double(length*n[1]),
            as.double(mu),
            mu=double(length),
            as.double(beta2),
            beta2=double(length),
            as.double(alpha2),
            alpha2=double(length),
            as.double(delta22),
            delta22=double(length),
            as.double(eta),
            eta=double(n[2]*length),
            as.double(lambda.eps1),
            lambda.eps1=double(length),
            as.double(lambda.eps2),
            lambda.eps2=double(length),
            as.double(w.in),
            as.double(df.choice),
            as.integer(length(df.choice)),
            as.double(df.in),
            as.double(rho),
            rho=double(length),
            as.double(shift),
            shift=double(length),
            as.double(max(-shift,0)+0.01),
            as.double(lambda.gamma1),
            as.double(lambda.gamma2),
            lambda.gamma1=double(length),
            lambda.gamma2=double(length),
            as.integer(min.iter),
            as.integer(batch),
            as.integer(all.out),
            as.integer(verbose),
            PACKAGE="rama")

    new.mcmc<-list(gamma1=t(matrix(obj$gamma1,length,n[1],byrow=TRUE)),
                   gamma2=t(matrix(obj$gamma2,length,n[1],byrow=TRUE)),
                   mu=obj$mu, beta2=obj$beta2, alpha2=obj$alpha2,delta22=obj$delta22,
                   lambda.eps1=obj$lambda.eps1,
                   lambda.eps2=obj$lambda.eps2,
                   lambda.gamma1=obj$lambda.gamma1,lambda.gamma2=obj$lambda.gamma2,rho=obj$rho,
                   shift=obj$shift,eta=t(matrix(obj$eta,length,n[2],byrow=TRUE)))

### Give it the right class
    class(new.mcmc)<-"mcmc.shift"

    return(new.mcmc)
}

fit.model<-function(sample1,sample2,B=1000,min.iter=0,batch=10,shift=NULL,mcmc.obj=NULL,
                    dye.swap=FALSE, nb.col1=NULL, all.out=FALSE, ci=0.95,verbose=FALSE)
  {


    ###  Only take the finite observations
    indf1<-is.row.na(sample1)
    indf2<-is.row.na(sample2)
    sample1<-as.matrix(sample1[indf1 & indf2,])
    sample2<-as.matrix(sample2[indf1 & indf2,])
    n<-dim(sample1)

    vec1<-as.double(t(sample1))
    vec1[is.finite(vec1)==FALSE]<- -9999999
    vec2<-as.double(t(sample2))
    vec2[is.finite(vec2)==FALSE]<- -9999999

    df.choice<-c(1:10,seq(20,100,10))
    w.out<-rep(0,n[1]*n[2])

    a.gamma<-1
    b.gamma<-0.005

    if(dye.swap==TRUE)
      {
        if(length(nb.col1)==0)
          stop("No value has been set for nb.col1" , call. = TRUE)
        else if(nb.col1>=(n[2]-1) | nb.col1<=1)
          stop("nb.col1 should be at least 2 and at most n-2" , call. = TRUE)
      }
    else ## just set a value for the code to run
      nb.col1<-n[2]/2

    if(length(shift)==0) ## No shift has been specified
      {
        ## Estimate the shift

        m1<-max(0,-min(vec1)+0.01)
        m2<-max(0,-min(vec2)+0.01)
        shift<-max(m1,m2)
        mcmc.obj.shift<-est.shift(sample1,sample2,B=2000,min.iter=1000,batch=10,mcmc.obj=NULL,dye.swap=dye.swap,nb.col1=nb.col1,verbose=verbose)
        shift<-mean(mcmc.obj.shift$shift)
      }

    if(length(mcmc.obj)>0)
      {
        if(class(mcmc.obj)!="mcmc")
          stop("'mcmc.obj' should be of type 'mcmc'" , call. = TRUE)


        n.iter<-length(mcmc.obj$mu)
        print(n.iter)

        lambda.eps1<-mcmc.obj$lambda.eps1[,n.iter]
        lambda.eps2<-mcmc.obj$lambda.eps2[,n.iter]
        lambda.gamma1<-mcmc.obj$lambda.gamma1[n.iter]
        lambda.gamma2<-mcmc.obj$lambda.gamma2[n.iter]

        a.eps<-mcmc.obj$a.eps[n.iter]
        b.eps<-mcmc.obj$b.eps[n.iter]

        rho<-mcmc.obj$rho[n.iter]

        df.in<-mcmc.obj$df[,n.iter]
        w.in<-matrix(mcmc.obj$w)
        w.in<-as.double(t(w.in))
        mu<-mcmc.obj$mu[n.iter]


        alpha2<-mcmc.obj$alpha[n.iter]
        gamma1<-mcmc.obj$gamma1[,n.iter]
        gamma2<-mcmc.obj$gamma2[,n.iter]
        beta2<-mcmc.obj$beta[n.iter]
        delta22<-mcmc.obj$delta22[n.iter]
        eta<-mcmc.obj$eta[,n.iter]

      }
    else
      {

        obj<-ls.effect(log2(sample1+shift),log2(sample2+shift),dye.swap=TRUE,nb.col1=nb.col1)
        mu<-obj$mu
        alpha2<-obj$alpha2

        gamma1<-obj$gamma1
        gamma2<-obj$gamma2
        if(dye.swap==TRUE)
          {
            beta2<-obj$beta2
            delta22<-obj$delta22
          }
        else
          {
            beta2<-0
            delta22<-0
          }
        eta<-obj$eta
        if(n[2]>1)
          {
            lambda.eps1<-1/mat.mean(obj$R1^2)[,1]
            lambda.eps2<-1/mat.mean(obj$R2^2)[,1]
          }
        else
          {
            lambda.eps1<-rep(1,n[1])
            lambda.eps2<-rep(1,n[1])
          }


        lambda.gamma1<-0.5
        lambda.gamma2<-0.5


        a.eps<-median(lambda.eps1)
        b.eps<-mad(lambda.eps1)
        df.in<-rep(10,n[2])
        w.in<-rep(1,n[1]*n[2])

        rho<-.8


      }

### Main code linked to a c function

    if(all.out==TRUE)
      length<-(B-min.iter)/batch
    else
      length<-1

    obj<-.C("ex_R_link_mcmc",
            log2(vec1+shift),
            log2(vec2+shift),
            as.integer(n[1]),
            as.integer(n[2]),
            as.integer(nb.col1),
            as.integer(B),
            as.integer(dye.swap),
            as.double(gamma1),
            gamma1=double(length*n[1]),
            as.double(gamma2),
            gamma2=double(length*n[1]),
            as.double(mu),
            mu=double(length),
            as.double(beta2),
            beta2=double(length),
            as.double(alpha2),
            alpha2=double(length),
            as.double(delta22),
            delta22=double(length),
            as.double(eta),
            eta=double(n[2]*length),
            as.double(lambda.eps1),
            lambda.eps1=double(length*n[1]),
            as.double(lambda.eps2),
            lambda.eps2=double(length*n[1]),
            as.double(a.eps),
            as.double(b.eps),
            a.eps=double(length),
            b.eps=double(length),
            as.double(w.in),
            as.double(df.choice),
            as.integer(length(df.choice)),
            as.double(df.in),
            df=double(n[2]*length),
            w=as.double(w.out),
            as.double(rho),
            rho=double(length),
            as.double(lambda.gamma1),
            as.double(lambda.gamma2),
            lambda.gamma1=double(length),
            lambda.gamma2=double(length),
            as.integer(min.iter),
            as.integer(batch),
            as.integer(all.out), as.integer(verbose),
            PACKAGE="rama")
    
    gamma1<-t(matrix(obj$gamma1,length,n[1],byrow=TRUE))
    gamma2<-t(matrix(obj$gamma2,length,n[1],byrow=TRUE))
    
    if(all.out==TRUE)
      {
        q.low<-rep(0,n[1])
        q.up<-rep(0,n[1])
        
        for(i in 1:(n[1]))
          {
            q.low[i]<-quantile(gamma1[i,]-gamma2[i,],probs=(1.-ci)/2)
            q.up[i]<-quantile(gamma1[i,]-gamma2[i,],probs=1.-(1.-ci)/2)
          }
        
      }
    else
      {
        q.low<-NULL
        q.up<-NULL
      }
    
### Create a new object
    new.mcmc<-list(gamma1=gamma1,
                   gamma2=gamma2,
                   q.low=q.low,q.up=q.up,
                   mu=obj$mu, beta2=obj$beta2, alpha2=obj$alpha2,delta22=obj$delta22,
                   lambda.eps1=t(matrix(obj$lambda.eps1,length,n[1],byrow=TRUE)),
                   lambda.eps2=t(matrix(obj$lambda.eps2,length,n[1],byrow=TRUE)),
                   lambda.gamma1=obj$lambda.gamma1,lambda.gamma2=obj$lambda.gamma2,rho=obj$rho,
                   w=matrix(obj$w,n[1],n[2]),
                   df=t(matrix(obj$df,length,n[2],byrow=TRUE)),
                   eta=t(matrix(obj$eta,length,n[2],byrow=TRUE)),
                   a.eps=obj$a.eps,b.eps=obj$b.eps,shift=shift)
### Give it the right class
    class(new.mcmc)<-"mcmc"
    
    return(new.mcmc)
}

is.row.na<-function (data)
{
  n <- dim(data)
  n1 <- n[1]
  n2 <- n[2]
  ind <- rep(FALSE, n1)

  for (i in 1:n1) {
    if (sum(is.finite(data[i, ]))==n2)
      ind[i] <- TRUE
  }
  ind
}
ls.effect<-function(sample1,sample2,dye.swap=FALSE,nb.col1=NULL)
  {
    n<-dim(sample1)
    n1<-n[1]
    n2<-n[2]
### Gene effect sample 1
    gamma1<-rep(0,n1)
### Gene effect sample 2
    gamma2<-rep(0,n1)
    
### Array effect
    eta<-rep(0,n2)

### Residuals
    R1<-sample1
    R2<-sample2
### Main effects
    M1<-sample1
    M2<-sample2

    ### Some constants
    m11<-mean(as.double(sample1[,1:nb.col1]),na.rm=TRUE)
    m12<-mean(as.double(sample1[,(nb.col1+1):n2]),na.rm=TRUE)
    m21<-mean(as.double(sample2[,1:nb.col1]),na.rm=TRUE)
    m22<-mean(as.double(sample2[,(nb.col1+1):n2]),na.rm=TRUE)

    if(dye.swap)
      {
### Offset
        mu<-m11
### Compute the dye effect
        beta2<-m12-m11
        
### Compute the sample effect
        alpha2<-m21-m11
        
### delta22 
        delta22<-m22+m11-m12-m21
        
### Compute the array effect
        
        for(i in 1:nb.col1)
          {
            eta[i]<-1/2*(mean(sample1[,i],na.rm=TRUE)+mean(sample2[,i],na.rm=TRUE)-m11-m21)
          }
        for(i in (nb.col1+1):n2)
          {
            eta[i]<-1/2*(mean(sample1[,i],na.rm=TRUE)+mean(sample2[,i],na.rm=TRUE)-m12-m22)
          }
        
        
### Compute the gene effect
        ms1<-mat.mean(sample1)[,1]
        ms2<-mat.mean(sample2)[,1]
        for(i in 1:n1)
          {
            gamma1[i]<-ms1[i]-(m11+m12)/2.
            gamma2[i]<-ms2[i]-(m21+m22)/2.
            for(j in 1:nb.col1)
              {
                M1[i,j]<-mu+eta[j]+gamma1[i]
                M2[i,j]<-mu+eta[j]+alpha2+gamma2[i]
                
                R1[i,j]<-sample1[i,j]-M1[i,j]
                R2[i,j]<-sample2[i,j]-M2[i,j]
              }
            for(j in (nb.col1+1):n2)
              {
                M1[i,j]<-mu+eta[j]+beta2+gamma1[i]
                M2[i,j]<-mu+eta[j]+alpha2+beta2+delta22+gamma2[i]
                R1[i,j]<-sample1[i,j]-M1[i,j]
                R2[i,j]<-sample2[i,j]-M2[i,j]
              } 
          }     
      }
    else
      {
        beta2<-NULL
        delta22<-NULL
### Offset
        mu<-1/2*(m11+m12) 
        
### Compute the sample effect
        alpha2<-1/2*(m21+m22-m11-m12)
        
### delta22 
        delta22<-1/2*(m22+m11-m12-m21)
        
### Compute the array effect

        for(i in 1:(n2))
          {
            eta[i]<-1/2*(mean(sample1[,i],na.rm=TRUE)+mean(sample2[,i],na.rm=TRUE)-(m11+m12)/2-(m21+m22)/2)
          }
        
        
        
### Compute the gene effect
        ms1<-mat.mean(sample1)[,1]
        ms2<-mat.mean(sample2)[,1]
        for(i in 1:n1)
          {
            gamma1[i]<-ms1[i]-(m11+m12)/2.
            gamma2[i]<-ms2[i]-(m21+m22)/2.
            for(j in 1:nb.col1)
              {
                M1[i,j]<-mu+eta[j]+gamma1[i]
                M2[i,j]<-mu+eta[j]+alpha2+gamma2[i]
                R1[i,j]<-sample1[i,j]-M1[i,j]
                R2[i,j]<-sample2[i,j]-M2[i,j]
              }
            for(j in (nb.col1+1):n2)
              {
                M1[i,j]<-mu+eta[j]+gamma1[i]
                M2[i,j]<-mu+eta[j]+alpha2+gamma2[i]
                R1[i,j]<-sample1[i,j]-M1[i,j]
                R2[i,j]<-sample2[i,j]-M2[i,j]
              }
          }
      }
    
    list(mu=mu,eta=eta,alpha2=alpha2,beta2=beta2,delta22=delta22,gamma1=gamma1,gamma2=gamma2,M1=M1,M2=M2,R1=R1,R2=R2)
  }
mat.mean<-function(data)
  {
    ### Main code linked to a c function
    n<-dim(data)
    vec<-as.double(t(data))
    vec[is.finite(vec)==FALSE]<- -9999999


    obj<-.C("link_R_mean_sd",
            as.double(vec),
            as.integer(n[1]),
            as.integer(n[2]),
            mean=double(n[1]),
            sd=double(n[1]), PACKAGE="rama")

    mean.data<-obj$mean
    sd.data<-obj$sd
    mean.data[mean.data==-9999999]<- NA
    sd.data[sd.data==-9999999]<- NA

    cbind(mean.data,sd.data)
  }


ratio.plot<-function(mcmc.obj,col=1,pch=1)
  {
    if(class(mcmc.obj)!="mcmc")
      stop("'mcmc.obj' should be of type 'mcmc'" , call. = TRUE)
    
    
    ### Estimate the gene effects in sample 1
    x1<-mat.mean(mcmc.obj$gamma1)[,1]
    x2<-mat.mean(mcmc.obj$gamma2)[,1]

    plot((x1+x2)/2,x1-x2,pch=pch,col=col,xlab="Overall intensity (log2)",ylab="Log ratio (log2)")
    
  }
weight.plot<-function(mcmc.obj,coordinate,array=1)
  {
    l<-length(mcmc.obj$w[,array])
    
### Check the dimension matching
    if(((dim(coordinate)[1])!=l) | ((dim(coordinate)[2])!=2))
      stop("Error in the dimensions of coordinate! " , call. = TRUE)

    if(class(mcmc.obj)!="mcmc")
      stop("'mcmc.obj' should be of type 'mcmc'" , call. = TRUE)
    
    ordered.weight<-arrange.row(cbind(coordinate,mcmc.obj$w[,array]))

### Number of rows and columns
    n1<-max(coordinate[,1]+1)
    n2<-max(coordinate[,2]+1)
    
    mat.weight<-matrix(ordered.weight[,3],n1,n2,byrow=TRUE)
    title<-cbind("array", as.character(array))
    image(1:n1,1:n2,mat.weight,xlab="Row", ylab="Column",col=grey(100:0/100),main=c("Image plot of the weights ",title))
  }
