home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Explore the World of Soft…e: Engineering & Science
/
Explore_the_World_of_Software_Engineering_and_Science_HRS_Software_1998.iso
/
programs
/
statistc
/
aiuq9308.exe
/
AIU-QLV.CXX
next >
Wrap
Text File
|
1993-08-01
|
14KB
|
412 lines
/*
* Acceptable Quality Level (AQL), Indifference Quality Level (IQL) and
* Unacceptable Quality Level (UQL) for Single-Stage Binomial Sampling
*
* A Quality Assurance Training Tool:
* Statistics Committee of the QA Section of the PMA
*
* Bob Obenchain, CompuServe User [72007,467]
*
* Usage: DOSprompt> aiu-qlv
*
* Parameter settings are either...
* specified interactively in response to prompts, or
* redirected to come from a batch input file.
*/
#include <math.h>
#include <stdio.h>
#include <signal.h>
#include <stdlib.h>
#include <string.h>
#include <process.h>
#define abs(a) (( (a) >= 0 ) ? (a) : (-a)) /* absolute value of a */
#define sgn(a) (( (a) >= 0 ) ? 1 : -1 ) /* numerical sign of a */
#define max(x,y) (( (x) > (y) ) ? (x) : (y) )
#define min(x,y) (( (x) > (y) ) ? (y) : (x) )
#define ITMAX 100
#define EPS 3.0e-7
/* externals */
FILE *inpfile, *outfile;
char buf[256], inpnam[13], outnam[13], dtlnam[13], yesno;
double alpha, omalpha, term, quan, facp1, fnmac;
long sn, ac, rj;
/* prototypes */
void main( void );
double qbeta( double p, double a, double b );
double qnorms( double pr );
double betai( double a, double b, double x );
double betacf( double a, double b, double x );
double gammln( double xx );
extern int get1key( void );
double qbeta(p,a,b)
double p, a, b; {
int right, i;
double quan, tol, xl, pl, xr, pr, xm, sd, xx, pp, pdif;
tol = 1.17577E-37;
quan = p;
if( a == 1.0 && b == 1.0 )
return( quan );
if( p < 0.05 ) {
xl = 0.0;
pl = 0.0;
right = 0;
}
else if( p > 0.95 ) {
xr = 1.0;
pr = 1.0;
right = 1;
}
else {
/* normal approximations... */
xm = a + b;
sd = sqrt((a*b)/(xm*xm*(xm+1.)));
xl = qnorms(p) * sd + a / xm;
if( xl < tol ) {
xl=0.0;
pl=0.0;
right=0;
}
else if( xl > (1.0-tol) ) {
xr=1.0;
pr=1.0;
right=1;
}
else {
pl=betai(a,b,xl);
right=0;
if( pl > p ) {
right=1;
pr=pl;
xr=xl;
}
}
}
if( right == 1 ) {
/* find left end... */
while( 1 ) {
xl = max( xr-0.05, 0.0 );
if( xl <= 0.0 ) {
pl = 0.0;
break;
}
pl=betai(a,b,xl);
quan = xl;
if( pl == p )
return( quan );
if( pl < p )
break;
xr=xl;
pr=pl;
}
}
if( right == 0 ) {
/* find right end... */
while( 1 ) {
xr = min( xl+0.05, 1.0 );
if( xr >= 1.0 ) {
pr = 1.0;
break;
}
pr=betai(a,b,xr);
quan = xr;
if( pr == p )
return( quan );
if( pr > p )
break;
xl=xr;
pl=pr;
}
}
/* now quantile is between xl and xr; use bisection */
for( i=1; i<=6; i++ ) {
xx = (xl+xr)*.5;
pp = betai(a,b,xx);
pdif = pp-p;
quan = xx;
if( abs(pdif) < tol )
return( quan );
if( pdif > 0.0 ) {
xr=xx;
pr=pp;
}
else {
xl = xx;
pl = pp;
}
}
/* next, try secant method... */
for( i=1; i<=6; i++ ) {
xx = xl+(p-pl)*(xr-xl)/(pr-pl);
pp = betai(a,b,xx);
pdif = pp-p;
quan =xx;
if( abs(pdif) < tol)
return( quan );
if( pdif > 0.0) {
xr = xx;
pr = pp;
}
else {
xl = xx;
pl = pp;
}
}
quan = xx;
/* failed to converge... */
return( quan );
}
double qnorms( pr )
double pr; {
double quan, p, eta, f1, f2, f3, f4, f5, f6;
quan = 0.0;
if( pr <= 0.0 || pr == 0.5 || pr >= 1.0 )
return( quan );
f1 = .010328;
f2 = .802853;
f3 = 2.515517;
f4 = .001308;
f5 = .189269;
f6 = 1.432788;
p = pr;
if( pr > 0.5 )
p = 1.0 - pr;
eta = sqrt( -2.0 * log( p ) );
quan = eta - ((f1*eta+f2)*eta+f3)/(((f4*eta+f5)*eta+f6)*eta+1.0);
if( pr <= 0.5 )
quan *= -1.0;
return( quan );
}
void main() {
char kb;
printf("\n\n Acceptable Quality Level (AQL)," );
printf( "\n Indifference Quality Level (IQL) and" );
printf( "\n Unacceptable Quality Level (UQL) for" );
printf( "\n Single-Stage Binomial Sampling" );
printf("\n\n A/I/U-QLV.EXE....Version 9308");
printf("\n\n A Quality Assurance Training Tool:");
printf( "\n Statistics Committee of the QA Section of the PMA");
printf("\n\n Bob Obenchain, CompuServe User [72007,467]\n\n" );
printf( "\tWill Parameter Settings be Input via K = Keyboard ? ...or" );
printf( "\n\t B = Batch File ?" );
printf( "\n\n\tPress the K or B key now --> " );
while( 1 ) {
gets( buf );
sscanf( buf, "%c", &kb );
if( kb == 'k' )
kb = 'K';
if( kb == 'b' )
kb = 'B';
if( kb == 'K' || kb == 'B' )
break;
printf( "\r\tENTER either K or B ...Try Again --> " );
}
strcpy( outnam, "aiu-qlv" );
strcpy( inpnam, "aiu-qlv" );
strcpy( dtlnam, "aiu-qlv" );
if( kb == 'B' )
printf( "\n\n\tBatch Input of Parameter Settings Selected..." );
else
printf( "\n\n\tKeyboard Input of Parameter Settings Selected..." );
printf( "\n\n\tAt colon Prompts : ...simply press ENTER to get the [default]." );
if( kb == 'B' ) {
printf( "\n\n\tSpecify filename of Batch Input File [%s] : ",
inpnam );
gets( buf );
if( buf[0] != '\0' && buf[0] != '\r' && buf[0] != '\n' )
sscanf( buf, "%s", inpnam );
inpnam[ min( 8, (int)strcspn( inpnam, ". " ) ) ] = '\0';
if( inpnam[0] == '\0' )
strcpy( inpnam, "aiu-qlv" );
strcpy( outnam, inpnam );
strcpy( dtlnam, inpnam );
strcat( inpnam, ".inp" );
printf( "\n\tThe Batch Input file is to be: %s\n", inpnam );
if( ( inpfile = fopen( inpnam, "r" ) ) == NULL ) {
printf( "\tCannot read Batch Input file: %s\n", inpnam );
printf( "\t...using Keyboard Input from standard Infile, stdin.\n" );
kb = 'K';
}
}
if( kb == 'K' )
inpfile = stdin;
printf( "\n\n\tSpecify filename to save primary A/I/U-QLV Output [%s] : ",
outnam );
fgets( buf, 80, inpfile );
if( buf[0] != '\0' && buf[0] != '\r' && buf[0] != '\n' )
sscanf( buf, "%s", outnam );
outnam[ min( 8, (int)strcspn( outnam, ". " ) ) ] = '\0';
if( outnam[0] == '\0' )
strcpy( outnam, "aiu-qlv" );
strcpy( dtlnam, outnam );
strcat( outnam, ".out" );
printf( "\n\tThe A/I/U-QLV primary Output file is to be: %s\n",
outnam );
if( ( outfile = fopen( outnam, "w" ) ) == NULL ) {
printf( "\tCannot write to Output filename : %s\n", outnam );
if( ( outfile = fopen( "aiu-qlv.out", "w" ) ) == NULL )
printf( "\tCannot write to Output filename : aiu-qlv.out\n" );
else {
printf( "\t...using default Outfile name : aiu-qlv.out\n" );
strcpy( outnam, "aiu-qlv.out" );
}
}
if( outfile != NULL )
fprintf( outfile, "Output file for A/I/U-QLV..." );
printf("\n\nThis software calculates lower and upper confidence limits on the" );
printf("\npercentage of nonconforming units in an infinite population of");
printf("\nunits given accept - reject numbers for random sampling.");
sn = 100;
ac = 0;
rj = 1;
omalpha = 0.95;
while( 1 ) {
printf("\n\nWhat is the Sample Size ? [n=%ld] : ", sn );
fgets( buf, 80, inpfile );
if( buf[0] != '\0' && buf[0] != '\r' && buf[0] != '\n' )
sscanf( buf, "%ld", &sn );
if( sn < (long)1 )
sn = (long)1;
printf("\n\tSample Size: n =%7ld", sn);
if( outfile != NULL ) {
fprintf( outfile, "\n\n*****************\n" );
fprintf( outfile, "\nSample Size: n =%7ld", sn);
}
printf("\n\nWhat is the Accept Number? [ac=%ld] : ",
ac );
fgets( buf, 80, inpfile );
if( buf[0] != '\0' && buf[0] != '\r' && buf[0] != '\n' )
sscanf( buf, "%ld", &ac );
if( ac > sn - (long)1 )
ac = sn - (long)1 ;
if( ac < (long)0 )
ac = (long)0;
printf("\n\tAccept Number: ac =%7ld", ac );
if( outfile != NULL )
fprintf( outfile, "\nAccept Number: ac =%7ld", ac );
rj = ac + (long)1;
printf("\n\tReject Number: rj =%7ld", rj );
if( outfile != NULL )
fprintf( outfile, "\nReject Number: rj =%7ld", rj );
printf("\n\nDesired Yield Fraction at AQL" );
printf( "\n and Rejection Fraction at UQL ? [1-alpha=%5.3lf] : ",
omalpha );
fgets( buf, 80, inpfile );
if( buf[0] != '\0' && buf[0] != '\r' && buf[0] != '\n' )
sscanf( buf, "%lf", &omalpha );
if( omalpha > 0.99 )
omalpha = 0.99;
if( omalpha < 0.75 ) {
printf("\n\tWARNING: Yield/Rejection Fraction is usually large.");
omalpha = 0.75;
}
printf("\n\tYield/Rejection Fraction = %5.3lf", omalpha);
if( outfile != NULL )
fprintf( outfile, "\nYield/Rejection Fraction = %5.3lf", omalpha);
alpha = 1.0 - omalpha;
printf("\n\n\nAcceptable Percent Nonconforming: 100 * %ld / %ld = %7.3lf%%",
ac, sn, 100.0 * (double)ac / (double)sn );
printf("\n\nRejectable Percent Nonconforming: 100 * %ld / %ld = %7.3lf%%",
rj, sn, 100.0 * (double)rj / (double)sn );
if( outfile != NULL ) {
fprintf( outfile, "\nAcceptable Percent Nonconforming: 100 * %ld / %ld = %7.3lf%%",
ac, sn, 100.0 * (double)ac / (double)sn );
fprintf( outfile, "\nRejectable Percent Nonconforming: 100 * %ld / %ld = %7.3lf%%",
rj, sn, 100.0 * (double)rj / (double)sn );
}
printf("\n\nAt Yield/Rejection Percentage %5.1lf%%,", 100.0 * omalpha );
if( rj == sn )
quan = 100.0 * exp( log(alpha) / (double)sn );
else if( rj == (long)0 )
quan=0.0;
else {
facp1 = (double)(sn-rj+(long)1);
fnmac = (double)rj;
quan = 100.0 * (1.0 - qbeta( omalpha, facp1, fnmac ));
}
printf( "\n ...the AQL is %7.3lf%%", quan );
if( outfile != NULL ) {
fprintf( outfile, "\n\nAt Yield/Rejection Percentage %5.1lf%%,", 100.0 * omalpha );
fprintf( outfile, "\n ...the AQL is %7.3lf%%", quan );
}
if( rj == sn )
quan = 100.0 * exp( log(0.5) / (double)sn );
else if( rj == (long)0 )
quan=0.0;
else {
facp1 = (double)(sn-rj+(long)1);
fnmac = (double)rj;
quan = 100.0 * (1.0 - qbeta( 0.5, facp1, fnmac ));
}
printf( "\n ...the IQL is %7.3lf%%", quan );
if( outfile != NULL )
fprintf( outfile, "\n ...the IQL is %7.3lf%%", quan );
if( ac == (long)0 )
quan = 100.0 * ( 1.0 - exp( log(alpha) / (double)sn ));
else if( ac < sn ) {
facp1 = (double)(ac+(long)1);
fnmac = (double)(sn-ac);
quan = 100.0 * qbeta( omalpha, facp1, fnmac );
}
else
quan=100.0;
printf( "\n& ...the UQL is %7.3lf%%", quan );
if( outfile != NULL )
fprintf( outfile, "\n& ...the UQL is %7.3lf%%", quan );
yesno = 'y';
printf("\n\nA/I/U-QLV calculations for the current single-stage plan are complete.");
printf("\n\nDo you want to specify additional plans [Y|n] ? ");
fgets( buf, 80, inpfile );
if( buf[0] != '\0' && buf[0] != '\r' && buf[0] != '\n' )
sscanf( buf, "%c", &yesno );
if( yesno == 'n' || yesno == 'N' )
break;
}
printf( "\n\nExiting A/I/U-QLV...\n\n" );
}