/*
* Wrapper for the functions that do the work.
*/
double
gsl_cdf_gamma_P (const double x, const double a, const double b)
{
double P;
double y = x / b;
if (x <= 0.0)
{
return 0.0;
}
#if 0 /* Not currently working to sufficient accuracy in tails */
if (a > LARGE_A)
{
/* Use Peizer and Pratt's normal approximation for large A. */
double z = norm_arg (y, a);
P = gsl_cdf_ugaussian_P (z);
}
else
#endif
{
P = gsl_sf_gamma_inc_P (a, y);
}
return P;
}
static double
beta_inc_AXPY (const double A, const double Y,
const double a, const double b, const double x)
{
if (x == 0.0)
{
return A * 0 + Y;
}
else if (x == 1.0)
{
return A * 1 + Y;
}
else if (a > 1e5 && b < 10 && x > a / (a + b))
{
/* Handle asymptotic regime, large a, small b, x > peak [AS 26.5.17] */
double N = a + (b - 1.0) / 2.0;
return A * gsl_sf_gamma_inc_Q (b, -N * log (x)) + Y;
}
else if (b > 1e5 && a < 10 && x < b / (a + b))
{
/* Handle asymptotic regime, small a, large b, x < peak [AS 26.5.17] */
double N = b + (a - 1.0) / 2.0;
return A * gsl_sf_gamma_inc_P (a, -N * log1p (-x)) + Y;
}
else
{
double ln_beta = gsl_sf_lnbeta (a, b);
double ln_pre = -ln_beta + a * log (x) + b * log1p (-x);
double prefactor = exp (ln_pre);
if (x < (a + 1.0) / (a + b + 2.0))
{
/* Apply continued fraction directly. */
double epsabs = fabs (Y / (A * prefactor / a)) * GSL_DBL_EPSILON;
double cf = beta_cont_frac (a, b, x, epsabs);
return A * (prefactor * cf / a) + Y;
}
else
{
/* Apply continued fraction after hypergeometric transformation. */
double epsabs =
fabs ((A + Y) / (A * prefactor / b)) * GSL_DBL_EPSILON;
double cf = beta_cont_frac (b, a, 1.0 - x, epsabs);
double term = prefactor * cf / b;
if (A == -Y)
{
return -A * term;
}
else
{
return A * (1 - term) + Y;
}
}
}
}
double
gsl_cdf_exppow_Q (const double x, const double a, const double b)
{
const double u = x / a;
if (u < 0)
{
double Q = 0.5 * (1.0 + gsl_sf_gamma_inc_P (1.0 / b, pow (-u, b)));
return Q;
}
else
{
double Q = 0.5 * gsl_sf_gamma_inc_Q (1.0 / b, pow (u, b));
return Q;
}
}
double
gsl_cdf_gamma_Q (const double x, const double a, const double b)
{
double Q;
double y = x / b;
if (x <= 0.0)
{
return 1.0;
}
if (y < a)
{
Q = 1 - gsl_sf_gamma_inc_P (a, y);
}
else
{
Q = gsl_sf_gamma_inc_Q (a, y);
}
return Q;
}
double
gsl_cdf_gamma_P (const double x, const double a, const double b)
{
double P;
double y = x / b;
if (x <= 0.0)
{
return 0.0;
}
if (y > a)
{
P = 1 - gsl_sf_gamma_inc_Q (a, y);
}
else
{
P = gsl_sf_gamma_inc_P (a, y);
}
return P;
}
inline long double gamma_p(long double x, long double y)
{ return gsl_sf_gamma_inc_P(x, y); }
inline double gamma_p(double x, double y)
{ return gsl_sf_gamma_inc_P(x, y); }
inline float gamma_p(float x, float y)
{ return (float)gsl_sf_gamma_inc_P(x, y); }
void AT_gamma_response( const long number_of_doses,
const double d_Gy[],
const long gamma_model,
const double gamma_parameter[],
const bool lethal_events_mode,
double S[]){
assert( number_of_doses > 0);
assert( d_Gy != NULL);
assert( gamma_parameter != NULL);
long i,j;
/*
* (0) Test model, response m*x + c
* parameters: m - gamma_parameter[0]
* c - gamma_parameter[1]
*/
if(gamma_model == GR_Test){
double m = gamma_parameter[0];
double c = gamma_parameter[1];
for (i = 0; i < number_of_doses; i++){
if(lethal_events_mode){
S[i] = 0; // No lethal_event_mode that would make sense
}else{
S[i] = m * d_Gy[i] + c;
}
}
}
/*
* (1) General multi-hit, multi-target model
*
* N.B.: In this case the array length IS NOT (*n_parameter) but 4*(*n_parameter) !!
*
* 4 * i parameters: k - relative contribution from component i (= Smax_i), preferably adding to 1 for all components (not mandatory though!)
* D1 - characteristic dose (one hit per target in average) of component i
* c - hittedness of component i
* m - number of targets for component i
* if 4*ith parameter (k_i == 0) -> end of parameter list
**/
if(gamma_model == GR_GeneralTarget){
long n_gamma_parameter = 0;
while (gamma_parameter[n_gamma_parameter] != 0){
n_gamma_parameter += 4;
}
for (i = 0; i < number_of_doses; i++){
S[i] = 0.0;
}
for (j = 0; j < n_gamma_parameter / 4; j++){ // loop over all components
double k = gamma_parameter[j * 4];
double D1 = gamma_parameter[j * 4 + 1];
double c = gamma_parameter[j * 4 + 2];
double m = gamma_parameter[j * 4 + 3];
assert( D1 > 0);
double tmp = 0.0;
for (i = 0; i < number_of_doses; i++){
if(c == 1){ // in case of c = 1 use simplified, faster formula
tmp = 1.0 - exp(-1.0 * d_Gy[i] / D1);
}else{ // for c > 1 use incomplete gamma function
assert( c > 0 );
assert( d_Gy[i] >= 0 );
tmp = gsl_sf_gamma_inc_P(c, d_Gy[i] / D1);
}
if(m == 1){ // in case of m = 1 do not use pow for speed reasons
tmp *= k;
}else{
tmp = k * pow(tmp, m);
}
S[i] += tmp;
}
}
if(lethal_events_mode){
for(i = 0; i < number_of_doses; i++){
assert( S[i] < 1.0);
S[i] = -1.0 * log(1.0 - S[i]);
}
}
}
/*
* (2) RL ACCUMULATED COUNTS MODEL
*
* parameters: Smax - max. RATE signal (in contrast to model == 1, where Smax is the maximum response signal)
* chi - dynamics, ration between Smax and start count rate c0
* D1 - characteristic dose at which rate signal reaches saturation
*
* are transformed into
*
* c0 - RATE signal at D = 0
* B - linear slope of RATE signal below D = D1
* D1 - see above
*/
if(gamma_model == GR_Radioluminescence){
double Smax = gamma_parameter[0];
double D1 = gamma_parameter[1];
double chi = gamma_parameter[2];
assert( chi > 0);
assert( D1 > 0);
// transform parameters
double c0 = Smax / chi;
double B = (Smax - c0) / D1;
for (i = 0; i < number_of_doses; i++){
if(d_Gy[i] <= D1){
S[i] = c0 * d_Gy[i] + 0.5 * B * gsl_pow_2(d_Gy[i]);
}else{
S[i] = c0 * D1 + 0.5 * B * gsl_pow_2(D1) + Smax * (d_Gy[i] - D1);
}
}
if(lethal_events_mode){
for(i = 0; i < number_of_doses; i++){
assert( S[i] < 1.0);
S[i] = -1.0 * log(1.0 - S[i]);
}
}
}
/*
* (3) EXPONENTIAL-SATURATION MODEL, obsolete
*
* parameters: Smax - max. response signal
* D1 - characteristic dose at which rate signal reaches saturation
*/
if(gamma_model == GR_ExpSaturation){
double Smax = gamma_parameter[0];
double D0 = gamma_parameter[1];
assert( D0 > 0);
for (i = 0; i < number_of_doses; i++){
if(lethal_events_mode){
S[i] = d_Gy[i] / D0;
}else{
S[i] = Smax * (1.0 - exp(-1.0 * d_Gy[i] / D0));
}
}
}
/*
* (4) LINEAR-QUADRATIC MODEL
*
* parameters: alpha - 1st parameter in LQ equation
* beta - 2nd parameter in LQ equation
* D0 - 3rd parameter - transition-dose
*/
if(gamma_model == GR_LinQuad){
double alpha = gamma_parameter[0];
double beta = gamma_parameter[1];
double D0 = gamma_parameter[2];
assert( alpha > 0. );
assert( beta >= 0. );
assert( D0 > 0. );
for (i = 0; i < number_of_doses; i++){
if( d_Gy[i] < D0 ){
S[i] = alpha * d_Gy[i] + beta * gsl_pow_2(d_Gy[i]);
} else {
S[i] = alpha * D0 + beta * gsl_pow_2(D0) + ( alpha + 2.0 * beta * D0) * (d_Gy[i] - D0);
}
if(!lethal_events_mode){ // non-lethal events mode
S[i] = exp( -S[i] );
}
}
}
/*
* (6) Multi-component model as given in Geiss, 1997 (PhD thesis)
*
* N.B.: This function is supposed to be a mixed of one- and two-hit characteristics. Due to missing linear terms in the second
* component, however, it cannot be expressed using the general hit-target model (implemented as (1))
*
* 5 parameters: c - constant, arbitrary for efficiency prediction
* k1 - contribution from linear component (0.8 for Geiss, 1997)
* a1 - dose prefactor for linear component (3e-4 for Geiss, 1997)
* k2 - contribution from quadratic component (0.2 for Geiss, 1997)
* a2 - dose prefactor for quadratic component (1e-6 for Geiss, 1997)
**/
if(gamma_model == GR_Geiss){
double co = gamma_parameter[0];
double k1 = gamma_parameter[1];
double a1 = gamma_parameter[2];
double k2 = gamma_parameter[3];
double a2 = gamma_parameter[4];
for (i = 0; i < number_of_doses; i++){
if(lethal_events_mode){
// TODO: Use more efficient formula
assert( 1.0 - k1 * (1.0 - exp(-a1 * d_Gy[i])) - k2 * (1.0 - exp(-a2 * d_Gy[i] * d_Gy[i])) > 0. );
S[i] = -log(1.0 - k1 * (1.0 - exp(-a1 * d_Gy[i])) - k2 * (1.0 - exp(-a2 * gsl_pow_2(d_Gy[i]))));
} else {
S[i] = co * (k1 * (1.0 - exp(-a1 * d_Gy[i])) + k2 * (1.0 - exp(-a2 * gsl_pow_2(d_Gy[i]))));
}
}
}
/*
* (7) DSB enhancement factor
**/
if(gamma_model == GR_AM_DSBEnhancement){
# define N_DATA 40
/** PROPRIETARY DATA --- NOT TO BE COMMITTED INTO PUBLIC SVN
BEGIN */
double dose_Gy[N_DATA] = { 100, 200, 300, 500, 700,
1000, 2000, 3000, 5000, 7000,
10000, 20000, 30000, 40000, 50000,
60000, 70000, 80000, 90000, 100000,
150000, 200000, 250000, 300000, 350000,
400000, 450000, 500000, 550000, 600000,
650000, 700000, 750000, 800000, 850000,
900000, 950000, 1000000, 1500000, 2000000};
double factor[N_DATA] = { 1.000000, 1.000000, 1.000000, 1.000000, 1.000000,
1.000000, 1.000000, 1.000000, 1.000000, 1.000000,
1.000000, 1.000000, 1.000000, 1.000000, 1.000000,
1.000000, 1.000000, 1.000000, 1.000000, 1.000000,
1.000000, 1.000000, 1.000000, 1.000000, 1.000000,
1.000000, 1.000000, 1.000000, 1.000000, 1.000000,
1.000000, 1.000000, 1.000000, 1.000000, 1.000000,
1.000000, 1.000000, 1.000000, 1.000000, 1.000000};
/** PROPRIETARY DATA --- NOT TO BE COMMITTED INTO PUBLIC SVN
END */
for (i = 0; i < number_of_doses; i++){
if(d_Gy[i] < 100){
S[i] = 1.0;
}else{
if(d_Gy[i] > 2e6){
S[i] = -1.0e99; // Most inelegant way of interrupting...
}else{
S[i] = AT_get_interpolated_y_from_input_table(dose_Gy, factor, N_DATA, d_Gy[i]);
}
}
}
}
# undef N_DATA
}
