source: branches/0.6-stable/yat/statistics/Fisher.cc @ 2317

// $Id: Fisher.cc 2317 2010-08-20 04:10:07Z peter $

/*
  Copyright (C) 2004 Jari Häkkinen, Peter Johansson
  Copyright (C) 2005 Peter Johansson
  Copyright (C) 2006, 2007, 2008 Jari Häkkinen, Peter Johansson
  Copyright (C) 2009, 2010 Peter Johansson

  This file is part of the yat library, http://dev.thep.lu.se/yat

  The yat library is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License as
  published by the Free Software Foundation; either version 3 of the
  License, or (at your option) any later version.

  The yat library is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with yat. If not, see <http://www.gnu.org/licenses/>.
*/

#include "Fisher.h"
#include "utility.h"

#include <gsl/gsl_cdf.h>
#include <gsl/gsl_randist.h>

#include <algorithm>
#include <cassert>

namespace theplu {
namespace yat {
namespace statistics {

  
  Fisher::Fisher()
    : a_(0), b_(0), c_(0), d_(0), minimum_size_(10), oddsratio_(1.0)
  {
  }


  Fisher::~Fisher()
  {
  }


  bool Fisher::calculate_p_exact(void) const
  {
    return ( a_<minimum_size_ || b_<minimum_size_ || 
             c_<minimum_size_ || d_<minimum_size_); 
  }

  double Fisher::Chi2() const
  {
    double a,b,c,d;
    expected(a,b,c,d);
    return (a-a_)*(a-a_)/a + (b-b_)*(b-b_)/b + 
      (c-c_)*(c-c_)/c + (d-d_)*(d-d_)/d;
  }


  void Fisher::expected(double& a, double& b, double& c, double& d) const
  {
    // use floting point arithmetic to avoid overflow
    double N = static_cast<double>(a_) + static_cast<double>(b_) 
      + static_cast<double>(c_) + static_cast<double>(d_);
    a =((a_+b_)*(a_+c_)) / N;
    b =((a_+b_)*(b_+d_)) / N;
    c =((c_+d_)*(a_+c_)) / N;
    d =((c_+d_)*(b_+d_)) / N;
  }


  unsigned int& Fisher::minimum_size(void)
  {
    return minimum_size_;
  }


  const unsigned int& Fisher::minimum_size(void) const
  {
    return minimum_size_;
  }


  double Fisher::oddsratio(const unsigned int a,
                           const unsigned int b,
                           const unsigned int c,
                           const unsigned int d) 
  {
    // If a column sum or a row sum is zero, the table is nonsense
    if ((a==0 || d==0) && (c==0 || b==0)){
      throw std::runtime_error("runtime_error: Table in Fisher is not valid\n");
    }
    a_ = a;
    b_ = b;
    c_ = c;
    d_ = d;

    oddsratio_= (static_cast<double>(a) / static_cast<double>(b) * 
                 static_cast<double>(d) / static_cast<double>(c) );
    return oddsratio_;
  }


  double Fisher::p_value() const
  {
    if (calculate_p_exact())
      return p_value_exact();
    return p_value_approximative();
  }


  double Fisher::p_value_one_sided() const
  {
    if (!calculate_p_exact()) {
      if (oddsratio_<1.0)
        return 1.0-p_value_approximative()/2.0;
      return p_value_approximative()/2.0;
    }
    // check for overflow
    assert(c_ <= c_+d_ && d_ <= c_+d_);
    assert(a_ <= a_+b_ && b_ <= a_+b_);
    assert(a_ <= a_+c_ && c_ <= a_+c_);

    return statistics::cdf_hypergeometric_P(c_, c_+d_, a_+b_, a_+c_);
  }


  double Fisher::p_value_approximative() const
  {
    return gsl_cdf_chisq_Q(Chi2(), 1.0);
  }

  double Fisher::p_value_exact() const
  { 
    double res=0;
    double a, c, tmp;
    expected(a, tmp, c, tmp);
    // sum P(x) over x for which abs(x-E(a))>=abs(a-E(a))  

    // counting left tail
    int k = static_cast<int>(a - std::abs(a_-a));
    if (k>=0)
      res = cdf_hypergeometric_P(k, a_+b_, c_+d_, a_+c_);
    // counting right tail
    k = static_cast<int>(c - std::abs(c_-c));
    if (k>=0)
      res += cdf_hypergeometric_P(k, c_+d_, a_+b_, a_+c_);

    // avoid p>1 due to double counting middle one
    return std::min(1.0, res);
  }

}}} // of namespace statistics, yat, and theplu